1. Вы находитесь в архивной версии форума xaker.name. Здесь собраны темы с 2007 по 2012 год, большинство инструкций и мануалов уже неактуальны.
    Скрыть объявление

Алгоритмы.

Тема в разделе "Программирование", создана пользователем ~|~евто|-|, 14 сен 2007.

  1. vizard-06

    vizard-06 Продвинутый

    Регистрация:
    1 янв 2007
    Сообщения:
    47
    Симпатии:
    9
    Баллы:
    0
    Хел,
    ы, я лоханулся))) думал функция cin.get не дописывает 0 на конце)) щас проверил , убедился что не нужно левых байт, сори, изучаю ж только)
     
  2. Хел

    Хел ..::V.I.P::..

    Регистрация:
    15 ноя 2006
    Сообщения:
    0
    Симпатии:
    202
    Баллы:
    0
    vizard-06,
    да норм все, не перед кем извиняться =)
     
  3. lytgeygen

    lytgeygen pacifiste maniaque ..::V.I.P::..

    Регистрация:
    13 окт 2008
    Сообщения:
    431
    Симпатии:
    244
    Баллы:
    0
    Пригодиться...
    кодируем текст в 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. chimatii

    chimatii Глобальный модератор

    Регистрация:
    13 окт 2009
    Сообщения:
    0
    Симпатии:
    98
    Баллы:
    0
    спасибо большое давно искал..)) а что насчет обратной функции?
     
  5. lytgeygen

    lytgeygen pacifiste maniaque ..::V.I.P::..

    Регистрация:
    13 окт 2008
    Сообщения:
    431
    Симпатии:
    244
    Баллы:
    0
    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
     

Поделиться этой страницей