Разбазариваю код :)

[Inferno]

Когда-то была проблема в конвертации корейской кодировки, используя чей-то код (Ребята спасибо), и доцарапав в него немного своего получил следующий код. Может кому пригодится и облегчит жизнь:).

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

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" (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 Sub CopyMemory Lib "kernel32.dll" Alias "RtlMoveMemory" (ByRef Destination As Any, ByRef Source As Any, ByVal Length As Long)

Private Const LMEM_ZEROINIT As Long = &H40


Public Function KoreanToUnicode(ByVal InString As String) As String
       Dim hMemLock1   As Long
       Dim iStrSize    As Long
       
       
       Dim Ptr As Integer
       Dim CountNonANSILetter As Integer
       Dim AddedSpaces As Integer
       Dim NeedConvert As Boolean
       Dim PreviousWasANSISymbol As Boolean
       
       
       CountNonANSILetter = 0
       AddedSpaces = 0
       NeedConvert = False
       
       If Asc(Mid(InString, 1, 1)) > 127 Then
          PreviousWasANSISymbol = False
          CountNonANSILetter = CountNonANSILetter + 1
       Else
         PreviousWasANSISymbol = True
       End If
       
       For Ptr = 2 To Len(InString)
         If Asc(Mid(InString, Ptr, 1)) > 127 Then
            CountNonANSILetter = CountNonANSILetter + 1 '
            PreviousWasANSISymbol = False
         Else
            PreviousWasANSISymbol = True
            If PreviousWasANSISymbol Then
               AddedSpaces = AddedSpaces + 1
               PreviousWasANSISymbol = False
            End If
         End If
       Next
       
      If ((CountNonANSILetter Mod 2) = 0) Then NeedConvert = True
       
      If NeedConvert Then
        AddedSpaces = 0
        hMemLock1 = LocalAlloc(LMEM_ZEROINIT, 255)
        iStrSize = MultiByteToWideChar(949, &H1, InString, -1, hMemLock1, 0&)
        iStrSize = iStrSize - 1
        MultiByteToWideChar 949, &H1, InString, -1, hMemLock1, iStrSize
        KoreanToUnicode = String$(Len(InString) * 2 - CountNonANSILetter + AddedSpaces, 0&)
        Call CopyMemory(ByVal KoreanToUnicode, ByVal hMemLock1, Len(InString) * 2 - CountNonANSILetter + AddedSpaces)
        Call LocalFree(hMemLock1)
     Else
        KoreanToUnicode = StrConv(InString, vbUnicode)
     End If
End Function



[Twister]

Надо было статейку забабахать...

[ANDLL]

Да. Вещь ценная лучше понаписать комментариев и выслать Гайдару статью.