MyTetra Share
Делитесь знаниями!
Функция перекодировки кириллицы
Время создания: 16.03.2019 23:43
Раздел: !Закладки - VBA - Access - msa.polarcom.ru - 13 Преобразование Строк
Запись: xintrea/mytetra_db_adgaver_new/master/base/1532018253p5jc4tyhx8/text.html на raw.githubusercontent.com

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

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




Так же в этом разделе:
 
MyTetra Share v.0.59
Яндекс индекс цитирования