Option Explicit
Private Const CP_ACP As Long = 0 'default to ANSI code page
Private Const CP_OEMCP As Long = 1 'default to OEM code page
Private Const CP_MACCP As Long = 2 'default to MAC code page
Private Const CP_THREAD_ACP As Long = 3 'current thread's ANSI code page
Private Const CP_SYMBOL As Long = 42 'SYMBOL translations
Private Const CP_UTF7 As Long = 65000 'UTF-7 translation
Private Const CP_UTF8 As Long = 65001 'UTF-8 translation
Public Declare Function MultiByteToWideChar& Lib "kernel32" (ByVal CodePage As Long, _
ByVal dwFlags As Long, ByVal lpMultiByteStr As String, ByVal cchMultiByte As Long, _
ByRef buff As Byte, ByVal cchWideChar As Long)
Public Declare Function WideCharToMultiByte& Lib "kernel32" (ByVal CodePage As Long, _
ByVal dwFlags As Long, ByRef buff As Byte, ByVal cchWideChar As Long, _
ByRef buffCoded As Byte, ByVal cchMultiByte As Long, ByVal lpDefaultChar As String, _
ByVal lpUsedDefaultChar As Long)
Public Function cpCODE(sCodePage As String, sANSI As String) As String
Dim s As String, _
bb(1023) As Byte, _
bbCod(1023) As Byte, _
lngBadSymbols As Long, _
res As Long, _
lngBuffSize As Long, _
lngCP As Long
On Error GoTo L_Err
If sANSI = "" Then cpCODE = "": Exit Function
Select Case sCodePage
Case "CP_ACP": lngCP = 0
Case "CP_OEMCP": lngCP = 1 'default to OEM code page"
Case "CP_MACCP": lngCP = 2 'default to MAC code page"
Case "CP_THREAD_ACP": lngCP = 3 'current thread's ANSI code page"
Case "CP_SYMBOL": lngCP = 42 'SYMBOL translations"
Case "CP_UTF7": lngCP = 65000 'UTF-7 translation"
Case "CP_UTF8": lngCP = 65001 'UTF-8 translation"
Case Else
cpCODE = "Set Code Page not define"
Exit Function
End Select
'преобразуем ascii строчку в unicode
res = MultiByteToWideChar(CP_ACP, 0, sANSI, -1, bb(0), 512)
If res = 0 Then
cpCODE = "Function 'MultiByteToWideChar' return ERROR"
Exit Function
End If
'определяем размер выходного буфера
lngBuffSize = WideCharToMultiByte(lngCP, 0, bb(0), -1, bbCod(0), 0, vbNullString, lngBadSymbols)
'конвертируем данные входного буфера в заданную кодовую страницу и помещаем в выходной буфер
res = WideCharToMultiByte(lngCP, 0, bb(0), -1, bbCod(0), lngBuffSize, vbNullString, lngBadSymbols)
'преобразуем выходной буфер в строку в заданной кодовой странице
Call BinToStr(bbCod(), 0, lngBuffSize - 1, cpCODE)
L_Exit:
Exit Function
L_Err:
cpCODE = Err.Description & " (" & Err.Number & ")"
GoTo L_Exit
End Function
|