Статьи Королевства Дельфи
Decod
 | "Knowledge itself is power" F.Bacon |
| Разное |
Раздел Сокровищница
(17.01.00)
(21.01.00)
(31.01.00)
(31.01.00)
(01.09.00)
Вариант №5 (01.09.00) Автор: Павленко Алексей
Я же делал несколько по-другому, вернее больше: Взял стандартные таблицы из FARа. Достаточно иметь iso2dos.tbl (двоичные файлы длиной 256 байт, сейчас их буду прилинковывать к exe, как это сделать, посоветуете?)
koi2dos.tbl
mac2dos.tbl
win2dos.tbl
При запуске программы читаю таблицы и запоминаю в массивах type ChTable=array [0..255] of byte; var iso2dos, koi2dos, mac2dos, win2dos: ChTable; После этого легко переводить из одной кодировки в другую. Для этого надо заполнить массив t: ChTable; Есть несколько вариантов: 1) Переводим в ДОС case fm.cbCharsetIn.ItemIndex of 1: t:=win2dos; 2: t:=koi2dos; 3: t:=iso2dos; 4: t:=mac2dos; end; 2) Переводим из ДОС case fm.cbCharsetOut.ItemIndex of 1: t2:=win2dos; 2: t2:=koi2dos; 3: t2:=iso2dos; 4: t2:=mac2dos; end; for i:=128 to 255 do t[t2[i]]:=i; for i:=0 to 127 do t[i]:=i; 3) Не ДОС-кодировки // из входной кодировки в ДОС case fm.cbCharsetIn.ItemIndex of 1: t1:=win2dos; 2: t1:=koi2dos; 3: t1:=iso2dos; 4: t1:=mac2dos; end; // таблица для ДОС->выходная case fm.cbCharsetOut.ItemIndex of 1: t2:=win2dos; 2: t2:=koi2dos; 3: t2:=iso2dos; 4: t2:=mac2dos; end; for i:=128 to 255 do t3[t2[i]]:=i; for i:=0 to 127 do t3[i]:=i; // теперь уже окончательная таблица для входной кодировки в выходную for i:=0 to 255 do t[i]:=t3[t1[i]]; Ну а сам перевод делается уже легко: while not eof(f) do begin readln(f, s); s2:=''; for i:=1 to Length(s) do s2:=s2+chr(t[byte(s[i])]); writeln(fout, s2); end; Вроде еще быстрее сделать невозможно. Но это только теоретически ;)
Готовую программу можно скачать с
Вариант №4 (31.01.00) Автор: Еремеев Алексей
const Koi = 'юабцдефгхийклмнопярстужвьызшэщчъЮАБЦДЕФГХИЙКЛМНОПЯРСТУЖВЬЫЗШЭЩЧЪ'; Win = 'бвчздецъйклмнопртуфхжигюыэящшьасБВЧЗДЕЦЪЙКЛМНОПРТУФХЖИГЮЫЭЯЩШЬАС'; SerH = 'АБВГДЕЖЗИЙКЛМНОПРСТУФХЦЧШЩЪЫЬЭЮЯ'; SerL = 'абвгдежзийклмнопрстуфхцчшщъыьэюя'; procedure ANSI2KOI(var Str: string); var i: integer; k: byte; begin for i := 1 to Length(Str) do begin k := byte(Str[i]); if k = $B8 then Str[i] := char($A3) else if k = $A8 then Str[i] := char($B3) else if k > $BF then Str[i] := Win[k - $BF]; end; end; procedure KOI2ANSI(var Str: string); var i: integer; k: byte; begin for i := 1 to Length(Str) do begin k := byte(Str[i]); if k = $A3 then Str[i] := 'ё' else if k = $B3 then Str[i] := 'Ё' else if k > $BF then Str[i] := Koi[k - $BF]; end; end; procedure ANSI2IBM(var Str: string); var i: integer; k: byte; begin for i := 1 to Length(Str) do begin k := byte(Str[i]); if k = $B8 then Str[i] := char($F1) else if k = $A8 then Str[i] := char($F0) else if k > $EF then Str[i] := char(k - 16) else if (k > $BF) and (k < $F0) then Str[i] := char(k - 64); end; end; procedure IBM2ANSI(var Str: string); var i: integer; k: byte; begin for i := 1 to Length(Str) do begin k := byte(Str[i]); if k = $F0 then Str[i] := 'Ё' else if k = $F1 then Str[i] := 'ё' else if (k > $7F) and (k < $A0) then Str[i] := SerH[k - $7F] else if (k > $9F) and (k < $B0) then Str[i] := SerL[k - $9F] else if (k > $DF) and (k < $F0) then Str[i] := SerL[k - $CF]; end; end; procedure ANSI2Mac(var Str: string); var i: integer; k: byte; begin for i := 1 to Length(Str) do begin k := byte(Str[i]); if k = $A8 then Str[i] := char($DD) else if k = $B8 then Str[i] := char($DE) else if k = $FF then Str[i] := char($DF) else if (k > $BF) and (k < $E0) then Str[i] := char(k - 64); end; end; procedure Mac2ANSI(var Str: string); var i: integer; k: byte; begin for i := 1 to Length(Str) do begin k := byte(Str[i]); if k = $DD then Str[i] := 'Ё' else if k = $DE then Str[i] := 'ё' else if k = $DF then Str[i] := 'я' else if (k > $7F) and (k < $A0) then Str[i] := SerH[k - $7F] else if (k > $DF) and (k < $FF) then Str[i] := SerL[k - $DF]; end; end; procedure ANSI2ISO(var Str: string); var i: integer; k: byte; begin for i := 1 to Length(Str) do begin k := byte(Str[i]); if k = $A8 then Str[i] := char($A1) else if k = $B8 then Str[i] := char($F1) else if k > $BF then Str[i] := char(k - 16); end; end; procedure ISO2ANSI(var Str: string); var i: integer; k: byte; begin for i := 1 to Length(Str) do begin k := byte(Str[i]); if k = $A1 then Str[i] := 'Ё' else if k = $F1 then Str[i] := 'ё' else if k < $F0 then begin if k > $CF then Str[i] := SerL[k - $CF] else if k > $AF then Str[i] := SerH[k - $AF]; end; end; end;
