J
jame
Unregistered / Unconfirmed
GUEST, unregistred user!
邮件的headerpart和bodypart之间用是否存在回车换行('')来判断。
TotalType := '';
Found := FindInHeaders( 'CONTENT-TYPE:', HeaderPart, lines);
If Found Then begin
//专门用来对付elong的html邮件
If pos('text/html',HeaderPart[lines]) > 0 then begin
sakMsg.Text.Add('<html>');
end;
//找到类型
If FindInHeaders('multipart/',HeaderPart,lines) then begin //转发邮件和混合邮件
TotalType := 'MIX';
end else totaltype := 'NO'; //没有区间
//找有没有mime-version
attYn := FindInHeaders('MIME-VERSION:',headerpart,lines);
//找boundary字段
If FindInHeaders('BOUNDARY="',headerpart,lines) then begin
temps := copy(headerpart.strings[lines],Pos('"',headerpart.strings[lines])+1,length(headerpart.strings[lines])-1);
temps := copy(temps,0,Pos('"',temps)-1);
attYn := true; //如果找到了boundary字段肯定是有混合
end;
//
If FindInHeaders('Content-Transfer-Encoding:',headerPart,lines) then begin
FirstCode := trim(Copy(headerPart[lines],Pos(':',headerPart[lines])+1,length(HeaderPart[lines])));
If LowerCase(FirStCode) = 'quoted-printable' then FirStCode := 'QP';
If LowerCase(FirStCode) = 'base64' then FirStCode := 'BASE64';
end else FirStCode := '';
end;
//下面做邮件体处理
If attYn then begin
//如果是多媒体
If totalType = 'MIX' then begin
DeMulBoundMime(bodypart,temps,firstcode);
end
else begin
DeOneBoundMime(bodypart,temps,FirstCode);
end;
end
else begin
If FirstCode = 'QP' then QpDecodeText(Bodypart);
if(Firstcode = 'BASE64')then BaseDecodeText(bodypart);
For i := 0 to bodypart.count -2 do begin
sakmsg.Text.Add(bodypart);
end;
end;
/////////// 下面是子程序 //////////////////////////////////////
procedure TsakPOP.DeOneBoundMime(var s: tstringlist;bounds:string;coding:String);
var
line,i,k,l :Integer;
Encode :String; //编码方式
FnName :String; //文件名
FirstCode :String;
AttachFile :TAttachedFile;
BNull :boolean;
ns :Tstringlist;
begin
Bnull := true;
//解开一个块，该块是两个boundary之间的部分
If FindInHeaders('CONTENT-TYPE:',s,line) then begin
k := line;
If FindInHeaders('Content-Disposition:',s,line) then begin
If line > k then k := line;
end else line := k;
If (Pos('name="',lowercase(s[line])) > 0) or (Pos('name="',lowercase(s[line+1])) > 0) then begin //有文件名
If Pos('name="',lowercase(s[line])) > 0 then l := line else l:= line + 1;
FnName := Copy(s[l],pos('name="',lowercase(s[l]))+6,Length(s[l])-pos('name="',lowercase(s[l]))-6);
FnName := DecodeHeader(FnName,l);
If Pos('/',FnName)>0 then begin //去掉非法字符
While (pos('/',FnName)>0) do begin
FnName := Copy(FnName,Pos('/',FnName)+1,Length(FnName));
end;
end;
end else FnName := '';
//文件编码
If FindInHeaders('Content-Transfer-Encoding:',s,line) then begin
Encode := trim(Copy(s[line],Pos(':',s[line])+1,length(s[line])));
If LowerCase(EnCode) = 'quoted-printable' then EnCode := 'QP'
else
If LowerCase(EnCode) = 'base64' then EnCode := 'BASE64'
else
Encode := '';
i := line;
end else begin
EnCode := '';
i := k;
end;
//去掉无用行
If i < k then i := k;
If (i <> 0) or (k <> 0) then begin
For i := i to s.Count - 1 do if s = '' then break;
For k := 0 to i do s.Delete(0);
end;
If Encode <> '' then begin
k := 0;
while k < s.count do begin
If s[k] = '' then s.Delete(k) else k := k + 1;
end;
end;
end;
If coding <> '' then Encode := Coding;
//知道了文件名和编码方式
If FnName = '' then begin
If Encode = 'QP' then QpDecodeText(s);
If EnCode = 'BASE64' Then BaseDecodeText(s);
If sakmsg.Text.Count > s.count then begin
For i := 0 To s.count -1 do begin
sakMsg.Text.Add(s);
end;
end else SakMsg.Text.Assign(s);
end
else begin
sakMsg.AttachedFiles.Add(fnname);
AttachFile := sakMsg.attachedFiles[ sakMsg.attachedFiles.count-1];
with AttachFile do begin
If EnCode = 'BASE64' then BaseDecodeText(s);
If EnCOde = 'QP' then QPDecodeText(s);
FbodyBin := TmemoryStream.Create;
FBodyBin.Write( Pointer(s.text)^, length(s.text));
end;
end;
end;
procedure TsakPOP.DeMulBoundMime(var s: Tstringlist;bounds:string;coding:String);
var
SecondBound :String; //某个块内部的块分隔
Apart :TStringList; //某个块本身
i,j,k,fromi,endi :Integer; //变量
Mix_mailin,notEnd :boolean;
line :integer;
FirstCode :String; //编码形式
begin
//找寻新的块
NotEnd:= True;
apart := TstringList.Create;
While NotEnd Do begin
If FindInHeaders('--'+bounds,s,line) then begin
s.Delete(line);
Fromi := line; //本块开始
if FindInHeaders('--'+bounds,s,line) then begin
endi := Line - 1; //本块结束
//把块赋给相应的子块
For i:= fromi to endi do begin
apart.Add( s[Fromi]);
S.Delete(Fromi);
end;
If FindInHeaders('CONTENT-TYPE:',apart,line) then begin
k := line; //保存content-type位置
If FindInHeaders('boundary="',apart,line) then begin
SecondBound := Copy(apart[line],Pos('"',apart[line])+1,length(apart[line])-Pos('"',apart[line])-1);
if k < line then k := line;
For j := 0 to k do apart.Delete(0);
DeMulBoundMime(apart,SecondBound,'');
end //如果发现了新的块
Else begin
DeOneBoundMime(Apart,secondbound,''); //分解一个块
apart.Clear;
end;
end;
end;
end else NotEnd := False; //没有块了
End;//WHile
apart.free;
end;
编码挺乱的，不过还算好用。我试验了22种常见的pop3编码方式，其中的base64和qq编码
请参考相应控见。我的这段编码是用来替换sakmail中的编码的。
TotalType := '';
Found := FindInHeaders( 'CONTENT-TYPE:', HeaderPart, lines);
If Found Then begin
//专门用来对付elong的html邮件
If pos('text/html',HeaderPart[lines]) > 0 then begin
sakMsg.Text.Add('<html>');
end;
//找到类型
If FindInHeaders('multipart/',HeaderPart,lines) then begin //转发邮件和混合邮件
TotalType := 'MIX';
end else totaltype := 'NO'; //没有区间
//找有没有mime-version
attYn := FindInHeaders('MIME-VERSION:',headerpart,lines);
//找boundary字段
If FindInHeaders('BOUNDARY="',headerpart,lines) then begin
temps := copy(headerpart.strings[lines],Pos('"',headerpart.strings[lines])+1,length(headerpart.strings[lines])-1);
temps := copy(temps,0,Pos('"',temps)-1);
attYn := true; //如果找到了boundary字段肯定是有混合
end;
//
If FindInHeaders('Content-Transfer-Encoding:',headerPart,lines) then begin
FirstCode := trim(Copy(headerPart[lines],Pos(':',headerPart[lines])+1,length(HeaderPart[lines])));
If LowerCase(FirStCode) = 'quoted-printable' then FirStCode := 'QP';
If LowerCase(FirStCode) = 'base64' then FirStCode := 'BASE64';
end else FirStCode := '';
end;
//下面做邮件体处理
If attYn then begin
//如果是多媒体
If totalType = 'MIX' then begin
DeMulBoundMime(bodypart,temps,firstcode);
end
else begin
DeOneBoundMime(bodypart,temps,FirstCode);
end;
end
else begin
If FirstCode = 'QP' then QpDecodeText(Bodypart);
if(Firstcode = 'BASE64')then BaseDecodeText(bodypart);
For i := 0 to bodypart.count -2 do begin
sakmsg.Text.Add(bodypart);
end;
end;
/////////// 下面是子程序 //////////////////////////////////////
procedure TsakPOP.DeOneBoundMime(var s: tstringlist;bounds:string;coding:String);
var
line,i,k,l :Integer;
Encode :String; //编码方式
FnName :String; //文件名
FirstCode :String;
AttachFile :TAttachedFile;
BNull :boolean;
ns :Tstringlist;
begin
Bnull := true;
//解开一个块，该块是两个boundary之间的部分
If FindInHeaders('CONTENT-TYPE:',s,line) then begin
k := line;
If FindInHeaders('Content-Disposition:',s,line) then begin
If line > k then k := line;
end else line := k;
If (Pos('name="',lowercase(s[line])) > 0) or (Pos('name="',lowercase(s[line+1])) > 0) then begin //有文件名
If Pos('name="',lowercase(s[line])) > 0 then l := line else l:= line + 1;
FnName := Copy(s[l],pos('name="',lowercase(s[l]))+6,Length(s[l])-pos('name="',lowercase(s[l]))-6);
FnName := DecodeHeader(FnName,l);
If Pos('/',FnName)>0 then begin //去掉非法字符
While (pos('/',FnName)>0) do begin
FnName := Copy(FnName,Pos('/',FnName)+1,Length(FnName));
end;
end;
end else FnName := '';
//文件编码
If FindInHeaders('Content-Transfer-Encoding:',s,line) then begin
Encode := trim(Copy(s[line],Pos(':',s[line])+1,length(s[line])));
If LowerCase(EnCode) = 'quoted-printable' then EnCode := 'QP'
else
If LowerCase(EnCode) = 'base64' then EnCode := 'BASE64'
else
Encode := '';
i := line;
end else begin
EnCode := '';
i := k;
end;
//去掉无用行
If i < k then i := k;
If (i <> 0) or (k <> 0) then begin
For i := i to s.Count - 1 do if s = '' then break;
For k := 0 to i do s.Delete(0);
end;
If Encode <> '' then begin
k := 0;
while k < s.count do begin
If s[k] = '' then s.Delete(k) else k := k + 1;
end;
end;
end;
If coding <> '' then Encode := Coding;
//知道了文件名和编码方式
If FnName = '' then begin
If Encode = 'QP' then QpDecodeText(s);
If EnCode = 'BASE64' Then BaseDecodeText(s);
If sakmsg.Text.Count > s.count then begin
For i := 0 To s.count -1 do begin
sakMsg.Text.Add(s);
end;
end else SakMsg.Text.Assign(s);
end
else begin
sakMsg.AttachedFiles.Add(fnname);
AttachFile := sakMsg.attachedFiles[ sakMsg.attachedFiles.count-1];
with AttachFile do begin
If EnCode = 'BASE64' then BaseDecodeText(s);
If EnCOde = 'QP' then QPDecodeText(s);
FbodyBin := TmemoryStream.Create;
FBodyBin.Write( Pointer(s.text)^, length(s.text));
end;
end;
end;
procedure TsakPOP.DeMulBoundMime(var s: Tstringlist;bounds:string;coding:String);
var
SecondBound :String; //某个块内部的块分隔
Apart :TStringList; //某个块本身
i,j,k,fromi,endi :Integer; //变量
Mix_mailin,notEnd :boolean;
line :integer;
FirstCode :String; //编码形式
begin
//找寻新的块
NotEnd:= True;
apart := TstringList.Create;
While NotEnd Do begin
If FindInHeaders('--'+bounds,s,line) then begin
s.Delete(line);
Fromi := line; //本块开始
if FindInHeaders('--'+bounds,s,line) then begin
endi := Line - 1; //本块结束
//把块赋给相应的子块
For i:= fromi to endi do begin
apart.Add( s[Fromi]);
S.Delete(Fromi);
end;
If FindInHeaders('CONTENT-TYPE:',apart,line) then begin
k := line; //保存content-type位置
If FindInHeaders('boundary="',apart,line) then begin
SecondBound := Copy(apart[line],Pos('"',apart[line])+1,length(apart[line])-Pos('"',apart[line])-1);
if k < line then k := line;
For j := 0 to k do apart.Delete(0);
DeMulBoundMime(apart,SecondBound,'');
end //如果发现了新的块
Else begin
DeOneBoundMime(Apart,secondbound,''); //分解一个块
apart.Clear;
end;
end;
end;
end else NotEnd := False; //没有块了
End;//WHile
apart.free;
end;
编码挺乱的，不过还算好用。我试验了22种常见的pop3编码方式，其中的base64和qq编码
请参考相应控见。我的这段编码是用来替换sakmail中的编码的。