Алгоритмы: Таблицы перекодировки Win 1251 - KOI8

---

Вариант ╧1 (17.01.00) Автор: Дмитрий В. Полщанов

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;
//---------------------------------------------------------------------------

Вариант ╧2 (21.01.00) Автор: Алексей Вуколов

Этот вариант несколько более длинный (в плане размера таблиц перекодировки), но зато, как мне кажется, более универсальный (и, возможно, более быстрый).
//---------------------------------------------------------------------------
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;
//---------------------------------------------------------------------------

Вариант ╧3 (31.01.00) Автор: Constantin G. Nekhoroshkov

Предлагаю всеобщему вниманию вот такой вот 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.

Вариант ╧4 (31.01.00) Автор: Еремеев Алексей

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;

Вариант ╧5 (01.09.00) Автор: Павленко Алексей

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