Распознавание кодировки. Перекодировка.
Алгоритм распознавания кодировки нужен для автоматического декодирования текста. Этот алгоритм основан на том, что некоторые буквы русского алфавита встречается очень часто, а некоторые редко. Поскольку этот способ статистический, то лучше всего он работает с большими текстами.
Code: |
type TCode = (win, koi, iso, dos);
const CodeStrings: array [TCode] of string = ('win','koi','iso','dos');
procedure TForm1.Button1Click(Sender: TObject); var str: array [TCode] of string; norm: array ['А'..'я'] of single; code1, code2: TCode; min1, min2: TCode; count: array [char] of integer; d, min: single; s, so: string; chars: array [char] of char; c: char; i: integer; begin so := Memo1.Text;
norm['А'] := 0.001; norm['Б'] := 0; norm['В'] := 0.002; norm['Г'] := 0; norm['Д'] := 0.001; norm['Е'] := 0.001; norm['Ж'] := 0; norm['З'] := 0; norm['И'] := 0.001; norm['Й'] := 0; norm['К'] := 0.001; norm['Л'] := 0; norm['М'] := 0.001; norm['Н'] := 0.001; norm['О'] := 0.001; norm['П'] := 0.002; norm['Р'] := 0.002; norm['С'] := 0.001; norm['Т'] := 0.001; norm['У'] := 0; norm['Ф'] := 0; norm['Х'] := 0; norm['Ц'] := 0; norm['Ч'] := 0.001; norm['Ш'] := 0.001; norm['Щ'] := 0; norm['Ъ'] := 0; norm['Ы'] := 0; norm['Ь'] := 0; norm['Э'] := 0.001; norm['Ю'] := 0; norm['Я'] := 0; norm['а'] := 0.057; norm['б'] := 0.01; norm['в'] := 0.031; norm['г'] := 0.011; norm['д'] := 0.021; norm['е'] := 0.067; norm['ж'] := 0.007; norm['з'] := 0.013; norm['и'] := 0.052; norm['й'] := 0.011; norm['к'] := 0.023; norm['л'] := 0.03; norm['м'] := 0.024; norm['н'] := 0.043; norm['о'] := 0.075; norm['п'] := 0.026; norm['р'] := 0.038; norm['с'] := 0.034; norm['т'] := 0.046; norm['у'] := 0.016; norm['ф'] := 0.001; norm['х'] := 0.006; norm['ц'] := 0.002; norm['ч'] := 0.011; norm['ш'] := 0.004; norm['щ'] := 0.004; norm['ъ'] := 0; norm['ы'] := 0.012; norm['ь'] := 0.012; norm['э'] := 0.003; norm['ю'] := 0.005; norm['я'] := 0.015;
Str[win] := 'АаБбВвГгДдЕеЖжЗзИиЙйКкЛлМмНнОоПпРрСсТтУуФфХхЦцЧчШшЩщЪъЫыЬьЭэЮюЯя'; Str[koi] := 'юЮаАбБцЦдДеЕфФгГхХиИйЙкКлЛмМнНоОпПяЯрРсСтТуУжЖвВьЬыЫзЗшШэЭщЩчЧъЪ'; Str[iso] := 'РрСсТтУуФфХхЦцЧчШшЩщЪъЫыЬьЭэЮюЯяа№бёвђгѓдєеѕжізїијйљкњлћмќн§оўпџ'; Str[dos] := 'Ђ ЃЎ‚ўѓЈ"¤…Ґ†¦‡§€Ё‰©ЉЄ‹"ЊЌЋ®ЏЇђа'б'в"г"дoе-ж-зи™йљк›лњмќнћоџпз?и™йљк›лњмќнћоџп'; for c := #0 to #255 do Chars[c] := c;
min1 := win; min2 := win; min := 0; s := so; fillchar(count, sizeof(count), 0); for i := 1 to Length(s) do inc(count[s[i]]); for c := 'А' to 'я' do min := min + sqr(count[c] / Length(s) - norm[c]); for code1 := low(TCode) to high(TCode) do begin for code2 := low(TCode) to high(TCode) do begin if code1 = code2 then continue;
s := so; for i := 1 to Length(Str[win]) do Chars[Str[code2][i]] := Str[code1][i]; for i := 1 to Length(s) do s[i] := Chars[s[i]]; fillchar(count, sizeof(count), 0); for i := 1 to Length(s) do inc(count[s[i]]); d := 0; for c := 'А' to 'я' do d := d + sqr(count[c] / Length(s) - norm[c]); if d < min then begin min1 := code1; min2 := code2; min := d; end; end; end;
s := Memo1.Text; if min1 <> min2 then begin for c := #0 to #255 do Chars[c] := c; for i := 1 to Length(Str[win]) do Chars[Str[min2][i]] := Str[min1][i]; for i := 1 to Length(s) do s[i] := Chars[s[i]]; end; Form1.Caption := CodeStrings[min2] + ' ' + CodeStrings[min1];
Memo2.Text := s; end;
|
Просьба писать ваши замечания, наблюдения и все остальное,
что поможет улучшить предоставляемую информацию на этом сайте.
ВСЕ КОММЕНТАРИИ МОДЕРИРУЮТСЯ ВРУЧНУЮ, ТАК ЧТО СПАМИТЬ БЕСПОЛЕЗНО!