Таблицы перекодировки и их применение.

Win1251 - KOI8
Вариант №1 (17.01.00)  Вариант №2 (21.01.00)  Вариант №3 (31.01.00)
Вариант №4 (31.01.00)  Вариант №5 (01.09.00)

Преобразование текста OEM у Ansi

Вариант №5
Я же делал несколько по-другому, вернее больше: Взял стандартные таблицы из FARа. Достаточно иметь iso2dos.tbl (двоичные файлы длиной 256 байт, сейчас их буду прилинковывать к exe, как это сделать, посоветуете?)
(Примечание Adepts: как прилинковать файл к ехе читайте здесь)
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

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;

Вернуться наверх

Вариант №3
Предлагаю всеобщему вниманию вот такой вот unit. Он решает проблемы конвертации не только Win1251->KOI8 но и конвертации в другие кодировки.

//---Begin of Unit RusChar
Unit RusChar;
interface
        Function ALT2ISO(Ch1: byte): byte;
        Function ALT2KOI(Ch1: byte): byte;
        Function ALT2MAC(Ch1: byte): byte;
        Function ALT2WIN(Ch1: byte): byte;
        Function ISO2ALT(Ch1: byte): byte;
        Function ISO2KOI(Ch1: byte): byte;
        Function ISO2MAC(Ch1: byte): byte;
        Function ISO2WIN(Ch1: byte): byte;
        Function KOI2ALT(Ch1: byte): byte;
        Function KOI2ISO(Ch1: byte): byte;
        Function KOI2MAC(Ch1: byte): byte;
        Function KOI2WIN(Ch1: byte): byte;
        Function MAC2ALT(Ch1: byte): byte;
        Function MAC2ISO(Ch1: byte): byte;
        Function MAC2KOI(Ch1: byte): byte;
        Function MAC2WIN(Ch1: byte): byte;
        Function WIN2ALT(Ch1: byte): byte;
        Function WIN2ISO(Ch1: byte): byte;
        Function WIN2KOI(Ch1: byte): byte;
        Function WIN2MAC(Ch1: byte): byte;
        Function ConvertString(InputString: string; Convert_Flag: byte): string;
implementation
Const
   //Alt decode contants
   ALT_2_ISO=1;
   ALT_2_KOI=2;
   ALT_2_MAC=3;
   ALT_2_WIN=4;
   //Iso decode contants
   ISO_2_ALT=5;
   ISO_2_KOI=6;
   ISO_2_MAC=7;
   ISO_2_WIN=8;
   //Koi decode contants
   KOI_2_ALT=9;
   KOI_2_ISO=10;
   KOI_2_MAC=11;
   KOI_2_WIN=12;
   //Mac decode contants
   MAC_2_ALT=13;
   MAC_2_ISO=14;
   MAC_2_KOI=15;
   MAC_2_WIN=16;
   //Win decode contants
   WIN_2_ALT=17;
   WIN_2_ISO=18;
   WIN_2_KOI=19;
   WIN_2_MAC=20;
   ALTTable: array [1..64] of byte =(
                                     128, 129, 130, 131, 132, 133, 134, 135,
                                     136, 137, 138, 139, 140, 141, 142, 143,
                                     144, 145, 146, 147, 148, 149, 150, 151,
                                     152, 153, 154, 155, 156, 157, 158, 159,
                                     160, 161, 162, 163, 164, 165, 166, 167,
                                     168, 169, 170, 171, 172, 173, 174, 175,
                                     224, 225, 226, 227, 228, 229, 230, 231,
                                     232, 233, 234, 235, 236, 237, 238, 239
                                     );
   ISOTable: array [1..64] of byte =(
                                     176, 177, 178, 179, 180, 181, 182, 183,
                                     184, 185, 186, 187, 188, 189, 190, 191,
                                     192, 193, 194, 195, 196, 197, 198, 199,
                                     200, 201, 202, 203, 204, 205, 206, 207,
                                     208, 209, 210, 211, 212, 213, 214, 215,
                                     216, 217, 218, 219, 220, 221, 222, 223,
                                     224, 225, 226, 227, 228, 229, 230, 231,
                                     232, 233, 234, 235, 236, 237, 238, 239
                                    );
   KOITable: array [1..64] of byte =(
                                     225, 226, 247, 231, 228, 229, 246, 250,
                                     233, 234, 235, 236, 237, 238, 239, 240,
                                     242, 243, 244, 245, 230, 232, 227, 254,
                                     251, 253, 255, 249, 248, 252, 224, 241,
                                     193, 194, 215, 199, 196, 197, 214, 218,
                                     201, 202, 203, 204, 205, 206, 207, 208,
                                     210, 211, 212, 213, 198, 200, 195, 222,
                                     219, 221, 223, 217, 216, 220, 192, 209
                                    );
   MACTable: array [1..64] of byte =(
                                     128, 129, 130, 131, 132, 133, 134, 135,
                                     136, 137, 138, 139, 140, 141, 142, 143,
                                     144, 145, 146, 147, 148, 149, 150, 151,
                                     152, 153, 154, 155, 156, 157, 158, 159,
                                     224, 225, 226, 227, 228, 229, 230, 231,
                                     232, 233, 234, 235, 236, 237, 238, 239,
                                     240, 241, 242, 243, 244, 245, 246, 247,
                                     248, 249, 250, 251, 252, 253, 254, 223
                                     );
   WINTable: array [1..64] of byte =(
                                     192, 193, 194, 195, 196, 197, 198, 199,
                                     200, 201, 202, 203, 204, 205, 206, 207,
                                     208, 209, 210, 211, 212, 213, 214, 215,
                                     216, 217, 218, 219, 220, 221, 222, 223,
                                     224, 225, 226, 227, 228, 229, 230, 231,
                                     232, 233, 234, 235, 236, 237, 238, 239,
                                     240, 241, 242, 243, 244, 245, 246, 247,
                                     248, 249, 250, 251, 252, 253, 254, 255
                                     );

Function ALT2ISO(Ch1: byte): byte;
Var
 i: byte;
begin
 For i:=1 to 64 do begin
  If ALTTable[i]=ch1 then begin
   ALT2ISO:=ISOtable[i];
   exit;
  end;
 end;
 ALT2ISO:=ch1;
end;
Function ALT2KOI(Ch1: byte): byte;
Var
 i: byte;
begin
 For i:=1 to 64 do begin
  If ALTTable[i]=ch1 then begin
   ALT2KOI:=KOItable[i];
   exit;
  end;
 end;
 ALT2KOI:=ch1;
end;
Function ALT2MAC(Ch1: byte): byte;
Var
 i: byte;
begin
 For i:=1 to 64 do begin
  If ALTTable[i]=ch1 then begin
   ALT2MAC:=MACtable[i];
   exit;
  end;
 end;
 ALT2MAC:=ch1;
end;
Function ALT2WIN(Ch1: byte): byte;
Var
 i: byte;
begin
 For i:=1 to 64 do begin
  If ALTTable[i]=ch1 then begin
   ALT2WIN:=WINtable[i];
   exit;
  end;
 end;
 ALT2WIN:=ch1;
end;
Function ISO2ALT(Ch1: byte): byte;
Var
 i: byte;
begin
 For i:=1 to 64 do begin
  If ISOTable[i]=ch1 then begin
   ISO2ALT:=ALTtable[i];
   exit;
  end;
 end;
 ISO2ALT:=ch1;
end;
Function ISO2KOI(Ch1: byte): byte;
Var
 i: byte;
begin
 For i:=1 to 64 do begin
  If ISOTable[i]=ch1 then begin
   ISO2KOI:=KOItable[i];
   exit;
  end;
 end;
 ISO2KOI:=ch1;
end;
Function ISO2MAC(Ch1: byte): byte;
Var
 i: byte;
begin
 For i:=1 to 64 do begin
  If ISOTable[i]=ch1 then begin
   ISO2MAC:=MACtable[i];
   exit;
  end;
 end;
 ISO2MAC:=ch1;
end;
Function ISO2WIN(Ch1: byte): byte;
Var
 i: byte;
begin
 For i:=1 to 64 do begin
  If ISOTable[i]=ch1 then begin
   ISO2WIN:=WINtable[i];
   exit;
  end;
 end;
 ISO2WIN:=ch1;
end;
Function KOI2ALT(Ch1: byte): byte;
Var
 i: byte;
begin
 For i:=1 to 64 do begin
  If KOITable[i]=ch1 then begin
   KOI2ALT:=ALTtable[i];
   exit;
  end;
 end;
 KOI2ALT:=ch1;
end;
Function KOI2ISO(Ch1: byte): byte;
Var
 i: byte;
begin
 For i:=1 to 64 do begin
  If KOITable[i]=ch1 then begin
   KOI2ISO:=ISOtable[i];
   exit;
  end;
 end;
 KOI2ISO:=ch1;
end;
Function KOI2MAC(Ch1: byte): byte;
Var
 i: byte;
begin
 For i:=1 to 64 do begin
  If KOITable[i]=ch1 then begin
   KOI2MAC:=MACtable[i];
   exit;
  end;
 end;
 KOI2MAC:=ch1;
end;
Function KOI2WIN(Ch1: byte): byte;
Var
 i: byte;
begin
 For i:=1 to 64 do begin
  If KOITable[i]=ch1 then begin
   KOI2WIN:=WINtable[i];
   exit;
  end;
 end;
 KOI2WIN:=ch1;
end;
Function MAC2ALT(Ch1: byte): byte;
Var
 i: byte;
begin
 For i:=1 to 64 do begin
  If MACTable[i]=ch1 then begin
   MAC2ALT:=ALTtable[i];
   exit;
  end;
 end;
 MAC2ALT:=ch1;
end;
Function MAC2ISO(Ch1: byte): byte;
Var
 i: byte;
begin
 For i:=1 to 64 do begin
  If MACTable[i]=ch1 then begin
   MAC2ISO:=ISOtable[i];
   exit;
  end;
 end;
 MAC2ISO:=ch1;
end;
Function MAC2KOI(Ch1: byte): byte;
Var
 i: byte;
begin
 For i:=1 to 64 do begin
  If MACTable[i]=ch1 then begin
   MAC2KOI:=KOItable[i];
   exit;
  end;
 end;
 MAC2KOI:=ch1;
end;
Function MAC2WIN(Ch1: byte): byte;
Var
 i: byte;
begin
 For i:=1 to 64 do begin
  If MACTable[i]=ch1 then begin
   MAC2WIN:=WINtable[i];
   exit;
  end;
 end;
 MAC2WIN:=ch1;
end;
Function WIN2ALT(Ch1: byte): byte;
Var
 i: byte;
begin
 For i:=1 to 64 do begin
  If WINTable[i]=ch1 then begin
   WIN2ALT:=ALTtable[i];
   exit;
  end;
 end;
 WIN2ALT:=ch1;
end;
Function WIN2ISO(Ch1: byte): byte;
Var
 i: byte;
begin
 For i:=1 to 64 do begin
  If WINTable[i]=ch1 then begin
   WIN2ISO:=ISOtable[i];
   exit;
  end;
 end;
 WIN2ISO:=ch1;
end;
Function WIN2KOI(Ch1: byte): byte;
Var
 i: byte;
begin
 For i:=1 to 64 do begin
  If WINTable[i]=ch1 then begin
   WIN2KOI:=KOItable[i];
   exit;
  end;
 end;
 WIN2KOI:=ch1;
end;
Function WIN2MAC(Ch1: byte): byte;
Var
 i: byte;
begin
 For i:=1 to 64 do begin
  If WINTable[i]=ch1 then begin
   WIN2MAC:=MACtable[i];
   exit;
  end;
 end;
 WIN2MAC:=ch1;
end;

Function ConvertString(InputString: string; Convert_Flag: byte): string;
Var
           i: word;
 ConvertByte: byte;
begin
   ConvertString:='';
   If InputString='' then exit;
   for i:=1 to length(InputString) do begin
    ConvertByte:=ord(InputString[i]);
    Case Convert_Flag of

     ALT_2_ISO: ConvertByte:=Alt2Iso(ConvertByte);
     ALT_2_KOI: ConvertByte:=Alt2Koi(ConvertByte);
     ALT_2_MAC: ConvertByte:=Alt2Mac(ConvertByte);
     ALT_2_WIN: ConvertByte:=Alt2Win(ConvertByte);

     ISO_2_ALT: ConvertByte:=Iso2Alt(ConvertByte);
     ISO_2_KOI: ConvertByte:=Iso2Koi(ConvertByte);
     ISO_2_MAC: ConvertByte:=Iso2Mac(ConvertByte);
     ISO_2_WIN: ConvertByte:=Iso2Win(ConvertByte);

     KOI_2_ALT: ConvertByte:=Koi2Alt(ConvertByte);
     KOI_2_ISO: ConvertByte:=Koi2Iso(ConvertByte);
     KOI_2_MAC: ConvertByte:=Koi2Mac(ConvertByte);
     KOI_2_WIN: ConvertByte:=Koi2Win(ConvertByte);

     MAC_2_ALT: ConvertByte:=Mac2Alt(ConvertByte);
     MAC_2_ISO: ConvertByte:=Mac2Iso(ConvertByte);
     MAC_2_KOI: ConvertByte:=Mac2Koi(ConvertByte);
     MAC_2_WIN: ConvertByte:=Mac2Win(ConvertByte);

     WIN_2_ALT: ConvertByte:=Win2Alt(ConvertByte);
     WIN_2_ISO: ConvertByte:=Win2Iso(ConvertByte);
     WIN_2_KOI: ConvertByte:=Win2Koi(ConvertByte);
     WIN_2_MAC: ConvertByte:=Win2Mac(ConvertByte);

    end;
    InputString[i]:=chr(ConvertByte);
   end;
   ConvertString:=InputString;
end;


begin
end.
//---End of Unit RusChar

Вернуться наверх

Вариант №2
Этот вариант несколько более длинный (в плане размера таблиц перекодировки), но зато, как мне кажется, более универсальный (и, возможно, более быстрый).

//---------------------------------------------------------------------------
type
    PCharRecodeTable = ^TCharRecodeTable;
    TCharRecodeTable = array[ #0..#255 ] of char;

const
     WinToKOI8Table : TCharRecodeTable  =
(#$00, #$01, #$02, #$03, #$04, #$05, #$06, #$07, #$08, #$09, #$0A, #$0B, #$0C, #$0D, #$0E, #$0F,
 #$10, #$11, #$12, #$13, #$14, #$15, #$16, #$17, #$18, #$19, #$1A, #$1B, #$1C, #$1D, #$1E, #$1F,
 #$20, #$21, #$22, #$23, #$24, #$25, #$26, #$27, #$28, #$29, #$2A, #$2B, #$2C, #$2D, #$2E, #$2F,
 #$30, #$31, #$32, #$33, #$34, #$35, #$36, #$37, #$38, #$39, #$3A, #$3B, #$3C, #$3D, #$3E, #$3F,
 #$40, #$41, #$42, #$43, #$44, #$45, #$46, #$47, #$48, #$49, #$4A, #$4B, #$4C, #$4D, #$4E, #$4F,
 #$50, #$51, #$52, #$53, #$54, #$55, #$56, #$57, #$58, #$59, #$5A, #$5B, #$5C, #$5D, #$5E, #$5F,
 #$60, #$61, #$62, #$63, #$64, #$65, #$66, #$67, #$68, #$69, #$6A, #$6B, #$6C, #$6D, #$6E, #$6F,
 #$70, #$71, #$72, #$73, #$74, #$75, #$76, #$77, #$78, #$79, #$7A, #$7B, #$7C, #$7D, #$7E, #$7F,
 #$80, #$81, #$82, #$83, #$84, #$85, #$86, #$87, #$88, #$89, #$8A, #$8B, #$8C, #$8D, #$8E, #$8F,
 #$90, #$91, #$92, #$93, #$94, #$95, #$96, #$97, #$98, #$99, #$9A, #$9B, #$9C, #$9D, #$9E, #$9F,
 #$A0, #$A1, #$A2, #$A3, #$A4, #$A5, #$A6, #$A7, #$A8, #$A9, #$AA, #$AB, #$AC, #$AD, #$AE, #$AF,
 #$B0, #$B1, #$B2, #$B3, #$B4, #$B5, #$B6, #$B7, #$B8, #$B9, #$BA, #$BB, #$BC, #$BD, #$BE, #$BF,
 #$E1, #$E2, #$F7, #$E7, #$E4, #$E5, #$F6, #$FA, #$E9, #$EA, #$EB, #$EC, #$ED, #$EE, #$EF, #$F0,
 #$F2, #$F3, #$F4, #$F5, #$E6, #$E8, #$E3, #$FE, #$FB, #$FD, #$FF, #$F9, #$F8, #$FC, #$E0, #$F1,
 #$C1, #$C2, #$D7, #$C7, #$C4, #$C5, #$D6, #$DA, #$C9, #$CA, #$CB, #$CC, #$CD, #$CE, #$CF, #$D0,
 #$D2, #$D3, #$D4, #$D5, #$C6, #$C8, #$C3, #$DE, #$DB, #$DD, #$DF, #$D9, #$D8, #$DC, #$C0, #$D1);

     KOI8ToWinTable : TCharRecodeTable =
(#$00, #$01, #$02, #$03, #$04, #$05, #$06, #$07, #$08, #$09, #$0A, #$0B, #$0C, #$0D, #$0E, #$0F,
 #$10, #$11, #$12, #$13, #$14, #$15, #$16, #$17, #$18, #$19, #$1A, #$1B, #$1C, #$1D, #$1E, #$1F,
 #$20, #$21, #$22, #$23, #$24, #$25, #$26, #$27, #$28, #$29, #$2A, #$2B, #$2C, #$2D, #$2E, #$2F,
 #$30, #$31, #$32, #$33, #$34, #$35, #$36, #$37, #$38, #$39, #$3A, #$3B, #$3C, #$3D, #$3E, #$3F,
 #$40, #$41, #$42, #$43, #$44, #$45, #$46, #$47, #$48, #$49, #$4A, #$4B, #$4C, #$4D, #$4E, #$4F,
 #$50, #$51, #$52, #$53, #$54, #$55, #$56, #$57, #$58, #$59, #$5A, #$5B, #$5C, #$5D, #$5E, #$5F,
 #$60, #$61, #$62, #$63, #$64, #$65, #$66, #$67, #$68, #$69, #$6A, #$6B, #$6C, #$6D, #$6E, #$6F,
 #$70, #$71, #$72, #$73, #$74, #$75, #$76, #$77, #$78, #$79, #$7A, #$7B, #$7C, #$7D, #$7E, #$7F,
 #$80, #$81, #$82, #$83, #$84, #$85, #$86, #$87, #$88, #$89, #$8A, #$8B, #$8C, #$8D, #$8E, #$8F,
 #$90, #$91, #$92, #$93, #$94, #$95, #$96, #$97, #$98, #$99, #$9A, #$9B, #$9C, #$9D, #$9E, #$9F,
 #$A0, #$A1, #$A2, #$A3, #$A4, #$A5, #$A6, #$A7, #$A8, #$A9, #$AA, #$AB, #$AC, #$AD, #$AE, #$AF,
 #$B0, #$B1, #$B2, #$B3, #$B4, #$B5, #$B6, #$B7, #$B8, #$B9, #$BA, #$BB, #$BC, #$BD, #$BE, #$BF,
 #$FE, #$E0, #$E1, #$F6, #$E4, #$E5, #$F4, #$E3, #$F5, #$E8, #$E9, #$EA, #$EB, #$EC, #$ED, #$EE,
 #$EF, #$FF, #$F0, #$F1, #$F2, #$F3, #$E6, #$E2, #$FC, #$FB, #$E7, #$F8, #$FD, #$F9, #$F7, #$FA,
 #$DE, #$C0, #$C1, #$D6, #$C4, #$C5, #$D4, #$C3, #$D5, #$C8, #$C9, #$CA, #$CB, #$CC, #$CD, #$CE,
 #$CF, #$DF, #$D0, #$D1, #$D2, #$D3, #$C6, #$C2, #$DC, #$DB, #$C7, #$D8, #$DD, #$D9, #$D7, #$DA);

//---------------------------------------------------------------------------
function RecodeChar( Ch : char; const Table : TCharRecodeTable ) : char;
begin
  Result := Table[ Ch ];
end;
//---------------------------------------------------------------------------
function CharWinToKOI8( Ch : char ) : char;
begin
  Result := WinToKOI8Table[ Ch ];
end;
//---------------------------------------------------------------------------
function CharKOI8ToWin( Ch : char ) : char;
begin
  Result := KOI8ToWinTable[ Ch ];
end;
//---------------------------------------------------------------------------
function RecodeStr( Source : string; const Table : TCharRecodeTable ) : string;
var
   i : integer;
begin
  Result := '';
  for i := 1 to length( Source ) do
    Result := Result + Table[ Source[i] ];
end;
//---------------------------------------------------------------------------

Вариант №1
const
  Koi: Array[0..66] of Char = ('Ј', 'Ё', 'ё', 'А', 'Б', 'В', 'Г', 'Д', 'Е', 'Ж',
                               'З', 'И', 'Й', 'К', 'Л', 'М', 'Н', 'О', 'П', 'Р',
                               'С', 'Т', 'У', 'Ф', 'Х', 'Ц', 'Ч', 'Ш', 'Щ', 'Ъ',
                               'Ы', 'Ь', 'Э', 'Ю', 'Я', 'а', 'б', 'в', 'г', 'д',
                               'е', 'ж', 'з', 'и', 'й', 'к', 'л', 'м', 'н', 'о',
                               'п', 'р', 'с', 'т', 'у', 'ф', 'х', 'ц', 'ч', 'ш',
                               'щ', 'ъ', 'ы', 'ь', 'э', 'ю', 'я');
  Win: Array[0..66] of Char = ('ё', 'Ё', 'Ј', 'ю', 'а', 'б', 'ц', 'д', 'е', 'ф',
                               'г', 'х', 'и', 'й', 'к', 'л', 'м', 'н', 'о', 'п',
                               'я', 'р', 'с', 'т', 'у', 'ж', 'в', 'ь', 'ы', 'з',
                               'ш', 'э', 'щ', 'ч', 'ъ', 'Ю', 'А', 'Б', 'Ц', 'Д',
                               'Е', 'Ф', 'Г', 'Х', 'И', 'Й', 'К', 'Л', 'М', 'Н',
                               'О', 'П', 'Я', 'Р', 'С', 'Т', 'У', 'Ж', 'В', 'Ь',
                               'Ы', 'З', 'Ш', 'Э', 'Щ', 'Ч', 'Ъ');
//---------------------------------------------------------------------------
function WinToKoi(Str: String): String;
var
  i, j, Index: Integer;
begin
  Result := '';

  for i := 1 to Length(Str) do
  begin
    Index := -1;
    for j := Low(Win) to High(Win) do
      if Win[j] = Str[i] then
      begin
        Index := j;
        Break;
      end;

    if Index = -1 then Result := Result + Str[i]
                  else Result := Result + Koi[Index];
  end;
end;
//---------------------------------------------------------------------------
function KoiToWin(Str: String): String;
var
  i, j, Index: Integer;
begin
  Result := '';

  for i := 1 to Length(Str) do
  begin
    Index := -1;
    for j := Low(Win) to High(Win) do
      if Koi[j] = Str[i] then
      begin
        Index := j;
        Break;
      end;

    if Index = -1 then Result := Result + Str[i]
                  else Result := Result + Win[Index];
  end;
end;
//---------------------------------------------------------------------------
procedure SendFileOnSMTP(Host: String;
                         Port: Integer;
                         Subject,
                         FromAddress, ToAddress,
                         Body,
                         FileName: String);
var
  NMSMTP: TNMSMTP;
begin
  if DelSpace(ToAddress) = '' then Exit;
  if ToAddress[1] = ';' then Exit;

  if (DelSpace(FileName) <> '') and not FileExists(FileName) then
    raise Exception.Create('SendFileOnSMTP: file not exist: ' + FileName);

  NMSMTP := TNMSMTP.Create(nil);
  try
    NMSMTP.Host := Host;
    NMSMTP.Port := Port;
    NMSMTP.Charset := 'koi8-r';
    NMSMTP.PostMessage.FromAddress := FromAddress;
    NMSMTP.PostMessage.ToAddress.Text := ToAddress;
    NMSMTP.PostMessage.Attachments.Text := FileName;
    NMSMTP.PostMessage.Subject := Subject;
    NMSMTP.PostMessage.Date := DateTimeToStr(Now);
    NMSMTP.UserID := 'netmaster';
    NMSMTP.PostMessage.Body.Text := WinToKoi(Body);
    NMSMTP.FinalHeader.Clear;
    NMSMTP.TimeOut := 5000;
    NMSMTP.Connect;
    NMSMTP.SendMail;
    NMSMTP.Disconnect;
  finally
    NMSMTP.Free;
  end;
end;
//---------------------------------------------------------------------------
 

Вернуться наверх

Преобразование текста OEM у Ansi
Эта версия работает под любым Delphi.
(Начиная с Delphi 2, это можно записать короче с использованием AnsiToOem и OemToAnsi.)
Здесь все просто.

function ConvertAnsiToOem(const S : string) : string;
{ ConvertAnsiToOem translates a string into the OEM-defined character set }
{$IFNDEF WIN32}
var
  Source, Dest : array[0..255] of Char;
{$ENDIF}
begin
{$IFDEF WIN32}
  SetLength(Result, Length(S));
  if Length(Result) > 0 then
    AnsiToOem(PChar(S), PChar(Result));
{$ELSE}
  if Length(Result) > 0 then
  begin
    AnsiToOem(StrPCopy(Source, S), Dest);
    Result := StrPas(Dest);
  end;
{$ENDIF}
end; { ConvertAnsiToOem }
function ConvertOemToAnsi(const S : string) : string;
{ ConvertOemToAnsi translates a string from the OEM-defined
  character set into either an ANSI or a wide-character string }
{$IFNDEF WIN32}
var
  Source, Dest : array[0..255] of Char;
{$ENDIF}
begin
{$IFDEF WIN32}
  SetLength(Result, Length(S));
  if Length(Result) > 0 then
    OemToAnsi(PChar(S), PChar(Result));
{$ELSE}
  if Length(Result) > 0 then
  begin
    OemToAnsi(StrPCopy(Source, S), Dest);
    Result := StrPas(Dest);
  end;
{$ENDIF}
end; { ConvertOemToAnsi }

Вернуться наверх