Главная страница
    Top.Mail.Ru    Яндекс.Метрика
Форум: "Сети";
Текущий архив: 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
6-24593
Sim
2003-07-07 20:59
2003.09.08
Простейшее соединение

3-24368
P0tia
2003-08-15 21:45
2003.09.08
DbGrid & dBase

1-24476
Rouse_
2003-08-27 14:39
2003.09.08
Разве это не константа?

3-24349
Suharew
2003-08-17 19:26
2003.09.08
Вопрос по SQL

14-24650
Marser
2003-08-20 03:07
2003.09.08
И как вам это?




Afrikaans Albanian Arabic Armenian Azerbaijani Basque Belarusian Bulgarian Catalan Chinese (Simplified) Chinese (Traditional) Croatian Czech Danish Dutch English Estonian Filipino Finnish French
Galician Georgian German Greek Haitian Creole Hebrew Hindi Hungarian Icelandic Indonesian Irish Italian Japanese Korean Latvian Lithuanian Macedonian Malay Maltese Norwegian
Persian Polish Portuguese Romanian Russian Serbian Slovak Slovenian Spanish Swahili Swedish Thai Turkish Ukrainian Urdu Vietnamese Welsh Yiddish Bengali Bosnian
Cebuano Esperanto Gujarati Hausa Hmong Igbo Javanese Kannada Khmer Lao Latin Maori Marathi Mongolian Nepali Punjabi Somali Tamil Telugu Yoruba
Zulu
Английский Французский Немецкий Итальянский Португальский Русский Испанский