Перекодировка "на лету"

[newonline]

Для рабты своей проги я загружаю данные в таблицу, но потому как кодировка исходного файла DOS-овская, то приходится манипулировать свойством ФОНТ таблицы для получения читабельного текста. После получения оного иногда требуется ввести какие-то данные (текст) к клавы - но разумеется в поле добаляются только кракозябы какие-то (псевдографика или еще дрянь какая-нибудь). Какой инструмент позволяет "на лету" выполнять перекодировку текста со страницы 866-клава в ту, которая назначена таблице.
Спасибо.

[BV]

OemToChar?

[newonline]

Не пойдет:
1) Это ограничивает кодировки исходных данных, т.е. универсальность программы ограничевается, а это главный враг с которым я борюсь.
2) Даже насчастный DOS перекодирует неверно. Вот код:

'Private Declare Function OemToChar Lib "user32" Alias "CharToOemA" (ByVal lpszSrc As String, ByVal lpszDst As String) As Long
'Dim sourcestring As String
'Dim deststring As String
'Dim retcode As Long
txtCellEdit.Text = Replace(txtCellEdit.Text, ",", ".")

'sourcestring = txtCellEdit.Text
'deststring = Space$(Len(txtCellEdit.Text))
'retcode = OemToChar(sourcestring, deststring)
'txtCellEdit.Text = deststring

в результате кракозябы... Беда да и только...

[BV]

А ты уверен, что это DOS кодировка, а не проблема с кодовыми страницами в системе?

[newonline]

Ну вот в какчестве примера взгляни на энтот файл

[Odrick]

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

[Andrey Fedorov]

2) Даже насчастный DOS перекодирует неверно. Вот код:

Да ты что перекодитруешь-то? Контролы в VB неуенкодовские.

Считывай файл в переменную и перекодируй его.

[Andrey Fedorov]

Private Declare Function OemToChar Lib "user32" Alias "CharToOemA"

Кстати, таким объявлением ты прикалываешься???

[Andrey Fedorov]

Держи простенький примерчик для своих файликов.

[alibek]

Пара функций MultiByteToWideChar+WideCharToMultiByte позволяет менять любую кодировку на любую.

[Andrey Fedorov]

Пара функций MultiByteToWideChar+WideCharToMultiByte позволяет менять любую кодировку на любую.

Да ему надо чистый DOS. Прикол был в его объявлении функции OemToChar - глянь выше его пример - еще бы кракозябр не было

[newonline]

Я что хрень написал?
........

Ой



А что надо тагда писать в объявлении библиотеки?

[Andrey Fedorov]

Я что хрень написал?
........
Ой

А что надо тагда писать в объявлении библиотеки?

Трудно посмотреть пример что я дал?

[newonline]

Пара функций MultiByteToWideChar+WideCharToMultiByte позволяет менять любую кодировку на любую.

Да ему надо чистый DOS. Прикол был в его объявлении функции OemToChar - глянь выше его пример - еще бы кракозябр не было

Да не. Я с примером твоим разобрался. Спасибо. На нем можно хороший класс построить. Но я как понял одна из ошибок - это то, что я пользовался FSO при доступе к файлам - он не работает с Bynary. Но я ведь делал ОемТоЧар не совсем файлом сразу, а применительно к каждой записи в таблице отдельно...

[Alexander N. Samarin]

Вот на турбо си есть такая прога

[newonline]

А на каком принципе можно построить свой класс - перекодировщик для VB???

[Odrick]

В смысле? Самый простой вариант, который могу предложить - создать класс с 1 методом и парочкой свойств. Одно из которых - направление кодировки. И внутри этого класса набор строк, которые будут содержать набор символов-соответствий с windows-1251 кодировкой. А метод будет перебирать символы и по их кодам делать подстановку с соответствующей кодовой таблицы. Гм... Не очень сумбурно обьяснил?

[BV]

Оригинал (ReCode.bas).

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

Option Explicit

Enum Code
    Win = 1
    Dos = 2
    Koi = 3
End Enum

Public Function Recode(Char As String, Src As Code, Dest As Code) As String
Const wDos As String = "°±Ііґµ¶·ё№є»јЅѕїАБВГДЕЖЗИЙКЛМНОПРСТУФХЦЧрЩЪЫЬЭЮЯтуфхцчшщсыьэюяШъЂЃ‚ѓ„…†‡€‰Љ‹ЊЌЋЏђ‘’“”•–—˜™љ›њќћџ ЎўЈ¤Ґ¦§Ё©Є«¬­®Їабвгдежзийклмноп"
Const wKoi As String = "ђ‘’Ѓ‡Іґ§¦µЎЁ®­¬ѓ„‰€†ЂЉЇ°«Ґ»ё± ѕ№є¶·Є©ў¤Ѕі…‚ЌЊЋЏ‹™˜“›џ—њћЈ–љќ”їј•бвчздецъйклмнопртуфхжигюыэящшьасБВЧЗДЕЦЪЙКЛМНОПРТУФХЖИГЮЫЭЯЩШЬАС"
Const wWin As String = "ЂЃ‚ѓ„…†‡€‰Љ‹ЊЌЋЏђ‘’“”•–—˜™љ›њќћџ ЎўЈ¤Ґ¦§Ё©Є«¬­®Ї°±Ііґµ¶·ё№є»јЅѕїАБВГДЕЖЗИЙКЛМНОПРСТУФХЦЧШЩЪЫЬЭЮЯабвгдежзийклмнопрстуфхцчшщъыьэюя"
Const NotRecodedChar As String = "?"
If Src = Dest Then
Recode = Char
Exit Function
End If
Dim t As String, i As Long, tt As String, a As Long, ss As String, ch As String
If Src = Win Then
t = Char
Else
Select Case Src
Case Koi: ss = wKoi
Case Dos: ss = wDos
End Select
For i = 1 To Len(Char)
ch = Mid$(Char, i, 1)
If Asc(ch) < 128 Then
t = t & ch
Else
a = InStr(1, ss, ch, vbBinaryCompare)
If a = 0 Then
t = t & NotRecodedChar
Else
t = t & Mid$(wWin, a, 1)
End If
End If
Next i
End If
If Dest = Win Then
Recode = t
Else
Select Case Dest
Case Koi: ss = wKoi
Case Dos: ss = wDos
End Select
For i = 1 To Len(Char)
ch = Mid$(t, i, 1)
If Asc(ch) < 128 Then
tt = tt & ch
Else
a = InStr(1, wWin, ch, vbBinaryCompare)
If a = 0 Then
tt = tt & NotRecodedChar
Else
tt = tt & Mid$(ss, a, 1)
End If
End If
Next i
Recode = tt
End If
End Function

[Odrick]

BV - о, именно то, что я имел в виду

[Andrey Fedorov]

Но я как понял одна из ошибок - это то, что я пользовался FSO при доступе к файлам - он не работает с Bynary. Но я ведь делал ОемТоЧар не совсем файлом сразу, а применительно к каждой записи в таблице отдельно...

FSO нормально работает с текстом - т.е ты там тоже что-то накрутил...

[newonline]

Понял...
пошел в библиотеку

[VVitafresh]

Оригинал (ReCode.bas).

Для больших файлов (хотя бы более 1МБ) такой метод с подменой символов очень медленно работает. OemToCharA намного быстрее.

[BV]

OemToChar?

[VVitafresh]

Дя я понял, что ты в курсе
Просто для тех, кто не сравнивал эти два метода делюсь своим наблюдением.
Мне самому интересно как оптимизировать посимвольную подмену, чтобы скорость для больших файлов была приемлемой. Может стоит с массивами поиграться
Как считаешь?

[BV]

Можно и с Replace'ом "поиграться", и с коллекциями, и с RtlMoveMemory (всё при желании).

Сделай тесты.

[tyomitch]

А давайте ещё ассемблерную вставку напишем, с командой XLAT

[hCORe]

Предложивший такой изврат пишет сам

А вообще WideCharToMultiByte и MultiByteToWideChar - наиболее приемлемые решения. В NT-системах функции OemToChar и CharToOem вызывают WideCharToMultiByte и MultiByteToWideChar.

При желании можно поиграться с чем угодно. Лишь бы время было лишнее. Часов пять-шесть

[tyomitch]

Предложивший такой изврат пишет сам

А вообще WideCharToMultiByte и MultiByteToWideChar - наиболее приемлемые решения. В NT-системах функции OemToChar и CharToOem вызывают WideCharToMultiByte и MultiByteToWideChar.

При желании можно поиграться с чем угодно. Лишь бы время было лишнее. Часов пять-шесть

Желание было. Поигрался. Привожу вместе с результатами хронометража.

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

Private Declare Function OemToChar Lib "user32" Alias "OemToCharA" (ByVal lpszSrc As String, ByVal lpszDst As String) As Long
Private Declare Function GetTickCount Lib "kernel32" () As Long
Private Declare Function WideCharToMultiByte Lib "kernel32" (ByVal CodePage As Long, ByVal dwFlags As Long, ByVal lpWideCharStr As String, ByVal cchWideChar As Long, ByVal lpMultiByteStr As String, ByVal cchMultiByte As Long, ByVal lpDefaultChar As String, ByVal lpUsedDefaultChar As Long) As Long
Private Declare Function MultiByteToWideChar Lib "kernel32" (ByVal CodePage As Long, ByVal dwFlags As Long, ByVal lpMultiByteStr As String, ByVal cchMultiByte As Long, ByVal lpWideCharStr As String, ByVal cchWideChar As Long) As Long
Private Const CP_ACP = 0
Private Const CP_OEMCP = 1
Private Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (lpFunc As Any, ByVal Param1 As String, ByVal Param2 As Long, ByVal Param3 As String, ByVal Param4 As String) As Long
Private Asm(8) As Long

Sub Main()
Dim Conversion As String, Source As String, Dest As String, i As Long, Start As Long
Conversion = _
Chr(0) + Chr(1) + Chr(2) + Chr(3) + Chr(4) + Chr(5) + Chr(6) + Chr(7) + Chr(8) + Chr(9) + Chr(10) + Chr(11) + Chr(12) + Chr(13) + Chr(14) + Chr(164) + Chr(16) + Chr(17) + Chr(18) + Chr(19) + Chr(182) + Chr(167) + Chr(22) + Chr(23) + Chr(24) + Chr(25) + Chr(26) + Chr(27) + Chr(28) + Chr(29) + Chr(30) + Chr(31) + Chr(32) + Chr(33) + Chr(34) + Chr(35) + Chr(36) + Chr(37) + Chr(38) + Chr(39) + Chr(40) + Chr(41) + Chr(42) + Chr(43) + Chr(44) + Chr(45) + Chr(46) + Chr(47) + Chr(48) + Chr(49) + Chr(50) + Chr(51) + Chr(52) + Chr(53) + Chr(54) + Chr(55) + Chr(56) + Chr(57) + Chr(58) + Chr(59) + Chr(60) + Chr(61) + Chr(62) + Chr(63) + Chr(64) + _
Chr(65) + Chr(66) + Chr(67) + Chr(68) + Chr(69) + Chr(70) + Chr(71) + Chr(72) + Chr(73) + Chr(74) + Chr(75) + Chr(76) + Chr(77) + Chr(78) + Chr(79) + Chr(80) + Chr(81) + Chr(82) + Chr(83) + Chr(84) + Chr(85) + Chr(86) + Chr(87) + Chr(88) + Chr(89) + Chr(90) + Chr(91) + Chr(92) + Chr(93) + Chr(94) + Chr(95) + Chr(96) + Chr(97) + Chr(98) + Chr(99) + Chr(100) + Chr(101) + Chr(102) + Chr(103) + Chr(104) + Chr(105) + Chr(106) + Chr(107) + Chr(108) + Chr(109) + Chr(110) + Chr(111) + Chr(112) + Chr(113) + Chr(114) + Chr(115) + Chr(116) + Chr(117) + Chr(118) + Chr(119) + Chr(120) + Chr(121) + Chr(122) + Chr(123) + Chr(124) + _
Chr(125) + Chr(126) + Chr(127) + Chr(192) + Chr(193) + Chr(194) + Chr(195) + Chr(196) + Chr(197) + Chr(198) + Chr(199) + Chr(200) + Chr(201) + Chr(202) + Chr(203) + Chr(204) + Chr(205) + Chr(206) + Chr(207) + Chr(208) + Chr(209) + Chr(210) + Chr(211) + Chr(212) + Chr(213) + Chr(214) + Chr(215) + Chr(216) + Chr(217) + Chr(218) + Chr(219) + Chr(220) + Chr(221) + Chr(222) + Chr(223) + Chr(224) + Chr(225) + Chr(226) + Chr(227) + Chr(228) + Chr(229) + Chr(230) + Chr(231) + Chr(232) + Chr(233) + Chr(234) + Chr(235) + Chr(236) + Chr(237) + Chr(238) + Chr(239) + Chr(45) + Chr(45) + Chr(45) + Chr(166) + Chr(43) + Chr(166) + _
Chr(166) + Chr(172) + Chr(172) + Chr(166) + Chr(166) + Chr(172) + Chr(45) + Chr(45) + Chr(45) + Chr(172) + Chr(76) + Chr(43) + Chr(84) + Chr(43) + Chr(45) + Chr(43) + Chr(166) + Chr(166) + Chr(76) + Chr(227) + Chr(166) + Chr(84) + Chr(166) + Chr(61) + Chr(43) + Chr(166) + Chr(166) + Chr(84) + Chr(84) + Chr(76) + Chr(76) + Chr(45) + Chr(227) + Chr(43) + Chr(43) + Chr(45) + Chr(45) + Chr(45) + Chr(45) + Chr(166) + Chr(166) + Chr(45) + Chr(240) + Chr(241) + Chr(242) + Chr(243) + Chr(244) + Chr(245) + Chr(246) + Chr(247) + Chr(248) + Chr(249) + Chr(250) + Chr(251) + Chr(252) + Chr(253) + Chr(254) + Chr(255) + Chr(168) + _
Chr(184) + Chr(170) + Chr(186) + Chr(175) + Chr(191) + Chr(161) + Chr(162) + Chr(176) + Chr(149) + Chr(183) + Chr(118) + Chr(185) + Chr(164) + Chr(166) + Chr(160)
Source = "‘кҐим Ґйс нвЁе ¬пЈЄЁе да ­жг§бЄЁе Ўг«®Є, ¤  ўлЇҐ© © ¤г."

Dest = Space(Len(Source))
Start = GetTickCount
For i = 1 To 500000
    OemToChar Source, Dest
Next
Debug.Print "OemToChar: " & GetTickCount - Start
Debug.Print Dest

Dim Unicode As String: Unicode = Space(LenB(Source))
Dest = Space(Len(Source))
Start = GetTickCount
For i = 1 To 500000
    MultiByteToWideChar CP_OEMCP, 0, Source, Len(Source), Unicode, Len(Unicode)
    WideCharToMultiByte CP_ACP, 0, Unicode, Len(Unicode), Dest, Len(Dest), vbNullString, 0
Next
Debug.Print "WideChar<->MultiByte: " & GetTickCount - Start
Debug.Print Dest

Dest = Space(Len(Source))
Start = GetTickCount
For i = 1 To 50000 '10 times less
    Dest = Recode(Source, Dos, Win)
Next
Debug.Print "ReCode.bas: " & GetTickCount - Start
Debug.Print Dest

LoadAsm
Dest = Space(Len(Source))
Start = GetTickCount
For i = 1 To 500000
    Xlat Source, Len(Source), Dest, Conversion
Next
Debug.Print "XLAT: " & GetTickCount - Start
Debug.Print Dest

End Sub

Sub LoadAsm()
Asm(0) = &H53EC8B55
Asm(1) = &H8B575651
Asm(2) = &H4D8B145D
Asm(3) = &H8758B0C
Asm(4) = &HB107D8B
Asm(5) = &HAC0574C9
Asm(6) = &HFBE2AAD7
Asm(7) = &H5B595E5F
Asm(8) = &H10C2C9
End Sub

Private Sub Xlat(Source As String, ByVal Count As Long, Dest As String, Conversion As String)
    CallWindowProc Asm(0), Source, Count, Dest, Conversion
End Sub


Результаты, округлённые до двух значащих цифр:

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

OemToChar:            1000
WideChar<->MultiByte: 2500
ReCode.bas от BV:     33000
мой XLAT:             2700


Выводы очевидны.

[hCORe]

Выводы интересны... WideCharToMultiByte оказалась медленнее OemToChar. Не ожидал. Думал, что OemToChar просто "заглушка". Оказалось нет, и, ясное дело - узкоспециализированная функция работает быстрее. Эх, почему нет функций CharToKOI8 и KOI8ToChar?

[tyomitch]

А это потому, что внутри OemToChar тот же XLAT сидит, а таблица перекодировки один раз генерируется из WideChar<->MultiByte.
А для перекодировки Char<->KOI8 придётся юзать мой код
Тормоза у него, видимо, из-за CallWindowProc и связанных с ним накладных расходов.