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

Прислал: Максименко Юрий: 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