Win-UTF8

[bevaine2000]

Какая функция делает данный сабж

[Amed]

Есть два массива - кодовые страницы. Функция меняет в строке знак из одного массива на знак с соответствующего места другого массива.

[Qubicz]

http://bbs.vbstreets.ru/viewtopic.php?t=14844&highlight=utf8

[bevaine2000]

Сенкс

[tyomitch]

Есть два массива - кодовые страницы. Функция меняет в строке знак из одного массива на знак с соответствующего места другого массива.

Не сканает - UTF8 переменной длины.

[alexanderz]

Думаю, константу win1252 знаешь и подставить сможешь

Код: Выделить всё

Private Declare Function GlobalAlloc Lib "kernel32.dll" (ByVal wFlags As Long, ByVal dwBytes As Long) As Long
Private Declare Function GlobalFree Lib "kernel32.dll" (ByVal hMem As Long) As Long
Private Declare Function MultiByteToWideChar Lib "kernel32.dll" (ByVal CodePage As Long, ByVal dwFlags As Long, ByVal lpMultiByteStr As String, ByVal cchMultiByte As Long, ByVal lpWideCharStr As String, ByVal cchWideChar As Long) As Long
Private Declare Function WideCharToMultiByte Lib "kernel32.dll" (ByVal CodePage As Long, ByVal dwFlags As Long, ByVal lpWideCharStr As String, ByVal cchWideChar As Long, ByVal lpMultiByteStr As String, ByVal cchMultiByte As Long, ByVal lpDefaultChar As String, ByVal lpUsedDefaultChar As Long) As Long
Private Declare Sub CopyMemory Lib "kernel32.dll" Alias "RtlMoveMemory" (ByRef Destination As Any, ByRef Source As Any, ByVal Length As Long)
Public Declare Function IsTextUnicode Lib "advapi32" (ByVal lpBuffer As String, ByVal cb As Long, lpi As Long) As Long
Private Const CP_UTF8       As Long = 65001
Private Const GMEM_FIXED    As Long = &H0
Private Const GMEM_ZEROINIT As Long = &H40
Private Const GPTR          As Long = (GMEM_FIXED Or GMEM_ZEROINIT)

' Параметры  :  inString    - Строка, в win кодировке
'               lMaxSize    - Максимальный размер строки
'--------------------------------------------------------------------------------
Public Function WinToUTF8(ByRef InString As String, _
                           ByVal lMaxSize As Long) As String

        If InString = vbNullString Then Exit Function

        Dim hMemLock1   As Long, hMemLock2  As Long
        Dim iStrSize    As Long

        hMemLock1 = GlobalAlloc(GPTR, lMaxSize)
        hMemLock2 = GlobalAlloc(GPTR, lMaxSize)

        iStrSize = MultiByteToWideChar(0&, 0&, InString, &HFFFF, hMemLock1, lMaxSize)
        iStrSize = WideCharToMultiByte(65001, 0&, hMemLock1, iStrSize, hMemLock2, lMaxSize, 0&, 0&)  ' CP_UTF8

        If VBA.Len(iStrSize) Then
            WinToUTF8 = String$(iStrSize - vbNull, 0&)
            Call CopyMemory(ByVal WinToUTF8, ByVal hMemLock2, iStrSize - vbNull)
        End If

        Call GlobalFree(hMemLock1)
        Call GlobalFree(hMemLock2)
End Function

' Параметры  :  inString    - Строка в utf8 кодировке
'               lMaxSize    - Максимальный размер строки
'--------------------------------------------------------------------------------
Public Function UTF8ToWin(ByRef InString As String, _
                           ByVal lMaxSize As Long) As String

        If InString = vbNullString Then Exit Function

        Dim hMemLock1   As Long, hMemLock2  As Long
        Dim iStrSize    As Long

        hMemLock1 = GlobalAlloc(GPTR, lMaxSize)
        hMemLock2 = GlobalAlloc(GPTR, lMaxSize)

        iStrSize = MultiByteToWideChar(CP_UTF8, 0&, InString, &HFFFF, hMemLock1, lMaxSize)
        iStrSize = WideCharToMultiByte(0&, 0&, hMemLock1, &HFFFF, hMemLock2, iStrSize, 0&, 0&)

        If VBA.Len(iStrSize) Then
            UTF8ToWin = VBA.String$(iStrSize - vbNull, 0&)
            Call CopyMemory(ByVal UTF8ToWin, ByVal hMemLock2, iStrSize - vbNull)
        End If

        Call GlobalFree(hMemLock1)
        Call GlobalFree(hMemLock2)
End Function

[alexanderz]

Ой, спутал... Там она уже переводит в win1251 из utf8 и наоборот

[Qubicz]

А копирайты потерял...
А если сходить по ссылке в 3 посте, то увидишь тот же код...

[alexanderz]

Я ниче не потерял - если посмотреть на мое мыло, то оно с vbnet.ru. А на этом сайте ведется строительснво VBNet Offline Client - я один из разработчиков.
Внимательнее надо быть

[bevaine2000]

alexanderz
Спасибо за код!

[Qubicz]

Я ниче не потерял - если посмотреть на мое мыло, то оно с vbnet.ru. А на этом сайте ведется строительснво VBNet Offline Client - я один из разработчиков.
Внимательнее надо быть

Прошу меня извинить...

[alexanderz]

Прошу меня извинить...

Бываеть