Борьба с "кракозябрами", вставляемыми из буфера обмена VISTA и Win-7

[Alex_ST]

Многие, а особенно - участники форумов, знают о баге работы буфера обмена в VISTA и Win-7: если скопировать в буфер обмена текст, содержащий символы кириллицы, не переключив перед копированием раскладку клавиатуры в RUS, то после вставки скопированного текста в ответ форума или "блокнот" вместо кириллических букв будут "кракозябры" типа:
Äîïîëíèòåëüíûå ñâåäåíèÿ ñì. â çàìåòêàõ î âûïóñêå

Для того, чтобы прочесть "сглюченный" таким образом текст, разработана функция пользователя:

Код Выделить Развернуть

Function ПОЧИНИТЬ_КИРИЛЛИЦУ(ГЛЮК$)
   '---------------------------------------------------------------------------------------
   ' Procedure    : ПОЧИНИТЬ_КИРИЛЛИЦУ
   ' Author       : The_Prist & Alex_ST
   ' DateTime     : 29.04.11, 09:52
   ' Topic_HEADER : Как прочесть "кракозябры", получаемые после копирования-вставки кириллицы из Висты?
   ' Topic_URL    : http://www.planetaexcel.ru/forum.php?thread_id=26894
   ' Purpose      : правит глюки типа Ýòà äîë  и другие "кракозябры" после вставки кириллицы из Vista
   ' Notes        :
   '---------------------------------------------------------------------------------------
   Dim Arr, i%, sTxt$, sSymb$
   'ГЛЮК = Replace(ГЛЮК, "&#", ";&#"): ГЛЮК = Replace(ГЛЮК, ";;", ";"):Arr = Split(ГЛЮК, ";")
   Arr = Split(Replace(Replace(ГЛЮК, "&#", ";&#"), ";;", ";"), ";")
   If UBound(Arr) > LBound(Arr) Then
      For i = LBound(Arr) To UBound(Arr)
         If Left(Arr(i), 2) = "&#" And IsNumeric(Mid(Arr(i), 3)) Then
            Arr(i) = CInt(Replace(Arr(i), "&#", ""))
            Arr(i) = Chr(IIf(Arr(i) > 256, Arr(i) - 848, Arr(i)))
         End If
      Next
      sTxt = Join(Arr, "")
   Else
      For i = 1 To Len(ГЛЮК)
         sSymb = Mid(ГЛЮК, i, 1)
         If AscW(sSymb) > 255 Then
            sTxt = sTxt & sSymb
         Else
            sTxt = sTxt & Chr(AscW(sSymb))
         End If
      Next i
   End If
   ПОЧИНИТЬ_КИРИЛЛИЦУ = sTxt
End Function

А для того, чтобы такие глюки не возникали при вашей работе, KukLP где-то нарыл следующий метод:
1. В папке system32 удаляем файл c_1252.nls
2. Там же делаем копию файла c_1251.nls и переименовываем её в c_1252.nls
3. Перезагружаемся. Проверяем. БАЛДЕЕМ!
Главная проблема - суметь удалить имеющийся файл c_1252.nls
Виста, маниакальная сволочь  , не даёт это сделать даже администратору. А стать Full Admin я не сумел.
Зато по совету того же KukLP я попробовал удалить файл с помощью программы Unlocker - получилось!

[Шпец Докапыч]

Тоже добавлю парочку рецептов:
1. Один моей пользовательской функцией:

Код Выделить Развернуть

Function CP1252in1(txt As String) As String
  For i = 1 To Len(txt)
    Mid(txt, i, 1) = StrConv(Mid(txt, i, 1), 64, 1049)
  Next
  CP1252in1 = txt
End Function

2. Другой от ZVI: Починка реестра - Rus.reg

[Alex_ST]

К сожалению, ВСЕ предлагавшиеся на разных форумах файлы для редактирования реестра, хотя и вносили требуемые изменения в реестр, но к ожидаемому результату не приводили. Это  многократно мною проверялось, в том числе и этот файл, предлагавшийся ZVI.
Реальный результат дала только выше описанная замена файлов.
Ну а для упрощения расшифровки искалеченных текстов в постах я из своей UDF сделал скрипт VBS, который расшифровывает данные, скопированные в буфер обмена:

Код Выделить Развернуть

   'берет текст из буфера обмена и выводит сообщение с исправленным текстом
   Dim GLUK, Arr, i, sTxt, sSymb
   With GetObject("New:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
      .GetFromClipboard: GLUK = .GetText   ' получить значение из буфера обмена
   End With
   Arr = Split(Replace(Replace(GLUK, "&#", ";&#"), ";;", ";"), ";")
   If UBound(Arr) > LBound(Arr) Then
      For i = LBound(Arr) To UBound(Arr)
         If Left(Arr(i), 2) = "&#" And IsNumeric(Mid(Arr(i), 3)) Then
            Arr(i) = CInt(Replace(Arr(i), "&#", ""))
            If Arr(i) > 256 Then Arr(i) = Arr(i) - 848
            Arr(i) = Chr(Arr(i))
         End If
      Next
      sTxt = Join(Arr, "")
   Else
      For i = 1 To Len(GLUK)
         sSymb = Mid(GLUK, i, 1)
         If AscW(sSymb) > 255 Then
            sTxt = sTxt & sSymb
         Else
            sTxt = sTxt & Chr(AscW(sSymb))
         End If
      Next
   End If
   GLUK = InputBox("", "", sTxt)