Decod
 | "Knowledge itself is power" F.Bacon |
| Разное |
Раздел Сокровищница
(17.01.00)
(21.01.00)
(31.01.00)
(31.01.00)
(01.09.00)
Вариант №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; Вроде еще быстрее сделать невозможно. Но это только теоретически ;)
Готовую программу можно скачать с
Вариант №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;
Вариант №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. //---End of Unit RusChar
Вариант №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; //---------------------------------------------------------------------------
Вариант №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; //---------------------------------------------------------------------------
