

trash писал(а):(что было удивительно, ведь VB6 не работает с юникодом)

<% 
set cn = server.createobject("adodb.connection")
cn.open "provider=sqlncli;server=xxx;database=yyy"
set rs=cn.execute("select * from Table1 where id=6")
response.write rs("Field1")
%>
Public Function ConvertCP(strSrc As String, nFromCP As Charset, nToCP As Charset) As String
On Error Resume Next
Dim nLen As Long
Dim strDst As String
Dim strRet As String
Dim nRet As Long
    nLen = Len(strSrc)
    strDst = String(nLen * 2, Chr(0))
    strRet = String(nLen * 2, Chr(0))
    nRet = MultiByteToWideChar(nFromCP, &H1, strSrc, nLen, strDst, nLen)
    nRet = WideCharToMultiByte(nToCP, 0, strDst, nRet, strRet, nLen * 2, ByVal 0, 0)
    ConvertCP = Left$(strRet, nRet)
End FunctionFunction EncodeUTF8(ByVal sInput As String) As String
Dim iCharPos As Long, iCharCode As Long
Dim iLoByteCounter As Long, iLoByteCount As Long, iHiBytePrefix As Long
Dim iInputLen As Long
    iInputLen = Len(sInput)
    ReDim aUTF8(iInputLen)
    For iCharPos = 1 To iInputLen
        aUTF8(iCharPos) = Mid$(sInput, iCharPos, 1)
        iCharCode = AscW(aUTF8(iCharPos))
        If (iCharCode > &H7F) Then '0xxx xxxx
            If (iCharCode < &H800) Then
                iHiBytePrefix = 192 '110xxxxx prefix for 2 bytes unicode
                iLoByteCount = 1
            ElseIf (iCharCode < &H10000) Then
                iHiBytePrefix = 224 '1110xxxx prefix for 3 bytes unicode
                iLoByteCount = 2
            ElseIf (iCharCode < &H200000) Then
                iHiBytePrefix = 240 '11110xxx prefix for 4 bytes unicode
                iLoByteCount = 3
            ElseIf (iCharCode < &H4000000) Then
                iHiBytePrefix = 248 '111110xx prefix for 5 bytes unicode
                iLoByteCount = 4
            Else
                iHiBytePrefix = 252 '1111110x prefix for 6 bytes unicode
                iLoByteCount = 5
            End If
            aUTF8(iCharPos) = ""
            For iLoByteCounter = iLoByteCount To 1 Step -1
                '6 ìëàäøèõ áèòîâ îò iCharCode + ïðåôèêñ 10xxxxxx
                aUTF8(iCharPos) = Chr(128 Or iCharCode And 63) & aUTF8(iCharPos)
                iCharCode = iCharCode \ 64 'ñäâèã íà 6 áèòîâ âïðàâî
            Next
            aUTF8(iCharPos) = Chr(iHiBytePrefix Or iCharCode) & aUTF8(iCharPos)
        End If
    Next
    EncodeUTF8 = Join(aUTF8, "")
End Function
Function DecodeUTF8(sInput As String) As String
Dim iCharPos As Long, iCharCode As Long
Dim iLoByteCounter As Long, iLoByteCount As Long, iLoCharCode As Long
Dim iInputLen As Long
    iInputLen = Len(sInput)
    ReDim aUnicode(iInputLen)
    For iCharPos = 1 To iInputLen
        aUnicode(iCharPos) = Mid$(sInput, iCharPos, 1)
        iCharCode = Asc(aUnicode(iCharPos))
        If (iCharCode > 191) Then
            If (iCharCode < 224) Then '110xxxxx prefix for 2 bytes unicode
                iCharCode = iCharCode And 31 'remove the 3 bit two bytes prefix
                iLoByteCount = 1
            ElseIf (iCharCode < 240) Then '1110xxxx prefix for 3 bytes unicode
                iCharCode = iCharCode And 15 'remove the 4 bit three bytes prefix
                iLoByteCount = 2
            ElseIf (iCharCode < 248) Then '11110xxx prefix for 4 bytes unicode
                iCharCode = iCharCode And 7 'remove the 5 bit four bytes prefix
                iLoByteCount = 3
            ElseIf (iCharCode < 252) Then '111110xx prefix for 5 bytes unicode
                iCharCode = iCharCode And 3 'remove the 6 bit five bytes prefix
                iLoByteCount = 4
            Else '1111110x prefix for 6 bytes unicode
                iCharCode = iCharCode And 1 'remove the 7 bit six bytes prefix
                iLoByteCount = 5
            End If
            For iLoByteCounter = 1 To iLoByteCount
                iLoCharCode = Asc(Mid$(sInput, iCharPos + iLoByteCounter, 1)) 'the next byte
                'ñäâèã âëåâî íà 6 áèòîâ + 6 ìëàäøèõ áèòîâ ñëåäóþùåãî ñèìâîëà
                iCharCode = iCharCode * 64 + (iLoCharCode And 63)
            Next
            aUnicode(iCharPos) = ChrW(iCharCode)
            iCharPos = iCharPos + iLoByteCount
        End If
    Next
    DecodeUTF8 = Join(aUnicode, "")
End Function
Вынужден заметить, что эта фраза не соответствует действительности. Работать, в моем понимании в данном случае, это получать ожидаемый результат после конкретных действий. Поле, например действий LСase или Ucase, получается лажа, потому что они не считают, что строки бывают юникодными. Так что VB6 с юникодом не работает, а халтурит.Это не удивительно, потому что VB6 работает с юникодом.

trash писал(а):Поле, например действий LСase или Ucase, получается лажа, потому что они не считают, что строки бывают юникодными.

    With New Scripting.FileSystemObject
        With .OpenTextFile("F:\in.htm")
            s = .ReadAll
        End With
        With .OpenTextFile("F:\out.htm", ForWriting, True)
            .Write LCase(s)
        End With
    End With


trash писал(а):что было удивительно, ведь VB6 не работает с юникодом


trash писал(а):Называйте как хотите, но меня язык не поворачивается назвать это словом "работает"
trash писал(а):И все-таки, как конвертировать win1251 в UTF-8 с помощью api? Или это невозможно в принципе?

trash писал(а):И все-таки, как конвертировать win1251 в UTF-8 с помощью api? Или это невозможно в принципе?

Ключевое слово api, однако.Первая строка гугля, однако...


alibek писал(а):ADODB.Stream.Charset наверняка использует MultiByteToWideChar/WideCharToMultiByte, надо только правильные кодовые таблицы использовать.

arthur2 писал(а):alibek писал(а):ADODB.Stream.Charset наверняка использует MultiByteToWideChar/WideCharToMultiByte, надо только правильные кодовые таблицы использовать.
А раз всё равно, то почему бы не использовать MultiByteToWideChar/WideCharToMultiByte напрямую?

Оно есть - по моей ссылкеarthur2 писал(а):Если оно есть - тогда конечно можно.

arthur2 писал(а):Оно есть - по моей ссылкеarthur2 писал(а):Если оно есть - тогда конечно можно.


alibek писал(а):А чем тебе ADODB не API?
Sub main()
Const zzz = "вапваыпвапвапвыапвп"
Dim b() As Byte
Dim s As String
Dim s1 As String
Dim x As Long
Dim t
    s = EncodeUTF8(zzz)
    b = ConvertStringToUtf8Bytes(zzz)
    
    t = Now
    For x = 1 To 100000
        s1 = ConvertUtf8BytesToString(b)
    Next
    Debug.Print "ADODB.Stream", Now - t
    
    t = Now
    For x = 1 To 100000
        s1 = UTF8ToWin(s)
    Next
    Debug.Print "API", Now - t
    
    t = Now
    For x = 1 To 100000
        s1 = DecodeUTF8(s)
    Next
    Debug.Print "Pure VB6", Now - t
End Sub
ADODB.Stream   2,31481462833472E-05 
API            0 
Pure VB6       3,47222230629995E-05 Public Function UTF8ToWin(inString As String) As String
Dim iStrSize As Long, lMaxSize As Long, str1 As String
    lMaxSize = Len(inString)
    str1 = String$(lMaxSize, 0&)
    iStrSize = MultiByteToWideChar(CP_UTF8, 0&, inString, &HFFFF, StrPtr(str1), lMaxSize)
    If Len(iStrSize) Then UTF8ToWin = Left$(str1, iStrSize)
End Function
Public Function WinToUTF8(strSrc As String) As String
On Error Resume Next
Dim nLen As Long
Dim strDst As String
Dim strRet As String
Dim nRet As Long
Dim p As Long
    nLen = Len(strSrc)
    strDst = String(nLen * 2, Chr(0))
    strRet = String(nLen * 2, Chr(0))
    p = StrPtr(strDst)
    nRet = MultiByteToWideChar(1251, &H1, strSrc, nLen, p, nLen)
    nRet = WideCharToMultiByte(CP_UTF8, 0, p, nRet, StrPtr(strRet), nLen * 2, ByVal 0, 0)
    ConvertCP = Left$(StrConv(strRet, vbUnicode), nRet)
End Function
Блин, не работает последний сорц(((( И ведь только заметил. Казахские символы игнорирует, конвертирует только русские. Что ему надо?trash писал(а):Вопрос снимаю.





Сейчас этот форум просматривают: AhrefsBot и гости: 9