| 
| 
 | Вопрос # 1 863/ вопрос открыт / | 
 |  Приветствую, уважаемые эксперты!В memo есть текст, полученный из консоли. Из-за разной кодировки в нем русский текст отображается иероглифами. Как автоматически определить какая кодировка в memo, Dos или Windows?
 
|  |   Вопрос задал: Евгений Eklmn (статус: Посетитель)Вопрос отправлен: 29 августа 2008, 10:03
 Состояние вопроса: открыт, ответов: 1.
 |  Ответ #1. Отвечает эксперт: Feniks Здравствуйте, Трофимов Евгений!Алгоритм распознавания кодировки нужен для автоматического декодирования текста. Этот алгоритм основан на том, что некоторые буквы русского алфавита встречается очень часто, а некоторые редко. Поскольку этот способ статистический, то лучше всего он работает с большими текстами.
 Держите в Приложении несколько примеров для автоопределения кодировки и ее конвертации.
 
 P.S. Желаю удачи.
 Приложение:Переключить в обычный режим   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;   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;                                                                        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]]);     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;         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;    type  TCodePage = (cpWin1251, cp866, cpKOI8R);  PMap = ^TMap;  TMap = array[#$80..#$FF] of Char; function GetMap(CP: TCodePage): PMap;  begin  GetMap := nil;end; function DetermineRussian(Buf: PChar; Count: Integer): TCodePage;const  ModelBigrams: array[0..33, 0..33] of Byte = (        1, 5, 13, 24, 17, 12, 4, 0, 0, 0, 0, 14, 31, 205, 1),       1, 0, 0, 6, 16, 37, 0, 0, 0, 4, 3, 0),       1, 0, 0, 8, 1, 0, 40, 1, 0, 0, 5, 106, 3),       0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 8, 0),       2, 1, 0, 1, 0, 1, 9, 4, 0, 1, 5, 17, 4),       81, 1, 0, 15, 5, 12, 10, 6, 0, 0, 0, 0, 3, 4, 235, 1),       0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 2, 2),       0, 0, 0, 0, 0, 16, 6, 0, 1, 4, 17, 0),       0, 5, 25, 14, 28, 4, 1, 0, 0, 0, 0, 9, 56, 255, 0),       1, 0, 0, 0, 0, 0, 0, 0, 122, 0),       0, 11, 0, 0, 0, 0, 0, 0, 0, 0, 0, 5, 5, 0),       0, 2, 0, 0, 0, 9, 66, 0, 15, 43, 57, 4),       0, 0, 0, 0, 0, 28, 0, 0, 0, 8, 109, 3),    {}(139, 0, 0, 1, 11, 108, 0, 4, 152, 0, 7, 0, 1, 69, 161, 0, 0, 8, 25, 24,      5, 1, 5, 2, 0, 1, 0, 83, 10, 0, 1, 29, 38, 5),       98, 1, 2, 6, 6, 19, 15, 2, 0, 0, 0, 1, 4, 9, 252, 2),       0, 0, 0, 0, 0, 3, 6, 0, 0, 3, 2, 2),       5, 0, 1, 3, 0, 0, 24, 7, 0, 1, 10, 22, 5),       16, 0, 4, 1, 4, 1, 0, 0, 8, 25, 0, 1, 50, 41, 2),       0, 1, 4, 0, 0, 0, 20, 78, 0, 0, 5, 82, 4),       3, 0, 12, 5, 8, 0, 0, 0, 0, 22, 1, 65, 0),       0, 0, 0, 0, 0, 0, 0, 0, 2, 0),       0, 0, 0, 0, 0, 0, 0, 0, 76, 0),       0, 0, 0, 0, 2, 0, 0, 0, 0, 3, 0),       0, 0, 1, 0, 0, 0, 1, 0, 0, 0, 2, 2),       0, 0, 0, 0, 0, 3, 0, 0, 0, 1, 1),       0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 1),       0, 0, 0, 0, 0, 0, 1, 1, 0, 0),       0, 3, 4, 0, 0, 0, 0, 0, 0, 1, 84, 0),       0, 6, 0, 0, 0, 0, 0, 6, 4, 117, 0),       0, 0, 0, 0, 0, 0, 0, 0, 0, 0),       1, 15, 0, 0, 0, 0, 0, 0, 38, 0),       1, 0, 3, 0, 0, 0, 0, 5, 2, 177, 0),    {_}(42, 80, 193, 43, 109, 41, 18, 53, 159, 0, 144, 27, 83, 176, 187, 229,      70, 231, 99, 47, 15, 13, 6, 58, 7, 0, 0, 0, 0, 38, 0, 22, 0, 2),    {?}(0, 0, 0, 0, 3, 0, 0, 0, 0, 0, 2, 4, 4, 8, 0, 0, 5, 3, 4, 0, 0, 0, 0, 0,      0, 0, 0, 0, 0, 0, 0, 0, 0, 0));  type  TVariation = array[0..33, 0..33] of Integer;var  I, J, iC, iPredC, Max: Integer;  C: Char;  CP: TCodePage;  D, MinD, Factor: Double;  AMap: PMap;  PV: ^TVariation;  Vars: array[TCodePage] of TVariation;begin    FillChar(Vars, SizeOf(Vars), 0);  for CP := Low(Vars) to High(Vars) do  begin    AMap := GetMap(CP);    PV := @Vars[CP];    iPredC := 32;    for I := 0 to Count - 1 do    begin      C := Buf[I];      iC := 32;      if C > = #128 then      begin        if AMap < > nil then          C := AMap^[C];        if not (C in ['?', '?']) then        begin           end        else          iC := 33;      end;      Inc(PV^[iPredC, iC]);      iPredC := iC;    end;  end;   MinD := 0;  for CP := Low(Vars) to High(Vars) do  begin    PV := @Vars[CP];    PV^[32, 32] := 0;    Max := 1;    for I := 0 to 33 do      for J := 0 to 33 do        if PV^[I, J] > Max then          Max := PV^[I, J];     D := 0;    for I := 0 to 33 do      for J := 0 to 33 do        D := D + Abs(PV^[I, J] * Factor - ModelBigrams[I, J]);    if (MinD = 0) or (D < MinD) then    begin      MinD := D;      DetermineRussian := CP;    end;  end;end; begin    writeln(DetermineRussian(#$CF#$F0#$E8#$EC#$E5#$F0, 6) = cpWin1251);  writeln(DetermineRussian(#$8F#$E0#$A8#$AC#$A5#$E0, 6) = cp866);  writeln(DetermineRussian(#$F0#$D2#$C9#$CD#$C5#$D2, 6) = cpKOI8R);  readln;end.
|  | Ответ отправил: Feniks (статус: Бакалавр)Время отправки: 29 августа 2008, 11:56
 Оценка за ответ: 5
 |  
 Мини-форум вопросаВсего сообщений: 3; последнее сообщение — 29 августа 2008, 17:41; участников в обсуждении: 2. 
|   | Вадим К (статус: Академик), 29 августа 2008, 13:41 [#1]:а зачем определять? если известно, что текст получен с консоли, так берём и коневертируем. Практически всегда он будет в DOS кодировке (866). Галочка "подтверждения прочтения" - вселенское зло. |  
|   | Евгений Eklmn (статус: Посетитель), 29 августа 2008, 17:13 [#2]:Текст в memo может быть как в Win кодировке, так и в Dos (я забыл упомянуть о том, что текст в memo загружается из файла, а файл может быть получен из консоли). Генерация случайных чисел - слишком важный вопрос, чтобы оставлять его на волю случая. (Роберт Ковзю, Окриджская лаборатория) |  
|   | Вадим К (статус: Академик), 29 августа 2008, 17:41 [#3]:а, ну так другое дело. тогда только частотный анализ спасёт Вас. Но он хорошо работает на чистых больших текстах. Галочка "подтверждения прочтения" - вселенское зло. |  Чтобы оставлять сообщения в мини-форумах, Вы должны авторизироваться на сайте. |