Pre mnogo, mnogo godina sam to uradio:
Public Function KonvertovaniTekstIzKodneStraneUkodnuStranu(Tekst As String, TipKonverzijeKodneStrane As Integer) As String
Dim n As Integer
Dim novitekst As String
If TipKonverzijeKodneStrane = 0 Then
'Konvertovanje iz kodne strane Serbian(Latin, Serbia) 1250 u YUSCII
'Acii kod; slovo nase abecede
'138=S(slovo [ veLikMrezaNizo)
'142=Z(slovo @ veLikMrezaNizo)
'154=s(slovo { malo)
'158=z(slovo ` malo)
'198=C(slovo ] veLikMrezaNizo)
'200=C(slovo ^ veLikMrezaNizo)
'208=DJ(slovo \ veLikMrezaNizo)
'230=c(slovo } malo)
'232=c(slovo ~ malo)
'240=dj(slovo | malo)
For n = 1 To Len(Tekst)
If Asc(Mid(Tekst, n, 1)) = 154 Then
Mid(Tekst, n, 1) = "{"
End If
If Asc(Tekst) = 240 Then
Mid(Tekst, n, 1) = "|"
End If
If Asc(Mid(Tekst, n, 1)) = 232 Then
Mid(Tekst, n, 1) = "~"
End If
If Asc(Mid(Tekst, n, 1)) = 230 Then
Mid(Tekst, n, 1) = "}"
End If
If Asc(Mid(Tekst, n, 1)) = 158 Then
Mid(Tekst, n, 1) = "`"
End If
If Asc(Mid(Tekst, n, 1)) = 138 Then
Mid(Tekst, n, 1) = "["
End If
If Asc(Mid(Tekst, n, 1)) = 208 Then
Mid(Tekst, n, 1) = "\"
End If
If Asc(Mid(Tekst, n, 1)) = 200 Then
Mid(Tekst, n, 1) = "^"
End If
If Asc(Mid(Tekst, n, 1)) = 198 Then
Mid(Tekst, n, 1) = "]"
End If
If Asc(Mid(Tekst, n, 1)) = 142 Then
Mid(Tekst, n, 1) = "@"
End If
Next n
End If
If TipKonverzijeKodneStrane = 1 Then
'Konvertovanje iz kodne strane YUSCII u Serbian(Latin, Serbia) 1250
For n = 1 To Len(Tekst)
If Mid(Tekst, n, 1) = "{" Then
Mid(Tekst, n, 1) = Chr(154)
End If
If Mid(Tekst, n, 1) = "|" Then
Mid(Tekst, n, 1) = Chr(240)
End If
'~
If Mid(Tekst, n, 1) = "~" Then
Mid(Tekst, n, 1) = Chr(232)
End If
'}
If Mid(Tekst, n, 1) = "}" Then
Mid(Tekst, n, 1) = Chr(230)
End If
If Mid(Tekst, n, 1) = "`" Then
Mid(Tekst, n, 1) = Chr(158)
End If
If Mid(Tekst, n, 1) = "[" Then
Mid(Tekst, n, 1) = Chr(138)
End If
If Mid(Tekst, n, 1) = "\" Then
Mid(Tekst, n, 1) = Chr(208)
End If
'^
If Mid(Tekst, n, 1) = "^" Then
Mid(Tekst, n, 1) = Chr(200)
End If
']
If Mid(Tekst, n, 1) = "]" Then
Mid(Tekst, n, 1) = Chr(198)
End If
If Mid(Tekst, n, 1) = "@" Then
Mid(Tekst, n, 1) = Chr(142)
End If
Next n
End If
If TipKonverzijeKodneStrane = 2 Then
'Konvertovanje iz kodne strane YUSCII u Serbian(Latin, Serbia) 852
For n = 1 To Len(Tekst)
If Mid(Tekst, n, 1) = "{" Then
Mid(Tekst, n, 1) = Chr(231)
End If
If Mid(Tekst, n, 1) = "|" Then
Mid(Tekst, n, 1) = Chr(208)
End If
'~
If Mid(Tekst, n, 1) = "~" Then
Mid(Tekst, n, 1) = Chr(159)
End If
'}
If Mid(Tekst, n, 1) = "}" Then
Mid(Tekst, n, 1) = Chr(134)
End If
If Mid(Tekst, n, 1) = "`" Then
Mid(Tekst, n, 1) = Chr(167)
End If
If Mid(Tekst, n, 1) = "[" Then
Mid(Tekst, n, 1) = Chr(230)
End If
If Mid(Tekst, n, 1) = "\" Then
Mid(Tekst, n, 1) = Chr(209)
End If
'^
If Mid(Tekst, n, 1) = "^" Then
Mid(Tekst, n, 1) = Chr(172)
End If
']
If Mid(Tekst, n, 1) = "]" Then
Mid(Tekst, n, 1) = Chr(143)
End If
If Mid(Tekst, n, 1) = "@" Then
Mid(Tekst, n, 1) = Chr(166)
End If
Next n
End If
If TipKonverzijeKodneStrane = 3 Then
'Konvertovanje iz kodne strane YUSCII u UniChar
For n = 1 To Len(Tekst)
If Mid(Tekst, n, 1) = "{" Then
Mid(Tekst, n, 1) = ChrW$(353)
End If
If Mid(Tekst, n, 1) = "|" Then
Mid(Tekst, n, 1) = ChrW$(273)
End If
'~
If Mid(Tekst, n, 1) = "~" Then
Mid(Tekst, n, 1) = ChrW$(269)
End If
'}
If Mid(Tekst, n, 1) = "}" Then
Mid(Tekst, n, 1) = ChrW$(263)
End If
If Mid(Tekst, n, 1) = "`" Then
Mid(Tekst, n, 1) = ChrW$(382)
End If
If Mid(Tekst, n, 1) = "[" Then
Mid(Tekst, n, 1) = ChrW$(352)
End If
If Mid(Tekst, n, 1) = "\" Then
Mid(Tekst, n, 1) = ChrW$(272)
End If
'^
If Mid(Tekst, n, 1) = "^" Then
Mid(Tekst, n, 1) = ChrW$(268)
End If
']
If Mid(Tekst, n, 1) = "]" Then
Mid(Tekst, n, 1) = ChrW$(262)
End If
If Mid(Tekst, n, 1) = "@" Then
Mid(Tekst, n, 1) = ChrW$(381)
End If
If Mid(Tekst, n, 1) = "/" Then
novitekst = novitekst & ChrW$(47)
End If
Next n
End If
If TipKonverzijeKodneStrane = 4 Then
'Kodne strana Serbian(Cirilic, Serbia) 1251
' Tabela kodova za naša slova
'U tabeli 2 su izlistani skoro svi znakovi koji se kod nas (u Srbiji i na prostoru bivše Jugoslavije) koriste, sa svojim UCS-2 kodom, UTF-8 zapisom i sa HTML oktalnim i decimalnim zapisima (za više informacija pogledajte poglavlje 2).
'
'Karakter Izgled UTF-8 oktalna decimalna
'Velika latinična slova
'U+0041 A 0x41 \101 A
'U+0042 B 0x42 \102 B
'U+0043 C 0x43 \103 C
'U+0044 D 0x44 \104 D
'U+0045 E 0x45 \105 E
'U+0046 F 0x46 \106 F
'U+0047 G 0x47 \107 G
'U+0048 H 0x48 \110 H
'U+0049 I 0x49 \111 I
'U+004A J 0x4A \112 J
'U+004B K 0x4B \113 K
'U+004C L 0x4C \114 L
'U+004D M 0x4D \115 M
'U+004E N 0x4E \116 N
'U+004F O 0x4F \117 O
'U+0050 P 0x50 \120 P
'U+0051 Q 0x51 \121 Q
'U+0052 R 0x52 \122 R
'U+0053 S 0x53 \123 S
'U+0054 T 0x54 \124 T
'U+0055 U 0x55 \125 U
'U+0056 V 0x56 \126 V
'U+0057 W 0x57 \127 W
'U+0058 X 0x58 \130 X
'U+0059 Y 0x59 \131 Y
'U+005A Z 0x5A \132 Z
'Mala latinična slova
'U+0061 a 0x61 \141 a
'U+0062 b 0x62 \142 b
'U+0063 c 0x63 \143 c
'U+0064 d 0x64 \144 d
'U+0065 e 0x65 \145 e
'U+0066 f 0x66 \146 e
'U+0067 g 0x67 \147 g
'U+0068 h 0x68 \150 h
'U+0069 i 0x69 \151 i
'U+006A j 0x6A \152 j
'U+006B k 0x6B \153 k
'U+006C l 0x6C \154 l
'U+006D m 0x6D \155 m
'U+006E n 0x6E \156 n
'U+006F o 0x6F \157 o
'U+0070 p 0x70 \160 p
'U+0071 q 0x71 \161 q
'U+0072 r 0x72 \162 r
'U+0073 s 0x73 \163 s
'U+0074 t 0x74 \164 t
'U+0075 u 0x75 \165 u
'U+0076 v 0x76 \166 v
'U+0077 w 0x77 \167 w
'U+0078 x 0x78 \170 x
'U+0079 y 0x79 \171 y
'U+007A z 0x7A \172 z
'Naša dodatna latinična slova
'U+0106 Ć 0xC4 0x86 \304\206 Ć
'U+0107 ć 0xC4 0x87 \304\207 ć
'U+010C Č 0xC4 0x8C \304\214 Č
'U+010D č 0xC4 0x8D \304\215 č
'U+0110 Đ 0xC4 0x90 \304\220 Đ
'U+0111 đ 0xC4 0x91 \304\221 đ
'U+0160 Š 0xC5 0xA0 \305\240 Š
'U+0161 š 0xC5 0xA1 \305\241 š
'U+017D Ž 0xC5 0xBD \305\275 Ž
'U+017E ž 0xC5 0xBE \305\276 ž
'Velika ćirilična slova
'U+0402 Đ 0xD0 0x82 \320\202 Ђ
'U+0408 J 0xD0 0x88 \320\210 Ј
'U+0409 LJ 0xD0 0x89 \320\211 Љ
'U+040A NJ 0xD0 0x8A \320\212 Њ
'U+040B Ć 0xD0 0x8B \320\213 Ћ
'U+040F DŽ 0xD0 0x8F \320\217 Џ
'U+0410 A 0xD0 0x90 \320\220 А
'U+0411 B 0xD0 0x91 \320\221 Б
'U+0412 V 0xD0 0x92 \320\222 В
'U+0413 G 0xD0 0x93 \320\223 Г
'U+0414 D 0xD0 0x94 \320\224 Д
'U+0415 E 0xD0 0x95 \320\225 Е
'U+0416 Ž 0xD0 0x96 \320\226 Ж
'U+0417 Z 0xD0 0x97 \320\227 З
'U+0418 I 0xD0 0x98 \320\230 И
'U+041A K 0xD0 0x9A \320\232 К
'U+041B L 0xD0 0x9B \320\233 Л
'U+041C M 0xD0 0x9C \320\234 М
'U+041D N 0xD0 0x9D \320\235 Н
'U+041E O 0xD0 0x9E \320\236 О
'U+041F P 0xD0 0x9F \320\237 П
'U+0420 R 0xD0 0xA0 \320\240 Р
'U+0421 S 0xD0 0xA1 \320\241 С
'U+0422 T 0xD0 0xA2 \320\242 Т
'U+0423 U 0xD0 0xA3 \320\243 У
'U+0424 F 0xD0 0xA4 \320\244 Ф
'U+0425 H 0xD0 0xA5 \320\245 Х
'U+0426 C 0xD0 0xA6 \320\246 Ц
'U+0427 Č 0xD0 0xA7 \320\247 Ч
'U+0428 Š 0xD0 0xA8 \320\250 Ш
'Mala ćirilična slova
'U+0430 a 0xD0 0xB0 \320\260 а
'U+0431 b 0xD0 0xB1 \320\261 б
'U+0432 v 0xD0 0xB2 \320\262 в
'U+0433 g 0xD0 0xB3 \320\263 г
'U+0434 d 0xD0 0xB4 \320\264 д
'U+0435 e 0xD0 0xB5 \320\265 е
'U+0436 ž 0xD0 0xB6 \320\266 ж
'U+0437 z 0xD0 0xB7 \320\267 з
'U+0438 i 0xD0 0xB8 \320\270 и
'U+043A k 0xD0 0xBA \320\272 к
'U+043B l 0xD0 0xBB \320\273 л
'U+043C m 0xD0 0xBC \320\274 м
'U+043D n 0xD0 0xBD \320\275 н
'U+043E o 0xD0 0xBE \320\276 о
'U+043F p 0xD0 0xBF \320\277 п
'U+0440 r 0xD0 0xC0 \320\280 р
'U+0441 s 0xD0 0xC1 \320\281 с
'U+0442 t 0xD0 0xC2 \320\282 т
'U+0443 u 0xD0 0xC3 \320\283 у
'U+0444 f 0xD0 0xC4 \320\284 ф
'U+0445 h 0xD0 0xC5 \320\285 х
'U+0446 c 0xD0 0xC6 \320\286 ц
'U+0447 č 0xD0 0xC7 \320\287 ч
'U+0448 š 0xD0 0xC8 \320\290 ш
'U+0452 đ 0xD1 0x92 \321\222 ђ
'U+0458 j 0xD1 0x98 \321\230 ј
'U+0459 lj 0xD1 0x99 \321\231 љ
'U+045A nj 0xD1 0x9A \321\232 њ
'U+045B ć 0xD1 0x9B \321\233 ћ
'U+045F dž 0xD1 0x9F \321\237 џ
'Konvertovanje iz kodne strane YUSCII u Serbian(Cirilic, Serbia) 1251
For n = 1 To Len(Tekst)
'Mala slova
'Velika slova
If Asc(Mid(Tekst, n, 1)) = 13 Then
novitekst = novitekst & Chr(Asc(Mid(Tekst, n, 1)))
End If
If Asc(Mid(Tekst, n, 1)) > 31 And Asc(Mid(Tekst, n, 1)) < 47 Then
novitekst = novitekst & Chr(Asc(Mid(Tekst, n, 1)))
End If
If Asc(Mid(Tekst, n, 1)) > 47 And Asc(Mid(Tekst, n, 1)) < 64 Then
novitekst = novitekst & Chr(Asc(Mid(Tekst, n, 1)))
End If
If Mid(Tekst, n, 1) = "_" Then
novitekst = novitekst & Chr(95)
End If
If Mid(Tekst, n, 1) = "A" Then
novitekst = novitekst & ChrW$(1040)
End If
If Mid(Tekst, n, 1) = "B" Then
novitekst = novitekst & ChrW$(1041)
End If
If Mid(Tekst, n, 1) = "V" Then
novitekst = novitekst & ChrW$(1042)
End If
If Mid(Tekst, n, 1) = "G" Then
novitekst = novitekst & ChrW$(1043)
End If
If Mid(Tekst, n, 1) = "D" Then
novitekst = novitekst & ChrW$(1044)
End If
''''''''''''''''''''''''''''''''
If Mid(Tekst, n, 1) = "\" Then
novitekst = novitekst & ChrW$(1026)
End If
'''''''''''''''''''''''''''''''''''
If Mid(Tekst, n, 1) = "E" Then
novitekst = novitekst & ChrW$(1045)
End If
If Mid(Tekst, n, 1) = "@" Then
novitekst = novitekst & ChrW$(1046)
End If
If Mid(Tekst, n, 1) = "Z" Then
novitekst = novitekst & ChrW$(1047)
End If
If Mid(Tekst, n, 1) = "I" Then
novitekst = novitekst & ChrW$(1048)
End If
''''''''''''''''''''''''''''''''
If Mid(Tekst, n, 1) = "J" Then
novitekst = novitekst & ChrW$(1032)
End If
''''''''''''''''''''''''''''''''
If Mid(Tekst, n, 1) = "K" Then
novitekst = novitekst & ChrW$(1050)
End If
If Mid(Tekst, n, 1) = "L" Then
novitekst = novitekst & ChrW$(1051)
End If
''''''''''''''''''''''''''''''
If Mid(Tekst, n, 1) = "Q" Then
novitekst = novitekst & ChrW$(1033)
End If
''''''''''''''''''''''''''''''''
If Mid(Tekst, n, 1) = "M" Then
novitekst = novitekst & ChrW$(1052)
End If
If Mid(Tekst, n, 1) = "N" Then
novitekst = novitekst & ChrW$(1053)
End If
''''''''''''''''''''''''''''''''
If Mid(Tekst, n, 1) = "W" Then
novitekst = novitekst & ChrW$(1034)
End If
'''''''''''''''''''''''''''''''
If Mid(Tekst, n, 1) = "O" Then
novitekst = novitekst & ChrW$(1054)
End If
If Mid(Tekst, n, 1) = "P" Then
novitekst = novitekst & ChrW$(1055)
End If
If Mid(Tekst, n, 1) = "R" Then
novitekst = novitekst & ChrW$(1056)
End If
If Mid(Tekst, n, 1) = "S" Then
novitekst = novitekst & ChrW$(1057)
End If
If Mid(Tekst, n, 1) = "T" Then
novitekst = novitekst & ChrW$(1058)
End If
'''''''''''''''''''''''''''''''''
If Mid(Tekst, n, 1) = "]" Then
novitekst = novitekst & ChrW$(1035)
End If
''''''''''''''''''''''''''''''''
If Mid(Tekst, n, 1) = "U" Then
novitekst = novitekst & ChrW$(1059)
End If
If Mid(Tekst, n, 1) = "F" Then
novitekst = novitekst & ChrW$(1060)
End If
If Mid(Tekst, n, 1) = "H" Then
novitekst = novitekst & ChrW$(1061)
End If
If Mid(Tekst, n, 1) = "C" Then
novitekst = novitekst & ChrW$(1062)
End If
If Mid(Tekst, n, 1) = "^" Then
novitekst = novitekst & ChrW$(1063)
End If
'''''''''''''''''''''''''''''''''
If Mid(Tekst, n, 1) = "X" Then
novitekst = novitekst & ChrW$(1039)
End If
'''''''''''''''''''''''''''''''''
If Mid(Tekst, n, 1) = "[" Then
novitekst = novitekst & ChrW$(1064)
End If
' Mala slova
If Mid(Tekst, n, 1) = "a" Then
novitekst = novitekst & ChrW$(1072)
End If
If Mid(Tekst, n, 1) = "b" Then
novitekst = novitekst & ChrW$(1073)
End If
If Mid(Tekst, n, 1) = "v" Then
novitekst = novitekst & ChrW$(1074)
End If
If Mid(Tekst, n, 1) = "g" Then
novitekst = novitekst & ChrW$(1075)
End If
If Mid(Tekst, n, 1) = "d" Then
novitekst = novitekst & ChrW$(1076)
End If
''''''''''''''''''''''''''''''''
If Mid(Tekst, n, 1) = "|" Then
novitekst = novitekst & ChrW$(1106)
End If
'''''''''''''''''''''''''''''''''''
If Mid(Tekst, n, 1) = "e" Then
novitekst = novitekst & ChrW$(1077)
End If
If Mid(Tekst, n, 1) = "`" Then
novitekst = novitekst & ChrW$(1078)
End If
If Mid(Tekst, n, 1) = "z" Then
novitekst = novitekst & ChrW$(1079)
End If
If Mid(Tekst, n, 1) = "i" Then
novitekst = novitekst & ChrW$(1080)
End If
''''''''''''''''''''''''''''''''
If Mid(Tekst, n, 1) = "j" Then
novitekst = novitekst & ChrW$(1112)
End If
''''''''''''''''''''''''''''''''
If Mid(Tekst, n, 1) = "k" Then
novitekst = novitekst & ChrW$(1082)
End If
If Mid(Tekst, n, 1) = "l" Then
novitekst = novitekst & ChrW$(1083)
End If
''''''''''''''''''''''''''''''
If Mid(Tekst, n, 1) = "q" Then
novitekst = novitekst & ChrW$(1113)
End If
''''''''''''''''''''''''''''''''
If Mid(Tekst, n, 1) = "m" Then
novitekst = novitekst & ChrW$(1084)
End If
If Mid(Tekst, n, 1) = "n" Then
novitekst = novitekst & ChrW$(1085)
End If
''''''''''''''''''''''''''''''''
If Mid(Tekst, n, 1) = "w" Then
novitekst = novitekst & ChrW$(1114)
End If
'''''''''''''''''''''''''''''''
If Mid(Tekst, n, 1) = "o" Then
novitekst = novitekst & ChrW$(1086)
End If
If Mid(Tekst, n, 1) = "p" Then
novitekst = novitekst & ChrW$(1087)
End If
If Mid(Tekst, n, 1) = "r" Then
novitekst = novitekst & ChrW$(1088)
End If
If Mid(Tekst, n, 1) = "s" Then
novitekst = novitekst & ChrW$(1089)
End If
If Mid(Tekst, n, 1) = "t" Then
novitekst = novitekst & ChrW$(1090)
End If
'''''''''''''''''''''''''''''''''
If Mid(Tekst, n, 1) = "}" Then
novitekst = novitekst & ChrW$(1115)
End If
''''''''''''''''''''''''''''''''
If Mid(Tekst, n, 1) = "u" Then
novitekst = novitekst & ChrW$(1091)
End If
If Mid(Tekst, n, 1) = "f" Then
novitekst = novitekst & ChrW$(1092)
End If
If Mid(Tekst, n, 1) = "h" Then
novitekst = novitekst & ChrW$(1093)
End If
If Mid(Tekst, n, 1) = "c" Then
novitekst = novitekst & ChrW$(1094)
End If
If Mid(Tekst, n, 1) = "~" Then
novitekst = novitekst & ChrW$(1095)
End If
'''''''''''''''''''''''''''''''''
If Mid(Tekst, n, 1) = "x" Then
novitekst = novitekst & ChrW$(1119)
End If
'''''''''''''''''''''''''''''''''
If Mid(Tekst, n, 1) = "{" Then
novitekst = novitekst & ChrW$(1096)
End If
If Mid(Tekst, n, 1) = "/" Then
novitekst = novitekst & ChrW$(47)
End If
Next n
Tekst = novitekst
End If
KonvertovaniTekstIzKodneStraneUkodnuStranu = Tekst
End Function
rgdrajko