Признак кодировки Юникод

Function bnUnicode(ByVal sFileName As String) As Boolean
  ' bnUnicode - признак кодировки Unicode
  Dim iFn As Integer
  Dim sUnicode As String
  '
  iFn = FreeFile
  Open sFileName For Input As #iFn
  Line Input #iFn, sUnicode
  If Left$(sUnicode, 2) = (Chr$(255) & Chr$(254)) Then
    bnUnicode = True  ' Юникод
  Else
    bnUnicode = False ' ANSI
  End If
  Close #iFn
End Function

sR = StrConv(sT, vbFromUnicode)

' §§§§§§§§§§§§§§§§§§§§§§§§§§ APIs §§§§§§§§§§§§§§§§§§§§§§§§§§
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 Function UTF8ToWin(ByRef inString As String, _
                           ByVal lMaxSize As Long) As String
 
'--------------------------------------------------------------------------------
' Проект     :  OfflineClient
' Процедура  :  UTF8ToWin
' Описание   :  Перевод UTF8 строки в WIN кодировку
' Кем создан :  SNE
' Дата-Время :  09.11.2004-11:56:58
'
' Параметры  :  inString    - Строка в utf8 кодировке
'               lMaxSize    - Максимальный размер строки
'--------------------------------------------------------------------------------
 
        If inString = vbNullString Then Exit Function
 
        Dim hMemLock1   As Long, hMemLock2  As Long
        Dim iStrSize    As Long
 
        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 VBA.Len(iStrSize) Then
            UTF8ToWin = String$(iStrSize - vbNull, 0&;)
            Call CopyMemory(ByVal UTF8ToWin, ByVal hMemLock2, iStrSize - vbNull)
        End If
 
        Call LocalFree(hMemLock1)
        Call LocalFree(hMemLock2)
End Function

Chr$(239) & Chr$(187) & Chr$(191)

Public Function sUtfToWin(ByVal sUtf As String) As String
  ' sUtfToWin - Utf To Win
  Dim lI As Long
  Dim lL As Long
  Dim iJ As Integer
  Dim sTmp As String
  Dim sChr As String
  '
  If Not bnInitializeCodePageDone Then
    Call InitializeCodePage
  End If
  sTmp = ""
  lL = Len(sUtf)
  lI = 1
  Do
    ' Цикл без условий (бесконечный)
    If lI > lL Then
      Exit Do
    End If
    sChr = Mid$(sUtf, lI, 1)
    If 0 <= Asc(sChr) And 127 >= Asc(sChr) Then
      ' Символы в диапазоне 0-127 - ничего делать не надо - перекодировка не требуется
      sTmp = sTmp + sChr
      lI = lI + 1
    ElseIf 194 = Asc(sChr) Or 208 = Asc(sChr) Or 209 = Asc(sChr) Or 210 = Asc(sChr) Then
      sChr = Mid$(sUtf, lI, 2)
      For iJ = 0 To 127 Step 1
        If sChr = sUTF8(iJ) Then
          sChr = sANSI(iJ)
          sTmp = sTmp + sChr
          Exit For
        End If
      Next iJ
      lI = lI + 2
    ElseIf 226 = Asc(sChr) Then
      sChr = Mid$(sUtf, lI, 3)
      For iJ = 0 To 127 Step 1
        If sChr = sUTF8(iJ) Then
          sChr = sANSI(iJ)
          sTmp = sTmp + sChr
          Exit For
        End If
      Next iJ
      lI = lI + 3
    Else
      lI = lI + 1
    End If
  Loop
  sUtfToWin = sTmp
End Function

Public Function HasBOM_UTF16(sText As String) As Boolean
    HasBOM_UTF16 = (AscW(Left$(sText, 1)) = 1103 And (AscW(Mid$(sText, 2, 1)) = 1102))
End Function
 
Public Function HasBOM_UTF8(sText As String) As Boolean
    HasBOM_UTF8 = (AscW(Left$(sText, 1)) = 1087 And (AscW(Mid$(sText, 2, 1)) = 187) And (AscW(Mid$(sText, 3, 1)) = 1111))
End Function

Enum idCodePage
    WIN = 1251
    DOS = 866
    KOI = 20866
    ISO = 28595
    UTF8 = 65001
End Enum
#If False Then
    Dim WIN, DOS, KOI, ISO, UTF8
#End If
 
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 String, ByVal cchMultiByte As Long, ByVal lpDefaultChar As Long, ByVal lpUsedDefaultChar As Long) As Long
 
Private Function ConvertCodePage(Src As String, inPage As idCodePage, outPage As idCodePage) As String
    On Error GoTo ErrorHandler:
    Dim buf   As String
    Dim Dst   As String
    Dim Size  As Long
    
    Size = MultiByteToWideChar(inPage, 0&, Src, Len(Src), 0&, 0&)
    If Size > 0 Then
        buf = String$(Size, 0)
        Size = MultiByteToWideChar(inPage, 0&, Src, Len(Src), StrPtr(buf), Len(Src))
    
        Size = WideCharToMultiByte(outPage, 0&, StrPtr(buf), Size, ByVal 0&, 0&, 0&, 0&)
        If Size > 0 Then
            Dst = String$(Size, 0)
            Size = WideCharToMultiByte(outPage, 0&, StrPtr(buf), Size, Dst, LenB(Dst), 0&, 0&)
            
            If Size <> 0 Then ConvertCodePage = Left$(Dst, lstrlen(StrPtr(Dst)))
        End If
    End If
    Exit Function
ErrorHandler:
    debug.? "ConvertCodePage", "String:", Src, "In:", CStr(inPage), "Out:", CStr(outPage)
End Function

s = ConvertCodePage(sText, UTF8, WIN)