Форум: "Сети";
Текущий архив: 2003.09.08;
Скачать: [xml.tar.bz2];
Вниз
Перекодировка темы письма в POP3 Найти похожие ветки
← →
gedd (2003-06-18 08:10) [0]Уважаемые мастера. Кто нибудь знает как перекодировать из koi8
в нормальную виндовую кодировку тему письма.
например
=?koi8-r?Q?WinAPI=20=CE=C1=20?= =?koi8-r?Q?=D2=D5=D3=D3=CB=CF=CD?=
Конечно можно написать свою прогу, но может есть стандартные
функции?
← →
Ghost_ (2003-06-18 09:51) [1]Чета не ясно куда ты будешь девать функции если проги у тебя не будет?
← →
gedd (2003-06-18 10:57) [2]хорошо, исправляю ошибку
можно написать свою процеДУРУ
но вопрос остается открытым
и давайте к словам придираться
не будем
← →
Ghost_ (2003-06-18 12:03) [3]Никто и не собирался придераться непонятно было
http://www.delphimaster.ru/cgi-bin/download.pl?get=1032692385&n=0
посмотри исходник возми функцию...пытался написать сюда кодировка не совпадает...
← →
Andrey Klimov (2003-06-18 15:44) [4]В данном случае это не совсем только КОИ-8.
Это КОИ-8Р (?koi8-r?), но кодированная к тому же в Quoted-Printable (?Q?) (а еще есть Base64 (?B?)).
Для расшифровки надо применить функцию распаковки из Quoted-Printable и только потом конвертировать из КОИ8-Р в нужную тебе кодировку.
В твоем случае надо расшифровать:
WinAPI=20=CE=C1=20
и
=D2=D5=D3=D3=CB=CF=CD
из Quoted-Printable. Результат будет строкой в кои8-р
← →
k$v (2003-06-18 17:35) [5]Для раскодировки таких строк необходимо реализовать положения rfc-2047. Сам с такой проблемой столкнулся. Нашел функции реализующие это для Java, PHP, C++ (GNU), а для DELPHI не нашел... Наверное придется писать самому... хотя это явный велосипед...
← →
Andrey Klimov (2003-06-18 18:40) [6]В случае ?q? просто:
=XX , где XX это ASCII код байта (от 0..255),
т.е. =20 это символ пробела...
Для ?b? декодируешь Base64 (этих функций навалом для делфи)
unit Base_64;
interface
function Base64Encode(Input : String) : String;
function Base64Decode(Input : String) : String;
{$B-} { Partial boolean evaluation }
type
TLookup = array [0..64] of Char;
TLookup2 = array[0..127] of Byte;
const
Base64Out: TLookup =
(
"A", "B", "C", "D", "E", "F", "G", "H", "I", "J", "K", "L", "M",
"N", "O", "P", "Q", "R", "S", "T", "U", "V", "W", "X", "Y", "Z",
"a", "b", "c", "d", "e", "f", "g", "h", "i", "j", "k", "l", "m",
"n", "o", "p", "q", "r", "s", "t", "u", "v", "w", "x", "y", "z",
"0", "1", "2", "3", "4", "5", "6", "7", "8", "9", "+", "/", "="
);
Base64In: TLookup2 =
(
255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255,
255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255,
255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255,
255, 255, 255, 255, 62, 255, 255, 255, 63, 52, 53, 54, 55,
56, 57, 58, 59, 60, 61, 255, 255, 255, 64, 255, 255, 255,
0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12,
13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25,
255, 255, 255, 255, 255, 255, 26, 27, 28, 29, 30, 31, 32,
33, 34, 35, 36, 37, 38, 39, 40, 41, 42, 43, 44, 45,
46, 47, 48, 49, 50, 51, 255, 255, 255, 255, 255
);
implementation
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
function Base64Encode(Input : String) : String;
var
Final : String;
Count : Integer;
Len : Integer;
begin
Final := "";
Count := 1;
Len := Length(Input);
while Count <= Len do begin
Final := Final + Base64Out[(Byte(Input[Count]) and $FC) shr 2];
if (Count + 1) <= Len then begin
Final := Final + Base64Out[((Byte(Input[Count]) and $03) shl 4) +
((Byte(Input[Count+1]) and $F0) shr 4)];
if (Count+2) <= Len then begin
Final := Final + Base64Out[((Byte(Input[Count+1]) and $0F) shl 2) +
((Byte(Input[Count+2]) and $C0) shr 6)];
Final := Final + Base64Out[(Byte(Input[Count+2]) and $3F)];
end
else begin
Final := Final + Base64Out[(Byte(Input[Count+1]) and $0F) shl 2];
Final := Final + "=";
end
end
else begin
Final := Final + Base64Out[(Byte(Input[Count]) and $03) shl 4];
Final := Final + "==";
end;
Count := Count + 3;
end;
Result := Final;
end;
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
function Base64Decode(Input : String) : String;
var
Final : String;
Count : Integer;
Len : Integer;
DataIn0 : Byte;
DataIn1 : Byte;
DataIn2 : Byte;
DataIn3 : Byte;
begin
Final := "";
Count := 1;
Len := Length(Input);
while Count <= Len do begin
DataIn0 := Base64In[Byte(Input[Count])];
DataIn1 := Base64In[Byte(Input[Count+1])];
DataIn2 := Base64In[Byte(Input[Count+2])];
DataIn3 := Base64In[Byte(Input[Count+3])];
Final := Final + Char(((DataIn0 and $3F) shl 2) +
((DataIn1 and $30) shr 4));
if DataIn2 <> $40 then begin
Final := Final + Char(((DataIn1 and $0F) shl 4) +
((DataIn2 and $3C) shr 2));
if DataIn3 <> $40 then
Final := Final + Char(((DataIn2 and $03) shl 6) +
( DataIn3 and $3F) В случае ?q? просто:
=XX , где XX это ASCII код байта (от 0..255),
т.е. =20 это символ пробела...
Для ?b? декодируешь Base64 (этих функций навалом для делфи)
unit Base_64;
interface
function Base64Encode(Input : String) : String;
function Base64Decode(Input : String) : String;
{$B-} { Partial boolean evaluation }
type
TLookup = array [0..64] of Char;
TLookup2 = array[0..127] of Byte;
const
Base64Out: TLookup =
(
"A", "B", "C", "D", "E", "F", "G", "H", "I", "J", "K", "L", "M",
"N", "O", "P", "Q", "R", "S", "T", "U", "V", "W", "X", "Y", "Z",
"a", "b", "c", "d", "e", "f", "g", "h", "i", "j", "k", "l", "m",
"n", "o", "p", "q", "r", "s", "t", "u", "v", "w", "x", "y", "z",
"0", "1", "2", "3", "4", "5", "6", "7", "8", "9", "+", "/", "="
);
Base64In: TLookup2 =
(
255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255,
255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255,
255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255,
255, 255, 255, 255, 62, 255, 255, 255, 63, 52, 53, 54, 55,
56, 57, 58, 59, 60, 61, 255, 255, 255, 64, 255, 255, 255,
0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12,
13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25,
255, 255, 255, 255, 255, 255, 26, 27, 28, 29, 30, 31, 32,
33, 34, 35, 36, 37, 38, 39, 40, 41, 42, 43, 44, 45,
46, 47, 48, 49, 50, 51, 255, 255, 255, 255, 255
);
implementation
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
function Base64Encode(Input : String) : String;
var
Final : String;
Count : Integer;
Len : Integer;
begin
Final := "";
Count := 1;
Len := Length(Input);
while Count <= Len do begin
Final := Final + Base64Out[(Byte(Input[Count]) and $FC) shr 2];
if (Count + 1) <= Len then begin
Final := Final + Base64Out[((Byte(Input[Count]) and $03) shl 4) +
((Byte(Input[Count+1]) and $F0) shr 4)];
if (Count+2) <= Len then begin
Final := Final + Base64Out[((Byte(Input[Count+1]) and $0F) shl 2) +
((Byte(Input[Count+2]) and $C0) shr 6)];
Final := Final + Base64Out[(Byte(Input[Count+2]) and $3F)];
end
else begin
Final := Final + Base64Out[(Byte(Input[Count+1]) and $0F) shl 2];
Final := Final + "=";
end
end
else begin
Final := Final + Base64Out[(Byte(Input[Count]) and $03) shl 4];
Final := Final + "==";
end;
Count := Count + 3;
end;
Result := Final;
end;
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
function Base64Decode(Input : String) : String;
var
Final : String;
Count : Integer;
Len : Integer;
DataIn0 : Byte;
DataIn1 : Byte;
DataIn2 : Byte;
DataIn3 : Byte;
begin
Final := "";
Count := 1;
Len := Length(Input);
while Count <= Len do begin
DataIn0 := Base64In[Byte(Input[Count])];
DataIn1 := Base64In[Byte(Input[Count+1])];
DataIn2 := Base64In[Byte(Input[Count+2])];
DataIn3 := Base64In[Byte(Input[Count+3])];
Final := Final + Char(((DataIn0 and $3F) shl 2) +
((DataIn1 and $30) shr 4));
if DataIn2 <> $40 then begin
Final := Final + Char(((DataIn1 and $0F) shl 4) +
((DataIn2 and $3C) shr 2));
if DataIn3 <> $40 then
Final := Final + Char(((DataIn2 and $03) shl 6) +
(DataIn3 and $3F));
end;
Count := Count + 4;
end;
Result := Final;
end;
end.
← →
Andrey Klimov (2003-06-18 18:44) [7]WinAPI=20=CE=C1=20
"WinAPI"+Chr($20)+Chr($CE)+Chr($C1)+Chr($20)
← →
gedd (2003-06-19 09:29) [8]В данном случае это не совсем только КОИ-8.
Это КОИ-8Р (?koi8-r?), но кодированная к тому же в Quoted-Printable (?Q?) (а еще есть Base64 (?B?)).
>Для расшифровки надо применить функцию распаковки из Quoted->Printable Результат будет строкой в кои8-р и только потом конвертировать из КОИ8-Р в нужную тебе кодировку.
а как? есть стандартные функции?
или опять самому писать
я тут с горя таблицу соответсвия составил
всем спасибо
← →
gedd (2003-06-30 13:30) [9]//перекодировка koi8rQ->Win1251 Created by Egorov Boris
//(gedd@mail.ru)
//внимание этот текст действительно работает
//в отличие от всех представленных выше
var
koi8rQ : array [1..65] of String = (
"FE","E0","E1","F6","E4","E5","F4","E3","F5","E8","E9","EA","EB","EC","ED","EE",
"EF","FF","F0","F1","F2","F3","F6","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",
"20");
Win1251 : array [1..65] of String = (
" "," ","А","Ж","Д","Е","Т"," ","У"," ","И","Й","К","Л","М","Н",
"О","Ю","П","Я","Р","С","Ф","Б","Э"," ","Г","Ь"," ","Ы","В","З",
" "," ","а","ж","д","е","т"," ","у"," ","и","й","к","л","м","н",
"о","ю","п","я","р","с","ф","б","э"," ","г","ь"," ","ы","в","з",
" ");
function ReplaceStr(const S, Srch, Replace: string): string;
var
I : Integer;
Source: string;
begin
Source:= S;
Result:= "";
repeat
I:=Pos(Srch, Source);
if I > 0 then begin
Result := Result + Copy(Source,1,I-1) + Replace;
Source := Copy (Source,I+Length(Srch),MaxInt);
end
else
Result := Result + Source;
until I<=0;
end;
Function Translatekoi8rQ(Subject:String):String;
var i,StrPosition,NotPosition:integer;
ResStr:String;
begin
ResStr:="";
Subject:=ReplaceStr(Subject, "= =?koi8-r?Q?", "");
Subject:=ReplaceStr(Subject, "=?koi8-r?Q?", "");
Subject:=ReplaceStr(Subject, "?", "");
Subject:=ReplaceStr(Subject, " ", "");
Subject:=ReplaceStr(Subject, "==", "=");
StrPosition:=1;
while StrPosition<=(length(Subject)-2) do
begin
if Copy(Subject,StrPosition,1)<>"=" then
begin
NotPosition:=StrPosition;
While Copy(Subject,NotPosition,1)<>"=" do NotPosition:=NotPosition+1;
ResStr:=ResStr+Copy(Subject,StrPosition,NotPosition-StrPosition);
StrPosition:=NotPosition;
end;
if (Copy(Subject,StrPosition,1)="=") then //and (Copy(Subject,StrPosition+3,1)="=")
for i:=1 to 65 do
begin
( Subject,StrPosition+1,2) //перекодировка koi8rQ->Win1251 Created by Egorov Boris
//(gedd@mail.ru)
//внимание этот текст действительно работает
//в отличие от всех представленных выше
var
koi8rQ : array [1..65] of String = (
"FE","E0","E1","F6","E4","E5","F4","E3","F5","E8","E9","EA","EB","EC","ED","EE",
"EF","FF","F0","F1","F2","F3","F6","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",
"20");
Win1251 : array [1..65] of String = (
" "," ","А","Ж","Д","Е","Т"," ","У"," ","И","Й","К","Л","М","Н",
"О","Ю","П","Я","Р","С","Ф","Б","Э"," ","Г","Ь"," ","Ы","В","З",
" "," ","а","ж","д","е","т"," ","у"," ","и","й","к","л","м","н",
"о","ю","п","я","р","с","ф","б","э"," ","г","ь"," ","ы","в","з",
" ");
function ReplaceStr(const S, Srch, Replace: string): string;
var
I : Integer;
Source: string;
begin
Source:= S;
Result:= "";
repeat
I:=Pos(Srch, Source);
if I > 0 then begin
Result := Result + Copy(Source,1,I-1) + Replace;
Source := Copy (Source,I+Length(Srch),MaxInt);
end
else
Result := Result + Source;
until I<=0;
end;
Function Translatekoi8rQ(Subject:String):String;
var i,StrPosition,NotPosition:integer;
ResStr:String;
begin
ResStr:="";
Subject:=ReplaceStr(Subject, "= =?koi8-r?Q?", "");
Subject:=ReplaceStr(Subject, "=?koi8-r?Q?", "");
Subject:=ReplaceStr(Subject, "?", "");
Subject:=ReplaceStr(Subject, " ", "");
Subject:=ReplaceStr(Subject, "==", "=");
StrPosition:=1;
while StrPosition<=(length(Subject)-2) do
begin
if Copy(Subject,StrPosition,1)<>"=" then
begin
NotPosition:=StrPosition;
While Copy(Subject,NotPosition,1)<>"=" do NotPosition:=NotPosition+1;
ResStr:=ResStr+Copy(Subject,StrPosition,NotPosition-StrPosition);
StrPosition:=NotPosition;
end;
if (Copy(Subject,StrPosition,1)="=") then //and (Copy(Subject,StrPosition+3,1)="=")
for i:=1 to 65 do
begin
if Copy(Subject,StrPosition+1,2)=koi8rQ[i] then ResStr:=ResStr+Win1251[i];
end;
StrPosition:=StrPosition+3;
end;
Result:=ResStr;
end;//fun
← →
gedd (2003-07-06 17:08) [10]А как перекодировать вот это?
Subject: =?koi8-r?B?
wcLXx8TFo9baycrLzM3Oz9DS09TVxsjD3tvd2Nnf3MDR?=
в вот это
абвгдеёжзийклмнопрстуфхцчшщьыъэюя
← →
s_ser (2003-07-07 12:26) [11]На самом деле перекодировать из koi8rQ в koi8r можно проще, без
матрици сопоставления. Всего навсего нужно перевести из Шестнадцатиричной системы в двоичную:например
procedure TForm1.Button1Click(Sender: TObject);
var
( $FF) На самом деле перекодировать из koi8rQ в koi8r можно проще, без
матрици сопоставления. Всего навсего нужно перевести из Шестнадцатиричной системы в двоичную:например
procedure TForm1.Button1Click(Sender: TObject);
var
t:byte;
begin
Edit1.Text:=Chr($FF);
t:=15+15*16;
Edit2.Text:=Chr(t);
end;
Страницы: 1 вся ветка
Форум: "Сети";
Текущий архив: 2003.09.08;
Скачать: [xml.tar.bz2];
Память: 0.51 MB
Время: 0.008 c
