{* Авто-перекодировка русского текста в Win1251 *}

Unit CODER;
Interface
Implementation
Begin
 writeln(' Авто-перекодировка русского текста в Win1251');
End.

Program pas;

Uses coder.pas; {* Эту строку можно удалить *}
From demos!dnews!news.demos.su!L - relcom Wed Jan 26 16 : 21 : 25 2000  Received : by infolink.tver.su (UUPC / @ v6.20, 03Nov96) with UUCP            id AA10575;
Wed, 26 Jan 2000 16 : 21 : 25 + 0300 (MSK)  Received : by kremvax.demos.su (uumail v3.2.4 / D)
For vot;
  Tue, 25 Jan 2000 11 : 59 : 15 + 0300  Received : by news.demos.su (uumail v3.2.6 / D)
For vot@infolink.tver.su;
  Tue, 25 Jan 2000 11 : 58 : 06 + 0300  X - Class : Slow  Precedence : junk  To : netters  Sender : L - relcom@news.demos.su  From : "Serge Perevoznyk"   Newsgroups : relcom.comp.lang.pascal  Subject : [NEWS] Re : Перекодировка писем  Date : Tue, 25 Jan 2000 10 : 57 : 01 + 0200  Organization : "CINET NNTP - service"  Message - ID :   References :   NNTP - Posting - Host : ppp00 - 11 - 204.ci.net.ua  X - Priority : 3  X - MSMail - Priority : Normal  X - Newsreader : Microsoft Outlook Express 5.00.2417.2000  X - MimeOLE : Produced By Microsoft MimeOLE V5.00.2314.1300  Xref : demos relcom.comp.lang.pascal : 20858  Lines : 203  MIME - Version : 1.0  Content -
Type {* Используемые типы *}
  : text / plain;
  charset = x - cp866  Content - Transfer - Encoding : 8bit  Content - Length : 5879  Status : RO    {Автоматическая перекодировка русского текста из любой кодировки в Win1251  Serg Perevoznyk, 1999}
  Unit Coder;
  Interface
  Uses SysUtils; {* Подключаем внешние файлы *}
Const {* Постоянные значения *}
  win = 0;
  koi8 = 1;
  dos = 2;
  iso = 3;
Function AutoTrans(
Const {* Константы *}
  S : String) : String;
Function win2n(c : char;
n : byte) : char;
Function n2win(c : char;
n : byte) : char;
Function n2m(c : char;
n, m : byte) : char;
Function TransformString(s_in : String;
n, m : byte) : String;
Implementation
Const {* Постоянные значения *}
  EVAL_MAX = 40;
  EVAL_MIN = 5;
  CODE_MAX = 4;
  ideal_freq : Array[1..128] Of integer = (0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0  , 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 10, 0, 9, 1, 61, 13, 0, 5, 14, 0  , 59, 4, 2, 8, 10, 10, 6, 30, 12, 12, 0, 1, 0, 7, 0, 1, 0, 3, 5, 0, 0, 1, 742, 166, 385, 157, 287, 869, 8  2, 131, 961, 85, 279, 451, 365, 648, 1069, 303, 460, 433, 660, 202, 19, 71, 42, 130, 22, 52, 0, 1  80, 130, 21, 95, 188);
Var {* Необходимые переменные *}
  cur_freq                                             : Array[1..128] Of real;
  table                                                : Array[1..3, 1..128] Of byte = (; {koi8}
  {Dos} {iso}
  {Back transform}
  table_b                                              : Array[1..3, 1..128] Of byte = (; {koi8}
  {Dos} {iso}
  {transforms a character from win To n}
Function win2n(c                                     : char;
n                                                    : byte);
Begin
If ( (ord(c) > 127) And (n > 0)) Then
  result := chr(128 + table[ n ][ ord(c) - 127 ] )
Else result; {transforms a character from n To win}
Function n2win(c                                     : char;
n                                                    : byte);
Begin
If ( (ord(c) > 127) And (n > 0)) Then
  result := chr(128 + table_b[ n ][ ord(c) - 127] )
Else result; {transforms a character from n To m}
Function n2m(c                                       : char;
n                                                    : byte);
m                                                    : byte);
Begin
result := win2n( n2win(c, n), m ); {Transforms a String from n To m}
Function TransformString(s_in                        : String;
n                                                    : byte);
m                                                    : byte);
Var {* Объявление переменных *}
  ret                                                      : String;
  I                                                        : integer;
  c_in                                                     : char;
  c_out                                                    : char;
  Begin
  ret := '';
For i := 1 To length(s_in) Do; {* Цикл для i => [1 .. length(s_in)] *}
  If ( (c_in = #10) Or (s_in[i] = #13)) Then
    Begin
Ret := Ret + c_in;
End
  Else Begin
    c_out := n2m(c_in, n, m);
ret := ret + c_out;
result := ret;
Function GetString( str                                  : String );
Begin
If Length(Str) < EVAL_MIN Then
  Begin
Result := '';
End
Else result := Copy(Str, 1, EVAL_MAX); {
Function counts the distance Of the characters Set from the ideal}
Function norm( str                                       : String);
Var {* В работе нам потребуются переменные: *}
  ret         : real;
  incr        : real;
  I           : integer;
  Begin
  ret := 0;
  incr := 10000 / length(str);
For i := 1 To 128 Do; {* Переменная i увеличивается с 1 до 128 *}
  For i := 1 To length(str) Do; {* Увеличиваем i от 1 до length(str) с шагом 1 *}
    For i := 1 To 128 Do; {* Переменная i увеличивается с 1 до 128 *}
      result := ret; {
Function Of auto Transform}
{* Предопределенные *}
S           : String);
Var {* В работе нам потребуются переменные: *}
  min_norm : real;
  eval_str : String;
  cur_norm : real;
  cur_str  : String;
  f2r      : integer;
  F2       : integer;
  Begin
  f2r := 0;
  min_norm := 30000;
If S = EmptyStr Then
  Begin
result := '';
exit;
End;
eval_str := GetString(S);
If eval_str = '' Then
  Begin
result := '';
exit;
End;
For F2 := 0 To CODE_MAX - 1 Do {* Увеличиваем F2 от 0 до CODE_MAX с шагом 1 *}
  Begin
cur_str := TransformString(eval_str, f2, 0);
cur_norm := norm(cur_str);
If (cur_norm < min_norm) Then
  Begin
min_norm := cur_norm;
f2r := f2;
End;

End;
result := TransformString(S, f2r, 0);
End;

End......