Экспертная система Delphi.int.ru

Сообщество программистов
Общение, помощь, обмен опытом

Логин:
Пароль:
Регистрация | Забыли пароль?

Delphi.int.ru Expert

Другие разделы портала

Переход к вопросу:

#   

Статистика за сегодня:  


Лучшие эксперты

DNK
I. DNK
Баллы: 5

Подробнее »



Вопрос # 1 863

/ вопрос открыт /

Приветствую, уважаемые эксперты!
В memo есть текст, полученный из консоли. Из-за разной кодировки в нем русский текст отображается иероглифами. Как автоматически определить какая кодировка в memo, Dos или Windows?

Евгений Eklmn Вопрос ожидает решения (принимаются ответы, доступен мини-форум)

Вопрос задал: Евгений Eklmn (статус: Посетитель)
Вопрос отправлен: 29 августа 2008, 10:03
Состояние вопроса: открыт, ответов: 1.

Ответ #1. Отвечает эксперт: Feniks

Здравствуйте, Трофимов Евгений!
Алгоритм распознавания кодировки нужен для автоматического декодирования текста. Этот алгоритм основан на том, что некоторые буквы русского алфавита встречается очень часто, а некоторые редко. Поскольку этот способ статистический, то лучше всего он работает с большими текстами.
Держите в Приложении несколько примеров для автоопределения кодировки и ее конвертации.

P.S. Желаю удачи.

Приложение:
  1.  
  2.  
  3. type
  4. TCode = (win, koi, iso, dos);
  5.  
  6. const
  7. CodeStrings: array [TCode] of string = ('win','koi','iso','dos');
  8.  
  9. procedure TForm1.Button1Click(Sender: TObject);
  10. var
  11. str: array [TCode] of string;
  12.  
  13. code1, code2: TCode;
  14. min1, min2: TCode;
  15. count: array [char] of integer;
  16. d, min: single;
  17. s, so: string;
  18. chars: array [char] of char;
  19. c: char;
  20. i: integer;
  21. begin
  22. so := Memo1.Text;
  23.  
  24.  
  25.  
  26.  
  27.  
  28.  
  29.  
  30.  
  31.  
  32.  
  33.  
  34.  
  35.  
  36.  
  37.  
  38.  
  39.  
  40.  
  41.  
  42.  
  43.  
  44.  
  45.  
  46.  
  47.  
  48.  
  49.  
  50.  
  51.  
  52.  
  53.  
  54.  
  55.  
  56.  
  57.  
  58.  
  59.  
  60.  
  61.  
  62.  
  63.  
  64.  
  65.  
  66.  
  67.  
  68.  
  69.  
  70.  
  71.  
  72.  
  73.  
  74.  
  75.  
  76.  
  77.  
  78.  
  79.  
  80.  
  81.  
  82.  
  83.  
  84.  
  85.  
  86.  
  87.  
  88.  
  89.  
  90.  
  91.  
  92.  
  93. for c := #0 to #255 do
  94. Chars[c] := c;
  95.  
  96. min1 := win;
  97. min2 := win;
  98. min := 0;
  99. s := so;
  100. fillchar(count, sizeof(count), 0);
  101. for i := 1 to Length(s) do
  102. inc(count[s[i]]);
  103.  
  104. min := min + sqr(count[c] / Length(s) - norm[c]);
  105. for code1 := low(TCode) to high(TCode) do
  106. begin
  107. for code2 := low(TCode) to high(TCode) do
  108. begin
  109. if code1 = code2 then
  110. continue;
  111.  
  112. s := so;
  113. for i := 1 to Length(Str[win]) do
  114. Chars[Str[code2][i]] := Str[code1][i];
  115. for i := 1 to Length(s) do
  116. s[i] := Chars[s[i]];
  117. fillchar(count, sizeof(count), 0);
  118. for i := 1 to Length(s) do
  119. inc(count[s[i]]);
  120. d := 0;
  121.  
  122. d := d + sqr(count[c] / Length(s) - norm[c]);
  123. if d < min then
  124. begin
  125. min1 := code1;
  126. min2 := code2;
  127. min := d;
  128. end;
  129. end;
  130. end;
  131.  
  132. s := Memo1.Text;
  133. if min1 <> min2 then
  134. begin
  135. for c := #0 to #255 do
  136. Chars[c] := c;
  137. for i := 1 to Length(Str[win]) do
  138. Chars[Str[min2][i]] := Str[min1][i];
  139. for i := 1 to Length(s) do
  140. s[i] := Chars[s[i]];
  141. end;
  142. Form1.Caption := CodeStrings[min2] + ' ' + CodeStrings[min1];
  143.  
  144. Memo2.Text := s;
  145. end;
  146.  
  147.  
  148.  
  149.  
  150. type
  151. TCodePage = (cpWin1251, cp866, cpKOI8R);
  152. PMap = ^TMap;
  153. TMap = array[#$80..#$FF] of Char;
  154.  
  155. function GetMap(CP: TCodePage): PMap;
  156.  
  157.  
  158. begin
  159. GetMap := nil;
  160. end;
  161.  
  162. function DetermineRussian(Buf: PChar; Count: Integer): TCodePage;
  163. const
  164. ModelBigrams: array[0..33, 0..33] of Byte = (
  165.  
  166.  
  167. 1, 5, 13, 24, 17, 12, 4, 0, 0, 0, 0, 14, 31, 205, 1),
  168.  
  169. 1, 0, 0, 6, 16, 37, 0, 0, 0, 4, 3, 0),
  170.  
  171. 1, 0, 0, 8, 1, 0, 40, 1, 0, 0, 5, 106, 3),
  172.  
  173. 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 8, 0),
  174.  
  175. 2, 1, 0, 1, 0, 1, 9, 4, 0, 1, 5, 17, 4),
  176.  
  177. 81, 1, 0, 15, 5, 12, 10, 6, 0, 0, 0, 0, 3, 4, 235, 1),
  178.  
  179. 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 2, 2),
  180.  
  181. 0, 0, 0, 0, 0, 16, 6, 0, 1, 4, 17, 0),
  182.  
  183. 0, 5, 25, 14, 28, 4, 1, 0, 0, 0, 0, 9, 56, 255, 0),
  184.  
  185. 1, 0, 0, 0, 0, 0, 0, 0, 122, 0),
  186.  
  187. 0, 11, 0, 0, 0, 0, 0, 0, 0, 0, 0, 5, 5, 0),
  188.  
  189. 0, 2, 0, 0, 0, 9, 66, 0, 15, 43, 57, 4),
  190.  
  191. 0, 0, 0, 0, 0, 28, 0, 0, 0, 8, 109, 3),
  192. {}(139, 0, 0, 1, 11, 108, 0, 4, 152, 0, 7, 0, 1, 69, 161, 0, 0, 8, 25, 24,
  193. 5, 1, 5, 2, 0, 1, 0, 83, 10, 0, 1, 29, 38, 5),
  194.  
  195. 98, 1, 2, 6, 6, 19, 15, 2, 0, 0, 0, 1, 4, 9, 252, 2),
  196.  
  197. 0, 0, 0, 0, 0, 3, 6, 0, 0, 3, 2, 2),
  198.  
  199. 5, 0, 1, 3, 0, 0, 24, 7, 0, 1, 10, 22, 5),
  200.  
  201. 16, 0, 4, 1, 4, 1, 0, 0, 8, 25, 0, 1, 50, 41, 2),
  202.  
  203. 0, 1, 4, 0, 0, 0, 20, 78, 0, 0, 5, 82, 4),
  204.  
  205. 3, 0, 12, 5, 8, 0, 0, 0, 0, 22, 1, 65, 0),
  206.  
  207. 0, 0, 0, 0, 0, 0, 0, 0, 2, 0),
  208.  
  209. 0, 0, 0, 0, 0, 0, 0, 0, 76, 0),
  210.  
  211. 0, 0, 0, 0, 2, 0, 0, 0, 0, 3, 0),
  212.  
  213. 0, 0, 1, 0, 0, 0, 1, 0, 0, 0, 2, 2),
  214.  
  215. 0, 0, 0, 0, 0, 3, 0, 0, 0, 1, 1),
  216.  
  217. 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 1),
  218.  
  219. 0, 0, 0, 0, 0, 0, 1, 1, 0, 0),
  220.  
  221. 0, 3, 4, 0, 0, 0, 0, 0, 0, 1, 84, 0),
  222.  
  223. 0, 6, 0, 0, 0, 0, 0, 6, 4, 117, 0),
  224.  
  225. 0, 0, 0, 0, 0, 0, 0, 0, 0, 0),
  226.  
  227. 1, 15, 0, 0, 0, 0, 0, 0, 38, 0),
  228.  
  229. 1, 0, 3, 0, 0, 0, 0, 5, 2, 177, 0),
  230. {_}(42, 80, 193, 43, 109, 41, 18, 53, 159, 0, 144, 27, 83, 176, 187, 229,
  231. 70, 231, 99, 47, 15, 13, 6, 58, 7, 0, 0, 0, 0, 38, 0, 22, 0, 2),
  232. {?}(0, 0, 0, 0, 3, 0, 0, 0, 0, 0, 2, 4, 4, 8, 0, 0, 5, 3, 4, 0, 0, 0, 0, 0,
  233. 0, 0, 0, 0, 0, 0, 0, 0, 0, 0));
  234.  
  235.  
  236. type
  237. TVariation = array[0..33, 0..33] of Integer;
  238. var
  239. I, J, iC, iPredC, Max: Integer;
  240. C: Char;
  241. CP: TCodePage;
  242. D, MinD, Factor: Double;
  243. AMap: PMap;
  244. PV: ^TVariation;
  245. Vars: array[TCodePage] of TVariation;
  246. begin
  247.  
  248.  
  249. FillChar(Vars, SizeOf(Vars), 0);
  250. for CP := Low(Vars) to High(Vars) do
  251. begin
  252. AMap := GetMap(CP);
  253. PV := @Vars[CP];
  254. iPredC := 32;
  255. for I := 0 to Count - 1 do
  256. begin
  257. C := Buf[I];
  258. iC := 32;
  259. if C > = #128 then
  260. begin
  261. if AMap < > nil then
  262. C := AMap^[C];
  263. if not (C in ['?', '?']) then
  264. begin
  265.  
  266.  
  267.  
  268. end
  269. else
  270. iC := 33;
  271. end;
  272. Inc(PV^[iPredC, iC]);
  273. iPredC := iC;
  274. end;
  275. end;
  276.  
  277. MinD := 0;
  278. for CP := Low(Vars) to High(Vars) do
  279. begin
  280. PV := @Vars[CP];
  281. PV^[32, 32] := 0;
  282. Max := 1;
  283. for I := 0 to 33 do
  284. for J := 0 to 33 do
  285. if PV^[I, J] > Max then
  286. Max := PV^[I, J];
  287.  
  288. D := 0;
  289. for I := 0 to 33 do
  290. for J := 0 to 33 do
  291. D := D + Abs(PV^[I, J] * Factor - ModelBigrams[I, J]);
  292. if (MinD = 0) or (D < MinD) then
  293. begin
  294. MinD := D;
  295. DetermineRussian := CP;
  296. end;
  297. end;
  298. end;
  299.  
  300. begin
  301.  
  302.  
  303. writeln(DetermineRussian(#$CF#$F0#$E8#$EC#$E5#$F0, 6) = cpWin1251);
  304. writeln(DetermineRussian(#$8F#$E0#$A8#$AC#$A5#$E0, 6) = cp866);
  305. writeln(DetermineRussian(#$F0#$D2#$C9#$CD#$C5#$D2, 6) = cpKOI8R);
  306. readln;
  307. end.


Ответ отправил: Feniks (статус: Бакалавр)
Время отправки: 29 августа 2008, 11:56
Оценка за ответ: 5


Мини-форум вопроса

Всего сообщений: 3; последнее сообщение — 29 августа 2008, 17:41; участников в обсуждении: 2.
Вадим К

Вадим К (статус: Академик), 29 августа 2008, 13:41 [#1]:

а зачем определять? если известно, что текст получен с консоли, так берём и коневертируем. Практически всегда он будет в DOS кодировке (866).
Галочка "подтверждения прочтения" - вселенское зло.
Евгений Eklmn

Евгений Eklmn (статус: Посетитель), 29 августа 2008, 17:13 [#2]:

Текст в memo может быть как в Win кодировке, так и в Dos (я забыл упомянуть о том, что текст в memo загружается из файла, а файл может быть получен из консоли).
Генерация случайных чисел - слишком важный вопрос, чтобы оставлять его на волю случая. (Роберт Ковзю, Окриджская лаборатория)
Вадим К

Вадим К (статус: Академик), 29 августа 2008, 17:41 [#3]:

а, ну так другое дело. тогда только частотный анализ спасёт Вас. Но он хорошо работает на чистых больших текстах.
Галочка "подтверждения прочтения" - вселенское зло.

Чтобы оставлять сообщения в мини-форумах, Вы должны авторизироваться на сайте.

Версия движка: 2.6+ (26.01.2011)
Текущее время: 20 августа 2017, 04:59
Выполнено за 0.03 сек.
Рейтинг@Mail.ru