|
uses
IdComponent,IdTCPConnection, IdTCPClient, IdMessageClient, IdSMTP,IdBaseComponent,IdMessage,IdExplicitTLSClientServerBase, IdSMTPBase, IdAttachmentFile,IdText;//引用的与Indy10有关的单元 type //省去了窗体的定义部分 TSmtpThread = class(TThread) //定义的线程，用于发邮件 private FHost: String; FUserName: String; FPassword:String; // FPriority:TThreadPriority; protected procedure Execute; override; public constructor Create(Host:String;UserName:String;Password:String); destructor Destroy;override; function URLGet(s:String):String; function CIDGet(url:String):String; function UrlToCid(s:String;s1:String;s2:String):String; function InlineParse(s:String):String; end; var ComposeForm: TComposeForm; //窗体 not_relatedAttachmentList:TStrings;//用于记录附件信息 relatedAttachmentList:TStrings; //用于记录嵌式附件信息 //以下是具体执行部分 procedure TComposeForm.FormCreate(Sender: TObject); begin not_relatedAttachmentList:=Tstringlist.Create; relatedAttachmentList:=TStringList.Create; end; procedure TComposeForm.ComposeAttachmentExecute(Sender: TObject); begin if OpenDialog1.Execute then not_relatedAttachmentList.Add(OpenDialog1.FileName);//添加附件时加入文件名 end; //there we define some method in SmtpThread to send the message //writen in HTMLEdit1 and some transfrom ensure the success of sent of message. constructor TSmtpThread.Create(Host:String;UserName:String;Password:String); begin inherited Create(False); Priority :=tpNormal; FreeOnTerminate := True; FHost:=Host; FUserName:=UserName; FPassword:=Password; end; destructor TSmtpThread.Destroy; begin inherited Destroy; end; procedure TSmtpThread.Execute; var Smtp:TIdSMTP; Msg:TIdMessage; tempstr1,tempstr2:string; i:integer; begin tempstr1:=ComposeForm.HTMLEdit1.InnerHTML;//一个HTMLEdit控件, // 此语句产生 html格式的字符串 //各位也可用下面语句替换帮忙测试 //tempstr1:='<html><body><p>This message has an inline // image<img src="c:\temp\image1.gif" /></p></body></html>' tempstr2:=InlineParse(tempstr1);//执行内嵌式附件信的转化 Msg:=TIdMessage.Create(nil);//动态创建 //以下部分完成格式的匹配 //************************************************* if (relatedAttachmentList.Count>0) and (not_relatedAttachmentList.Count>0) then begin with TIdText.Create(Msg.MessageParts, nil) do begin ContentType := 'multipart/alternative'; ParentPart :=-1; end; with TIdText.Create(Msg.MessageParts, nil) do begin Body.Text :=tempstr2; ContentType := 'text/html'; ParentPart := 0; end; for i:=0 to relatedAttachmentList.Count-1 do with TIdAttachmentFile.Create(Msg.MessageParts, relatedAttachmentList.Strings[i]) do begin ContentID := CIDGet(relatedAttachmentList.Strings[i]); ContentType := 'image/*'; ContentDisposition := 'inline'; ParentPart := 0; end; for i:=0 to not_relatedAttachmentList.Count-1 do with TIdAttachmentFile.Create(Msg.MessageParts,not_relatedAttachmentList.Strings[i]) do begin ContentID := CIDGet(not_relatedAttachmentList.Strings[i]); ContentType := 'whatever'; ParentPart :=-1; end; Msg.ContentType:='multipart/mixed'; end; if (relatedAttachmentList.Count>0) and (not_relatedAttachmentList.Count<=0) then begin with TIdText.Create(Msg.MessageParts, nil) do begin Body.Text :=tempstr2; ContentType := 'text/html'; ParentPart := -1; end; for i:=0 to relatedAttachmentList.Count-1 do with TIdAttachmentFile.Create(Msg.MessageParts, relatedAttachmentList.Strings[i]) do begin ContentID := CIDGet(relatedAttachmentList.Strings[i]); ContentType := 'image/*'; ContentDisposition := 'inline'; ParentPart := -1; end; Msg.ContentType:='multipart/related; type="text/html"'; end; if (relatedAttachmentList.Count<=0) and (not_relatedAttachmentList.Count>0) then begin with TIdText.Create(Msg.MessageParts, nil) do begin Body.Text :=tempstr2; ContentType := 'text/html'; ParentPart := -1; end; for i:=0 to not_relatedAttachmentList.Count-1 do with TIdAttachmentFile.Create(Msg.MessageParts,not_relatedAttachmentList.Strings[i]) do begin ContentID := CIDGet(not_relatedAttachmentList.Strings[i]); ContentType := 'whatever'; ParentPart :=-1; end; Msg.ContentType:='multipart/mixed'; end; if (relatedAttachmentList.Count<=0) and (not_relatedAttachmentList.Count<=0) then begin with TIdText.Create(Msg.MessageParts, nil) do begin Body.Text :=tempstr2; ContentType := 'text/html'; ParentPart := -1; end; Msg.ContentType:='text/html'; end; //************************************************** with Msg do begin Clear; From.Address:='[email protected]';//直接输入，方便测试 //大家可以直接往我的这些邮箱中发，也方便我比较分析 ReplyTo.EMailAddresses:='[email protected]'; CCList.EMailAddresses:='[email protected]'; Subject:='ThanksForYourHelp'; Priority := TIdMessagePriority(mpHighest); end; Smtp:=TIdSMTP.Create(nil); with Smtp do begin Host:=FHost; Port:= 25; Username:=FUserName; Password:=FPassword; AuthType := atDefault; Connect; try Send(Msg); showmessage('success');//测试时加的 finally Disconnect; end; end; Msg.Free; Smtp.Free; end; function TSmtpThread.URLGet(s:String):String;//取得html中插入的图片等 //信息的物理地址,不知各位是怎么做的 var p:integer; begin result:=''; p:=Pos('src="cid',s); if p>0 then exit; p:=Pos('src="',s); if p>0 then begin s:=Copy(s,p+5,Length(s)-p-10); p:=Pos('"',s); result:=copy(s,1,p-1); end; end; function TSmtpThread.CIDGet(url:String):String;//直接将文件名作为CID begin //写成函数是方便以后改成其他处理方式 result:=ExtractFileName(url); end; function TSmtpThread.UrlToCid(s:String;s1:String;s2:String):String; var //转化HTML中的物理地址为CID p:Integer; begin p:=pos(s1,s); Delete(s,p,Length(s1)); Insert('cid:'+s2,s,p); result:=s; end; function TSmtpThread.InlineParse(s:string):String; var //对全文进行CID替换 htmlText:String; cid,url:String; begin htmlText:=s; url:=URLGet(htmlText); while url<>'' do begin relatedAttachmentList.Add(url); cid:=CIDGet(url); htmlText:=UrlToCid(htmlText,url,cid); url:=URLGet(htmlText); end; result:=htmlText; end; procedure TComposeForm.SendMailClick(Sender: TObject);//发信 begin //各位用自己邮箱帮忙测试哟，不甚感激 TSmtpThread.Create('smtp.163.com','linxiao8302','******'); end; 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; imple****tion {$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. To 小神通 StringToBase64()具体要用在什么地方呢，对哪部分进行编码啊？ 能说明的详细点吗？ IdMessage好像自动会将有关信息在发送前统一转化为Base64型吧，看看IdMessage.pas中的定义中好像是这样的 要帮忙看下格式定义那块是否正确，我有点怀疑那上面出了问题 结合问题具体指明哟 怎么没人回呀 用在读取出来是乱码的地方试试 在得到正文、标题等地方都要转换一下显示，好像是indy的一个bug。 应该是base64没解码的问题 这个是faststring 单元里面的base64解码程序，速度快 注意，不要用来解码空的字符串 function Base64Decode(const Source: string): string; var NewLength: Integer; begin { NB: On invalid input this routine will simply skip the bad data, a better solution would probably report the error ESI -> Source String EDI -> Result String ECX -> length of Source (number of DWords) EAX -> 32 Bits from Source EDX -> 24 Bits Decoded BL -> Current number of bytes decoded } SetLength( Result, (Length(Source) div 4) * 3); NewLength := 0; asm Push ESI Push EDI Push EBX Mov ESI, Source Mov EDI, Result //Result address Mov EDI, [EDI] Or ESI,ESI // Nil Strings Jz @Done Mov ECX, [ESI-4] Shr ECX,2 // DWord Count JeCxZ @Error // Empty String Cld jmp @Read4 @Next: Dec ECX Jz @Done @Read4: lodsd Xor BL, BL Xor EDX, EDX Call @DecodeTo6Bits Shl EDX, 6 Shr EAX,8 Call @DecodeTo6Bits Shl EDX, 6 Shr EAX,8 Call @DecodeTo6Bits Shl EDX, 6 Shr EAX,8 Call @DecodeTo6Bits // Write Word Or BL, BL JZ @Next // No Data Dec BL Or BL, BL JZ @Next // Minimum of 2 decode values to translate to 1 byte Mov EAX, EDX Cmp BL, 2 JL @WriteByte Rol EAX, 8 BSWAP EAX StoSW Add NewLength, 2 @WriteByte: Cmp BL, 2 JE @Next SHR EAX, 16 StoSB Inc NewLength jmp @Next @Error: jmp @Done @DecodeTo6Bits: @TestLower: Cmp AL, 'a' Jl @TestCaps Cmp AL, 'z' Jg @Skip Sub AL, 71 Jmp @Finish @TestCaps: Cmp AL, 'A' Jl @TestEqual Cmp AL, 'Z' Jg @Skip Sub AL, 65 Jmp @Finish @TestEqual: Cmp AL, '=' Jne @TestNum // Skip byte ret @TestNum: Cmp AL, '9' Jg @Skip Cmp AL, '0' JL @TestSlash Add AL, 4 Jmp @Finish @TestSlash: Cmp AL, '/' Jne @TestPlus Mov AL, 63 Jmp @Finish @TestPlus: Cmp AL, '+' Jne @Skip Mov AL, 62 @Finish: Or DL, AL Inc BL @Skip: Ret @Done: Pop EBX Pop EDI Pop ESI end; SetLength( Result, NewLength); // Trim off the excess end;
现在是内嵌式图片(inline )为什么会当作附件显示，邮件却没有附件标志 而且添加个附件的话,邮件中就会有附件标志，也能显示 说明两者还是有不同 用的是smtp.163.com 收用的是yahoo的邮箱 |
|