<TITLE>«Королевство Dельфи» Виртуальный клуб программистов</TITLE>
<META NAME="keywords" CONTENT="delphi programmer programm programming
club delphi hint дельфи программист программирование программа виртуальный
клуб дельфи советы компоненты взаимопомощь дельфи delphi">
<META NAME="description" CONTENT="Delphi Programmer Club. Using hints.
Виртуальный клуб программистов на Дельфи. Использование всплывающих подсказок">
<LINK HREF="../delphi.css" REL="STYLESHEET" TYPE="text/css">
</HEAD>
<BODY CLASS="Main" BGCOLOR="#FFFFFF">
<TABLE WIDTH=100%>
<TD ALIGN=LEFT VALIGN=TOP COLSPAN=0 ROWSPAN=0>
<IMG SRC="../images/treasure.gif" WIDTH=448 HEIGHT=87 BORDER=0 ALT="Королевство Дельфи">
</TD>
<TD ALIGN=RIGHT VALIGN=TOP >
<FONT COLOR="666666">
"Knowledge itself is power"<BR>
F.Bacon
</FONT>
</TD>
</TABLE>
<A NAME="conten"></A>
<TABLE WIDTH="100%"><TR><TD ALIGN="CENTER" BGCOLOR="#FFCC99">Разное</TD></TR></TABLE>
<DIV ALIGN="CENTER">Таблицы перекодировки Win1251 - KOI8 и их применение.</DIV>
<P ALIGN="right">Вернуться к разделу <A HREF="index.htm">Сокровищница</A><BR>
к разделу <A HREF="s003.htm">Разное</A></P>
<A HREF="#_1">Вариант №1</A> (17.01.00)<BR>
<A HREF="#_2">Вариант №2</A> (21.01.00)<BR>
<A HREF="#_3">Вариант №3</A> (31.01.00)<BR>
<A HREF="#_4">Вариант №4</A> (31.01.00)<BR>
<P></P>
<HR><A NAME="_4"></A>
Вариант №3 (31.01.00) Автор: <A HREF="mailto:eremeev@mdvor.ru">Еремеев Алексей</A>
<P></P>
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;
---
<P></P>
<A HREF="#conten"><FONT COLOR="666666">Вернуться наверх</FONT></A>
<!--- End track --->
<P></P>
<HR><A NAME="_3"></A>
Вариант №3 (31.01.00) Автор: <A HREF="mailto:nekhoroshkov@novolabs.ru">Constantin G. Nekhoroshkov</A>
<P></P>
Предлагаю всеобщему вниманию вот такой вот 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
---
<P></P>
<A HREF="#conten"><FONT COLOR="666666">Вернуться наверх</FONT></A>
<!--- End track --->
<P></P>
<HR><A NAME="_2"></A>
Вариант №2 (21.01.00) Автор: <A HREF="mailto:VUK@fcenter.ru">Алексей Вуколов</A>
<P></P>
Этот вариант несколько более
длинный (в плане размера таблиц перекодировки), но зато, как мне кажется,
более универсальный (и, возможно, более быстрый).
<FONT COLOR="#000099">//---------------------------------------------------------------------------</FONT>
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);
<FONT COLOR="#000099">//---------------------------------------------------------------------------</FONT>
function RecodeChar( Ch : char; const Table : TCharRecodeTable ) : char;
begin
Result := Table[ Ch ];
end;
<FONT COLOR="#000099">//---------------------------------------------------------------------------</FONT>
function CharWinToKOI8( Ch : char ) : char;
begin
Result := WinToKOI8Table[ Ch ];
end;
<FONT COLOR="#000099">//---------------------------------------------------------------------------</FONT>
function CharKOI8ToWin( Ch : char ) : char;
begin
Result := KOI8ToWinTable[ Ch ];
end;
<FONT COLOR="#000099">//---------------------------------------------------------------------------</FONT>
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;
<FONT COLOR="#000099">//---------------------------------------------------------------------------</FONT>
---
<P></P>
<A HREF="#conten"><FONT COLOR="666666">Вернуться наверх</FONT></A>
<!--- End track --->
<HR><A NAME="_1"></A>
Вариант №1 (17.01.00) Автор: <A HREF="mailto:polschanov@katren.ru">Дмитрий В. Полщанов</A>
const
Koi: Array[0..66] of Char = ('Ј', 'Ё', 'ё', 'А', 'Б', 'В', 'Г', 'Д', 'Е', 'Ж',
'З', 'И', 'Й', 'К', 'Л', 'М', 'Н', 'О', 'П', 'Р',
'С', 'Т', 'У', 'Ф', 'Х', 'Ц', 'Ч', 'Ш', 'Щ', 'Ъ',
'Ы', 'Ь', 'Э', 'Ю', 'Я', 'а', 'б', 'в', 'г', 'д',
'е', 'ж', 'з', 'и', 'й', 'к', 'л', 'м', 'н', 'о',
'п', 'р', 'с', 'т', 'у', 'ф', 'х', 'ц', 'ч', 'ш',
'щ', 'ъ', 'ы', 'ь', 'э', 'ю', 'я');
Win: Array[0..66] of Char = ('ё', 'Ё', 'Ј', 'ю', 'а', 'б', 'ц', 'д', 'е', 'ф',
'г', 'х', 'и', 'й', 'к', 'л', 'м', 'н', 'о', 'п',
'я', 'р', 'с', 'т', 'у', 'ж', 'в', 'ь', 'ы', 'з',
'ш', 'э', 'щ', 'ч', 'ъ', 'Ю', 'А', 'Б', 'Ц', 'Д',
'Е', 'Ф', 'Г', 'Х', 'И', 'Й', 'К', 'Л', 'М', 'Н',
'О', 'П', 'Я', 'Р', 'С', 'Т', 'У', 'Ж', 'В', 'Ь',
'Ы', 'З', 'Ш', 'Э', 'Щ', 'Ч', 'Ъ');
<FONT COLOR="#000099">//---------------------------------------------------------------------------</FONT>
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;
<FONT COLOR="#000099">//---------------------------------------------------------------------------</FONT>
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;
<FONT COLOR="#000099">//---------------------------------------------------------------------------</FONT>
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;
|