Перевод UTF-8 в ANSI и обратно: есть ли стандартный способ?

[arthur2]

Итак, нужно перевести строку из UTF-8 в ANSI и обратно. Есть ли для этого стандартный способ (Апи какая-нибудь - система же как-то переводит), или придётся переводить руками?

Если придётся руками, то какой алгоритм перевода и как вообще определить, в какой кодировке строка?

[Gloom]

WideCharToMultiByte / MultiByteToWideChar

[arthur2]

Gloom
Спасибо! Да, это то, что нужно.

На другом форуме подсказали рабочий кусок кода (правда, пришлось немного подстрогать

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

'Private Declare Function LocalAlloc Lib "kernel32.dll" (ByVal wFlags As Long, ByVal wBytes As Long) As Long
'Private Declare Function LocalFree 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 Long, ByVal cchWideChar As Long) As Long
Private Declare Function WideCharToMultiByte Lib "kernel32.dll" (ByVal CodePage As Long, ByVal dwFlags As Long, ByVal lpWideCharStr As Long, ByVal cchWideChar As Long, ByVal lpMultiByteStr As Long, ByVal cchMultiByte As Long, ByVal lpDefaultChar As Long, 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)
Private Const CP_UTF8       As Long = 65001
'Private Const LMEM_ZEROINIT As Long = &H40


Public Function UTF8ToWin(ByVal inString As String) As String
        Dim hMemLock1   As Long, hMemLock2  As Long
        Dim iStrSize    As Long, lMaxSize As Long, str1 As String, str2 As String
     ' судя по описанию функции, строка должна быть NULL-terminated
        inString = inString & vbNullChar '& vbNullChar
     'Но всё работает и без этого :) Оставил на всякий пожарный
       
        lMaxSize = Len(inString)
        str1 = String$(lMaxSize, 0&)
        str2 = String$(lMaxSize, 0&)
        hMemLock1 = StrPtr(str1)
        hMemLock2 = StrPtr(str2)
       
'        hMemLock1 = LocalAlloc(LMEM_ZEROINIT, lMaxSize)' при этом способе бейсик иногда падал
'        hMemLock2 = LocalAlloc(LMEM_ZEROINIT, lMaxSize)


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

        If Len(iStrSize) Then
        UTF8ToWin = StrConv(str2, vbUnicode)
'            UTF8ToWin = String$(iStrSize, 0&)
'            Call CopyMemory(ByVal UTF8ToWin, ByVal hMemLock2, iStrSize)
        End If

'        Call LocalFree(hMemLock1)
'        Call LocalFree(hMemLock2)
End Function



Пример использования:
instring="<B>Превед, </B> <A title=""Превед, медвед"" Style = ""TEXT-DECORATION: underline"" onclick=""link_to_post(1912827); return false;"" href=""#"">медвед</A>"

outstring=UTF8ToWin(instring, Len(instring))

[arthur2]

Написал пример, как получить перетаскиванием фрагмент страницы хтмл.

Код функции UTF8ToWin пришлось немного подстрогать - а то бейски иногда падал.

[arthur2]

И ведь никто не заметил ошибки. Или не счёл нужным о ней сказать.

Оказывается, число, которое я нашёл методом тыка, описывающее формат буфера HTML Format, может меняться! Так что мой код мог работать, а мог и не работать.

Чило нужно было получать через RegisterClipboardFormat("HTML Format")

Пример исправил.