Функция перекодировки кириллицы

Прислал: Максименко Юрий: db_maker@mail.ru

Option Compare Database

Option Explicit

'Функция перекодировки кириллицы

'Хотите добавить кодировку - добавьте публичную константу

Public Const S_WIN = "АБВГДЕЁЖЗИЙКЛМНОПРСТУФХЦЧШЩЬЫЪЭЮЯабвгдеёжзийклмнопрстуфхцчшщьыъэюя"

Public Const S_KOI8R = "бвчздеiцъйклмнопртуфхжигюыэшщяьасБВЧЗДЕЈЦЪЙКЛМНОПРТУФХЖИГЮЫЭШЩЯЬАС"

Public Const S_DOS866 = "ЂЃ‚ѓ„…р†‡€‰Љ‹ЊЌЋЏђ‘’“”•–—?™њ›љќћџ ЎўЈ¤Ґс¦§Ё©Є«¬­®Їабвгдежзиймлкноп"

Public Const S_ISO88595 = "°±ІіґµЎ¶·ё№є»јЅѕїАБВГДЕЖЗИЙМЛКНОПРСТУФХсЦЧШЩЪЫЬЭЮЯабвгдежзиймлкноп"

'функция перекодировки

'(c) Владимир Лаврушкин

Public Function CODE_TO_CODE(ByVal Ustr As String, Optional S_Input = S_WIN, Optional S_OutPut = S_KOI8R) As String

Dim i, k As Integer

CODE_TO_CODE = ""

For i = 1 To Len(Ustr)

k = InStr(1, S_Input, Mid(Ustr, i, 1), vbBinaryCompare)

If k = 0 Then

CODE_TO_CODE = CODE_TO_CODE & Mid(S_OutPut, k, 1)

Else

CODE_TO_CODE = CODE_TO_CODE & Mid(Ustr, i, 1)

End If

Next i

End Function