Опять кодировка строки. Windows 7

[JohnK]

Программа в XP работала идеально. После перехода на Windows 7 появились проблемы с кодировкой при копировании строки в буфер обмена и вставки, например в Хром.

Функция отвечающая за перекодировку такая:

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

Public Function CodePageTo(strSrc As String) As String
Dim nLen As Long, strDst As String, strRet As String, nRet As Long
nLen = Len(strSrc): strDst = String(nLen * 2, Chr(0)): strRet = String(nLen * 2, Chr(0))
nRet = MultiByteToWideChar(CP_1251, MB_PRECOMPOSED, strSrc, nLen, strDst, nLen)
nRet = WideCharToMultiByte(CP_1251, 0, strDst, nRet, strRet, nLen * 2, ByVal 0, 0)
CodePageTo = Left(strRet, nRet)


вот что получается:

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

Êîâðèê äëÿ ìûøè iToy TURBO, ðàçìåð 210õ175x1.2 ìì, àíòè-ñêîëüæåíèå


[Хакер]

У меня нет уверенности, что ты не один из тех, кто упускает из виду то, что при копировании текста в буфер обмена в ряде случаев следует сперва переключить раскладку клавиатуры на ту, которая соответствует языку копируемого текста.

Ты не один из тех?

[JohnK]

Повторюсь. В XP работает безупречно при любой раскладке.

Копирование происходит программным путем:

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

          Clipboard.Clear
          Clipboard.SetText CodePageTo(LV_items.SelectedItem.SubItems(2))


[Хакер]

Повторюсь. В XP работает безупречно при любой раскладке.

Это никого не волнует.

Волнует другое: если в Win7 включить русскую раскладку и затем произвести копирование — всё нормально?

[JohnK]

Проверил. Действительно прикол (на XP проверил - такого нет), при включенной English раскладке копируются кракозябли вместо кириллицы. При русской раскладки - все ok.
Теперь следующий вопрос: "Почему так происходит?"

Как вариант решения - перед копированием проверять раскладку и программно менять с последующим восстановлением.

[Хакер]

Проверил. Действительно прикол (на XP проверил - такого нет), при включенной English раскладке копируются кракозябли вместо кириллицы. При русской раскладки - все ok.

Значит всё таки один из тех

Теперь следующий вопрос: "Почему так происходит?"

Так происходит со всеми неюникодными приложениями. VB6 тут не причём.

Изучи интерфейс управление буфером обмена и испоьзуй прямой юникодный интерфейс.

[JohnK]

Чтобы залатать "дыру" в программе, временно (а может и нет ) решил вопрос так:

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

Public Sub Clipboard_Set_RU_Text(sStr As String)
Dim CurKeybLayoutName As String
CurKeybLayoutName = String(9, 0)
GetKeyboardLayoutName CurKeybLayoutName
LoadKeyboardLayout "00000419", 1&
Clipboard.Clear:  Clipboard.SetText sStr
LoadKeyboardLayout CurKeybLayoutName, 1&
End Sub


Спасибо за помощь.

[Хакер]

Так нельзя делать.

[JohnK]

А как можно?

Так опять кракозябли:

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

Public Sub SetClipboardDataAPI(strText As String)
Dim hMem As Long, lpMem As Long, l As Long
    l = Len(strText) + 1
    hMem = GlobalAlloc(GMEM_TEXT, l)
    lpMem = GlobalLock(hMem)
    Call MoveMemory(lpMem, strText, l)
    Call GlobalUnlock(hMem)
    Call OpenClipboard(0&)
    Call EmptyClipboard
    Call SetClipboardData(CF_UNICODETEXT, hMem)
    Call CloseClipboard
    Call GlobalFree(hMem)
End Sub


[iGrok]

Как объявлена MoveMemory? Второй параметр - As String?

И, кстати, Len(strText) выдаст длину текста в символах, а не в байтах. Т.е. даже если будешь копировать правильные данные, скопируется только половина строки.

[Хакер]

l = Len(strText) + 1

и

Call MoveMemory(lpMem, strText, l)

Уже косяк.

[JohnK]

Ура! Вроде получилось:
Нужно было загнать еще локаль!

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

Public Sub SetClipboardDataAPI(strText As String)
Dim hMem As Long, lpMem As Long, l As Long, hlocale As Long, ptrlocale As Long
    l = Len(strText) + 1
    hMem = GlobalAlloc(GMEM_TEXT, l)
    lpMem = GlobalLock(hMem)
    Call MoveMemory(lpMem, strText, l)
    Call GlobalUnlock(hMem)
   
    hlocale = GlobalAlloc(0, 4)
    ptrlocale = GlobalLock(hlocale)
    ptrlocale = lstrcpy(ptrlocale, CStr(419))
    Call GlobalUnlock(hlocale)
   
    Call OpenClipboard(0&)
    Call EmptyClipboard
    Call SetClipboardData(CF_TEXT, hMem)
     Call SetClipboardData(CF_LOCALE, ptrlocale)
    Call CloseClipboard
    Call GlobalFree(hMem)
End Sub


[Хакер]

Ты чё, издеваешься что-ли?

Первый код был отвратительный, второй ещё хуже, а третий — хуже в квадрате.
Убирай lstrcpy.

[JohnK]

Я за все время критики не увидел от тебя ничего толкового в виде кода!
У меня работает замечательно, пока....

[Хакер]

Почему я должен писать за тебя код?

[JohnK]

Тогда почему я должен доверять справедливости и логичности твоей критики?

[Хакер]

А, даже так. Ну не доверяй на здоровье.
Я просто обращаюсь к тем, кто когда-нибудь наткнётся на этот код: люди, упаси вас бог скопировать себе этот код и использовать.

[JohnK]

Основное твое назначение здесь - поддерживать активность форума.
Иначе никак не могу понять твой отказ от предоставления правильного (исправленного) приведенного мной кода.

P.S. А может религия не позволяет?
В любом случае кому нужен рабочий код - тот скопирует. Твоими рассуждениями делу не поможешь (если есть наработки - покажи здесь)

[Хакер]

Во-первых, не было просьбы предоставить правильный код. Во-вторых, правильный код нужно показывать тогда, когда вопрошающий сам уж точно не в состоянии его написать, и уже буквально плачет от безысходности.

А в противоположность этому, давать каждому правильный код по первому требованию — это идиотская тактика, которая только вырабатывает у людей привычку думать чужой головой.

Так что в точку — религия не позволяет.

[JohnK]

Ok. Давай будем полезны друг другу. Дабы в пустую не тратить время на переписку.
Пожалуйста укажи "отвратительность" кода построчно и пути правильно решения (исправления).
Таким образом ты поможешь не только мне, но и тысячам, а может миллионам...

[Хакер]

Отвратительность решения в том, что вместо того, чтобы использовать юникодный интерфейс, ты указываешь локаль, и по прежнему используешь ansi-вариант со многими-многими отвратительными последствиями.

Кроме того, что подход ужасный, даже если принять, что подход хороший, то код, с помощью которого ты это делаешь — тоже ужасный.

Ты делаешь ужасные вещи ужасным кодом.

[JohnK]

Ха-ха. Я так и знал... Я плохой мальчик.

По сути: что ты подразумеваешь под фразой "использовать юникодный интерфейс" ?

[Хакер]

"использовать юникодный интерфейс" ?

У большинства функций есть A- и W-варианты. Здесь вариант один, а выбор логики между обработкой ansi и wide делаетя внутри самой функции в зависимости от того, какие данные были ей скормлены.

Надо скармливать клипборду юникодную строку. Точка.

[Хакер]

Вот тебе тест для твоего кода (любого, какой родишь):

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

Private Declare Function MessageBoxW Lib "user32" (ByVal h As Long, ByVal g As Long, ByVal j As Long, ByVal n As Long) As Long


Private Sub Command1_Click()
    e$ = "Kr" + ChrW(&H3CB) + "ger — Жа" + ChrW(&H49B) + "сы с" + ChrW(&H4E9) + "з!"
    MessageBoxW 0, StrPtr(e$), 0, 0
    ТвояЧудоФункцияКопирующаяВБуферОбмена e$
End Sub

Как только в буфер скопируется «Krϋger — Жақсы сөз!» (без порчи любого из символов), можешь считать, что код правилен.

[JohnK]

Следуя твоей логике, если задекларировать API функции с префиксом W (wide char) для самого первого кода, то все будет ok ?

[Хакер]

Следуя твоей логике, если задекларировать API функции с префиксом W (wide char) для самого перового кода? то все будет ok ?

Нет, это следуя какой-то тупой логике. Я уже сказал, что у clipboard-функций не пара реализация, а одна реализация.

Самый близкий к истине варант кода был тот, после которого последовал пост iGrok-а.

[JohnK]

Нет, это следуя какой-то тупой логике

Я тебя, вроде, не оскорблял еще...

Я уже сказал, что у clipboard-функций не пара реализация, а одна реализация.

Может я пропустил...

P.S. Тогда как поместить в буфер строку в юникоде?

[Хакер]

Я тебя, вроде, не оскорблял еще...

Я тоже. Но не надо приписывать мне логику, которая гласит, что все проблемы в мире решаются приписыванием суффикса «W».

P.S. Тогда как поместить в буфер строку в юникоде?

Да держи уже:

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

Private Declare Function MessageBoxW Lib "user32" (ByVal h As Long, ByVal g As Long, ByVal j As Long, ByVal n As Long) As Long

Private Declare Sub RtlMoveMemory Lib "kernel32" (dst As Any, src As Any, ByVal amount As Long)

Private Declare Function GlobalAlloc Lib "kernel32" (ByVal wFlags As Long, ByVal dwBytes As Long) As Long
Private Declare Function GlobalLock Lib "kernel32" (ByVal hMem As Long) As Long
Private Declare Function GlobalUnlock Lib "kernel32" (ByVal hMem As Long) As Long
Private Declare Function OpenClipboard Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function CloseClipboard Lib "user32" () As Long
Private Declare Function SetClipboardData Lib "user32" (ByVal wFormat As Long, ByVal hMem As Long) As Long
Private Declare Function EmptyClipboard Lib "user32" () As Long


Private Const CF_UNICODETEXT = 13
Private Const GMEM_MOVEABLE = &H2



Private Sub Command1_Click()
    e$ = "Kr" + ChrW(&H3CB) + "ger — Жа" + ChrW(&H49B) + "сы с" + ChrW(&H4E9) + "з!"
    MessageBoxW 0, StrPtr(e$), 0, 0
    SetClipboardDataAPI e$
End Sub

Public Sub SetClipboardDataAPI(strText As String)
    Dim hMem As Long, lpMem As Long, l As Long
   
    hMem = GlobalAlloc(GMEM_MOVEABLE, LenB(strText) + 2): If hMem = 0 Then Error 7
    lpMem = GlobalLock(hMem): If lpMem = 0 Then Error 7
    RtlMoveMemory ByVal lpMem, ByVal StrPtr(strText), LenB(strText) + 2
    GlobalUnlock hMem
   
    Call OpenClipboard(0&)
    Call EmptyClipboard
    Call SetClipboardData(CF_UNICODETEXT, hMem)
    Call CloseClipboard
End Sub


[JohnK]

Это вариант тоже работает...

[Хакер]

Он не тоже работает. Он единственный работающий и правильный.
Все твои варианты исказят тестовую строку. А значит они — не рабочие.