indy 收邮件的subject是乱码(300分)

  • 主题发起人 主题发起人 yue_shan
  • 开始时间 开始时间
Y

yue_shan

Unregistered / Unconfirmed
GUEST, unregistred user!
高分,我很快给分的
 
我刚开始用Indy也有这个问题,后来改了它的源程序(Indy)就可以了。
以下是改动的地方:
if Pos('=?ISO', UpperCase(Header)) > 0 then
改为
if Pos('=?', UpperCase(Header)) > 0 then
如果你有Fastnet的源码的话你可以参考一下。

 
这里有个Decode函数,你参考一下
function TMailMessenger.FDecode(Src: String): String;
var
BeginPos,
EndPos : Integer;
begin
BeginPos := Pos('?B?', Src);
if BeginPos > 0 then
begin
EndPos := Pos('?=', Src);
if EndPos = 0 then
EndPos := Length(Src) + 1;
Src := Copy(Src, BeginPos + 3, EndPos - BeginPos - 3);
FBDecoder.Reset;
FBDecoder.CodeString(Src);
Result := FBDecoder.CompletedInput;
BeginPos := Pos(';', Result);
Result := Copy(Result, BeginPos + 1, Length(Result) - BeginPos);
Exit;
end;
BeginPos := Pos('?Q?', Src);
if BeginPos > 0 then
begin
EndPos := Pos('?=', Src);
if EndPos = 0 then
EndPos := Length(Src) + 1;
Src := Copy(Src, BeginPos + 3, EndPos - BeginPos - 3);
FQDecoder.Reset;
FQDecoder.CodeString(Src);
Result := FQDecoder.CompletedInput;
BeginPos := Pos(';', Result);
Result := Copy(Result, BeginPos + 1, Length(Result) - BeginPos);
Exit;
end;
Result := Src;
end;

注:
两个定义
FQDecoder : TIdQuotedPrintableDecoder;
FBDecoder : TIdBase64Decoder;
 
function CheckTxt(s: string): string;
var
s1,s2,s3: integer;
t,v: string;
Encoding: char;
hex,step: integer;
a1: array[1..4] of byte;
b1: array[1..3] of byte;
j: integer;
byte_ptr,real_bytes: integer;
begin
s1:=Pos('=?',s);
s2:= 1 ;
hex:= 0 ;
if s1>0 then
begin
for s2:=Length(s)-1 downto 1 do
begin
if Copy(s,s2,2)='?=' then Break;
end;
end;
if (s1=0) or (s2=1) then
begin
Result:=s;
Exit;
end;
t:=Copy(s,s1+2,s2-2-s1);
s3:=Pos('?',t);
Delete(t,1,s3);
if(t='')then
begin
Result:= s;
Exit ;
end ;
Encoding:=t[1];
Delete(t,1,2);
v:='';
step:=0;
case Encoding of
'Q':
while t<>'' do
begin
case step of
0:
begin
case t[1] of
'_': v:=v+' ';
'=': step:=1;
else v:=v+t[1];
end;
end;
1:
begin
if t[1]<='9' then hex:=(Ord(t[1])-Ord('0'))*16
else hex:=(Ord(t[1])-55)*16;
step:=2;
end;
2:
begin
if t[1]<='9' then hex:=hex+(Ord(t[1])-Ord('0'))
else hex:=hex+Ord(t[1])-55;
v:=v+Chr(hex);
step:=0;
end;
end;
Delete(t,1,1);
end;
'B':
begin
byte_ptr:=0;
for j:=1 to Length(t) do
begin
Inc(byte_ptr);
case t[j] of
'A'..'Z': a1[byte_ptr]:=Ord(t[j])-65;
'a'..'z': a1[byte_ptr]:=Ord(t[j])-71;
'0'..'9': a1[byte_ptr]:=Ord(t[j])+4;
'+': a1[byte_ptr]:=62;
'/': a1[byte_ptr]:=63;
'=': a1[byte_ptr]:=64;
end;
if byte_ptr=4 then
begin
byte_ptr:=0;
real_bytes:=3;
if a1[1]=64 then real_bytes:=0;
if a1[3]=64 then
begin
a1[3]:=0;
a1[4]:=0;
real_bytes:=1;
end;
if a1[4]=64 then
begin
a1[4]:=0;
real_bytes:=2;
end;
b1[1]:=a1[1]*4+(a1[2] div 16);
b1[2]:=(a1[2] mod 16)*16+(a1[3]div 4);
b1[3]:=(a1[3] mod 4)*64 +a1[4];
if(real_bytes>0)then
v:= v + chr(b1[1]) ;
if(real_bytes>1)then
v:= v + chr(b1[2]) ;
if(real_bytes>2)then
v:= v + chr(b1[3]) ;
end;
end;
end;
end;
Result:=Copy(s,1,s1-1)+v+Copy(s,s2+2,999);
end;
用这个汉函数可以转换.

 
不行啦,我照做了,不行啦
 
邮件的subject编码规则:encoded-word = "=?" charset "?" encoding "?" encoded-text "?="
encoding
Q --- Quote Printable
B --- BASE64
U --- UUENCODE

=?GB2312?Q?=C4=E3=BA=C3?=
这个邮件使用
Quote Printable编码
GB2312字符集
编码内容为C4=E3=BA=C3
你只需将编码内容按其相对应的解码方式进行解码即可
 
我在以前也遇到过原来以为是bug,后来就是用 CheckTxt函数解决了。Indy也真不够意思,解码函数都不提供。
 
我这样用CheckTxt(idMsg.subject)有没有问题,哪位再后指点下
 
小神通
您是怎么解决,帮忙啦,分全部给您,谢谢!
 
yue_shan, 你有没有试过我的函数
 
Tassadar,我用过你的函数,但TIdQuotedPrintableDecoder,TIdBase64Decoder; 我找不到,您还指点一下
 
是Indy自带的解码控件在Indy Misc控件栏里面
 
Tassadar,我是D7,我就是没您提的控件,有一个TIdDecoderQuotedPrintable,但TIdBase64Decoder真的没有,你可不可能花点时间再给我指点一下
 
unit Unit1;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls;

type
TForm1 = class(TForm)
Button1: TButton;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.dfm}

function Base64ToString(const Value : string): string;
var
x, y, n, l: Integer;
d: array[0..3] of Byte;
Table : string;
begin
Table :=
#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$3E +#$40
+#$40 +#$40 +#$3F +#$34 +#$35 +#$36 +#$37 +#$38 +#$39 +#$3A +#$3B +#$3C
+#$3D +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$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 +#$40 +#$40
+#$40 +#$40 +#$40 +#$40 +#$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 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40;

SetLength(Result, Length(Value));
x := 1;
l := 1;
while x < Length(Value) do
begin
for n := 0 to 3 do
begin
if x > Length(Value) then
d[n] := 64
else
begin
y := Ord(Value[x]);
if (y < 33) or (y > 127) then
d[n] := 64
else
d[n] := Ord(Table[y - 32]);
end;
Inc(x);
end;
Result[l] := Char((D[0] and $3F) shl 2 + (D[1] and $30) shr 4);
Inc(l);
if d[2] <> 64 then
begin
Result[l] := Char((D[1] and $0F) shl 4 + (D[2] and $3C) shr 2);
Inc(l);
if d[3] <> 64 then
begin
Result[l] := Char((D[2] and $03) shl 6 + (D[3] and $3F));
Inc(l);
end;
end;
end;
Dec(l);
SetLength(Result, l);
end;

function StringToBase64(const Value: string): string;
var
c: Byte;
n, l: Integer;
Count: Integer;
DOut: array[0..3] of Byte;
Table : string;
begin
Table :=
'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/=';

setlength(Result, ((Length(Value) + 2) div 3) * 4);
l := 1;
Count := 1;
while Count <= Length(Value) do
begin
c := Ord(Value[Count]);
Inc(Count);
DOut[0] := (c and $FC) shr 2;
DOut[1] := (c and $03) shl 4;
if Count <= Length(Value) then
begin
c := Ord(Value[Count]);
Inc(Count);
DOut[1] := DOut[1] + (c and $F0) shr 4;
DOut[2] := (c and $0F) shl 2;
if Count <= Length(Value) then
begin
c := Ord(Value[Count]);
Inc(Count);
DOut[2] := DOut[2] + (c and $C0) shr 6;
DOut[3] := (c and $3F);
end
else
begin
DOut[3] := $40;
end;
end
else
begin
DOut[2] := $40;
DOut[3] := $40;
end;
for n := 0 to 3 do
begin
Result[l] := Table[DOut[n] + 1];
Inc(l);
end;
end;
end;

function GetTitle(const Value: string): string;
var
iPos: integer;
begin
Result := Value;
if Copy(Value, 1, 2) <> '=?' then exit;
//'?B?'前面的都要去掉
iPos := Pos('?B?', Value);
Inc(iPos, 3);
//最后的'?='也要去掉
Result := Copy(Value, iPos, Length(Value) - iPos - 1);
Result := Base64ToString(Result);
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
ShowMessage(GetTitle('=?gb2312?B?YXNkZnNhZGZkc2Fm1tC5+g==?='));
end;

end.
 
Base64解码何必要自己写函数那么复杂呢?????
DELPHI本身就有提供啊。USES部分加上EncdDecd。然后调用DecodeString函数不就搞定了吗?晕~~
 
在D7 TIdBase64Decoder已经改名为TIdDecoderMiME
 
我也遇到类似问题!学习!
 
我用aolo提供的GetTitle函数解决了,所以分多点,同时也感谢所有回答人
 
多人接受答案了。
 
后退
顶部