大富翁上提问收到的答案,试过了,成功!
function TGetEmailInfo.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;
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;
{============================
*函数名:StringToBase64*
*作者:苏彬*
*时间:2005.11.29 15.25 *
*说明:实现字符转换*
============================}
function TGetEmailInfo.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
procedure StrtoStrlist(Sign: string; Str: string; var Strlist: TStringList);
var
temp: string;
begin
Strlist.Text:='';
while pos(Sign, str)> 0 do
begin
temp:= copy(Str,1, pos(Sign, Str)-1);
Delete(str, 1, pos(Sign, str)+length(Sign)-1);
Strlist.Add(temp);
end;
if Length(Str)> 0 then
Strlist.Add(Str);
end;
我用的邮件解码函数
function CheckTxt(const src: string): string;
var
i,pos1,pos2,pos3:integer;
post:string;
srclist:TStringList;
function Decoder(const 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;
tempedit:TEdit;
begin
s1:=Pos('=?',s);
s2:= 1 ;
hex:= 0 ;
if s1>0 then
for s2:=Length(s)-1 downto 1 do
if Copy(s,s2,2)='?=' then Break;
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);
tempedit:=TEdit.Create(nil);
try
tempedit.Width:=0;
tempedit.Height:=0;
tempedit.Visible:=True;
tempedit.Text:=Result;
Result:=tempedit.Text;
finally
FreeAndNil(tempedit);
end;
if Pos('***SPAM***',Result)>0 then
result:=copy(result,pos('-',result)+1,length(result)-pos('-',result));
end;
begin
pos1:=Pos('=?',src);
pos2:= 1 ;
if pos1>0 then
for pos2:=Length(src)-1 downto 1 do
if Copy(src,pos2,2)='?=' then Break;
if (pos1=0) or (pos2=1) then
begin
Result:=src;
Exit;
end;
post:=Copy(src,pos1+2,pos2-2-pos1);
pos3:=Pos('?',post);
Delete(post,1,pos3);
if(post='')then
begin
Result:=src;
Exit ;
end ;
srclist:=TStringList.Create;
try
srclist.Clear;
StrtoStrlist(' ',src,srclist);
Result:='';
for i:=0 to srclist.Count-1 do
begin
post:=srclist.Strings[i];
Result:=Result+Decoder(post);
end;
finally
srclist.Free;
end;
end;