Алгоритмы.

  1. Хел,
    ы, я лоханулся))) думал функция cin.get не дописывает 0 на конце)) щас проверил , убедился что не нужно левых байт, сори, изучаю ж только)
     
  2. vizard-06,
    да норм все, не перед кем извиняться =)
     
  3. Пригодиться...
    кодируем текст в UTF-8 кодировку:

    Public Function EncodeUTF8(ByVal sStr As String)
    For l& = 1 To Len(sStr)
    lChar& = AscW(Mid(sStr, l&, 1))
    If lChar& < 128 Then
    sUtf8$ = sUtf8$ + Mid(sStr, l&, 1)
    ElseIf ((lChar& > 127) And (lChar& < 2048)) Then
    sUtf8$ = sUtf8$ + Chr(((lChar& \ 64) Or 192))
    sUtf8$ = sUtf8$ + Chr(((lChar& And 63) Or 128))
    Else
    sUtf8$ = sUtf8$ + Chr(((lChar& \ 144) Or 234))
    sUtf8$ = sUtf8$ + Chr((((lChar& \ 64) And 63) Or 128))
    sUtf8$ = sUtf8$ + Chr(((lChar& And 63) Or 128))
    End If
    Next l&
    UTF8_Encode = sUtf8$
    End Function


    код для VB6
     
  4. спасибо большое давно искал..)) а что насчет обратной функции?
     
  5. chimati,
    в новый модуль

    Option Explicit
    Private Const CP_UTF8 = 65001
    Private Const CP_ACP = 0
    Private Declare Function GetACP Lib "Kernel32" () As Long
    Private Declare Function WideCharToMultiByte Lib "Kernel32" (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, lpUsedDefaultChar As Long) As Long
    Private Declare Function MultiByteToWideChar Lib "Kernel32" (ByVal CodePage As Long, ByVal dwFlags As Long, ByVal lpMultiByteStr As Long, ByVal cchMultiByte As Long, ByVal lpWideCharStr As Long, ByVal cchWideChar As Long) As Long

    Private Function WToA(ByVal st As String, Optional ByVal cpg As Long = -1, Optional lFlags As Long = 0) As String
    Dim stBuffer As String
    Dim cwch As Long
    Dim pwz As Long
    Dim pwzBuffer As Long
    Dim lpUsedDefaultChar As Long

    If cpg = -1 Then cpg = GetACP()
    pwz = StrPtr(st)
    cwch = WideCharToMultiByte(cpg, lFlags, pwz, -1, 0&, 0&, ByVal 0&, ByVal 0&)
    stBuffer = String$(cwch + 1, vbNullChar)
    pwzBuffer = StrPtr(stBuffer)
    cwch = WideCharToMultiByte(cpg, lFlags, pwz, -1, pwzBuffer, Len(stBuffer), ByVal 0&, ByVal 0&)
    WToA = Left$(stBuffer, cwch - 1)
    End Function

    Private Function AToW(ByVal st As String, Optional ByVal cpg As Long = -1, Optional lFlags As Long = 0) As String
    Dim stBuffer As String
    Dim cwch As Long
    Dim pwz As Long
    Dim pwzBuffer As Long

    If cpg = -1 Then cpg = GetACP()
    pwz = StrPtr(st)
    cwch = MultiByteToWideChar(cpg, lFlags, pwz, -1, 0&, 0&)
    stBuffer = String$(cwch + 1, vbNullChar)
    pwzBuffer = StrPtr(stBuffer)
    cwch = MultiByteToWideChar(cpg, lFlags, pwz, -1, pwzBuffer, Len(stBuffer))
    AToW = Left$(stBuffer, cwch - 1)
    End Function

    Public Function EncodeUTF8(ByVal cnvUni As String) As String
    If cnvUni = vbNullString Then Exit Function
    EncodeUTF8 = StrConv(WToA(cnvUni, CP_UTF8), vbUnicode)
    End Function

    Public Function DecodeUTF8(ByVal cnvUni As String) As String
    If cnvUni = vbNullString Then Exit Function
    DecodeUTF8 = AToW(WToA(cnvUni, CP_ACP), CP_UTF8)
    End Function