B
beij
Unregistered / Unconfirmed
GUEST, unregistred user!
如何使用indy发送图片，不是以附件的形式，而是直接在邮件中显示图片？
L
lqcros
Unregistered / Unconfirmed
GUEST, unregistred user!
不能实现吧，
B
beij
Unregistered / Unconfirmed
GUEST, unregistred user!
看过相关报道，应该是可以实现的。
V
Vsun
Unregistered / Unconfirmed
GUEST, unregistred user!
把邮件已HTML格式进行发送即可，但不能将本地的图片发送出去。
L
lqcros
Unregistered / Unconfirmed
GUEST, unregistred user!
http://www.cnblogs.com/Thinknet/archive/2008/11/13/1332675.htmlIndy10,采用线程，发送电子邮件 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);beginnot_relatedAttachmentList:=Tstringlist.Create; relatedAttachmentList:=TStringList.Create;end;procedure TComposeForm.ComposeAttachmentExecute(Sender: TObject);beginif 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>This message has an inline// image<img src="c:/temp/image1.gif" />
</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) do begin ContentID := CIDGet(relatedAttachmentList.Strings); ContentType := 'image/*'; ContentDisposition := 'inline'; ParentPart := 0; end; for i:=0 to not_relatedAttachmentList.Count-1 do with TIdAttachmentFile.Create(Msg.MessageParts,not_relatedAttachmentList.Strings) do begin ContentID := CIDGet(not_relatedAttachmentList.Strings); 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) do begin ContentID := CIDGet(relatedAttachmentList.Strings); 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) do begin ContentID := CIDGet(not_relatedAttachmentList.Strings); 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:='linxiao8302@163.com';//直接输入，方便测试//大家可以直接往我的这些邮箱中发，也方便我比较分析 ReplyTo.EMailAddresses:='scandinavian0330@yahoo.com'; CCList.EMailAddresses:='scandinavian0330@yahoo.com'; 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;//直接将文件名作为CIDbegin //写成函数是方便以后改成其他处理方式 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, abetter 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 excessend;-------------------------------------------------------------------------------- 现在问题是没有乱码了，没用编码(IdMessage支持自动编码成base64，我从它的单元文件中看到好像是的)现在是内嵌式图片(inline )为什么会当作附件显示，邮件却没有附件标志而且添加个附件的话,邮件中就会有附件标志，也能显示说明两者还是有不同用的是smtp.163.com收用的是yahoo的邮箱
</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) do begin ContentID := CIDGet(relatedAttachmentList.Strings); ContentType := 'image/*'; ContentDisposition := 'inline'; ParentPart := 0; end; for i:=0 to not_relatedAttachmentList.Count-1 do with TIdAttachmentFile.Create(Msg.MessageParts,not_relatedAttachmentList.Strings) do begin ContentID := CIDGet(not_relatedAttachmentList.Strings); 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) do begin ContentID := CIDGet(relatedAttachmentList.Strings); 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) do begin ContentID := CIDGet(not_relatedAttachmentList.Strings); 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:='linxiao8302@163.com';//直接输入，方便测试//大家可以直接往我的这些邮箱中发，也方便我比较分析 ReplyTo.EMailAddresses:='scandinavian0330@yahoo.com'; CCList.EMailAddresses:='scandinavian0330@yahoo.com'; 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;//直接将文件名作为CIDbegin //写成函数是方便以后改成其他处理方式 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, abetter 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 excessend;-------------------------------------------------------------------------------- 现在问题是没有乱码了，没用编码(IdMessage支持自动编码成base64，我从它的单元文件中看到好像是的)现在是内嵌式图片(inline )为什么会当作附件显示，邮件却没有附件标志而且添加个附件的话,邮件中就会有附件标志，也能显示说明两者还是有不同用的是smtp.163.com收用的是yahoo的邮箱
B
beij
Unregistered / Unconfirmed
GUEST, unregistred user!
谢了 lqcros,我测试一下。
B
beij
Unregistered / Unconfirmed
GUEST, unregistred user!
lqcros:用你的方法，图片仍然是以附件的形式。
U
ufo
Unregistered / Unconfirmed
GUEST, unregistred user!
图片应该是编码在html里面，具体建议参考一下mht的文件结构。
B
beij
Unregistered / Unconfirmed
GUEST, unregistred user!
图片是编码在html里面,可是显示出来是一个红色的叉号，没法正常显示。谢谢回复。
U
ufo
Unregistered / Unconfirmed
GUEST, unregistred user!
那可能是编码方式不正确，或者分割方式不正确。你可以打开一个带图片的html邮件，然后查看原文件，然后依样画葫芦编码就行了。
B
beij
Unregistered / Unconfirmed
GUEST, unregistred user!
谢谢UFO!:能否帮忙看看lqcros的代码？如何分割？
L
lqcros
Unregistered / Unconfirmed
GUEST, unregistred user!
利用Indy组件发送HTML格式的多信息邮件- - 今天辛苦一天，研究这个破东西，刚开始有老鸟帮助，知道了错在那里，最后才开始解决，就这也是边抄边找，才搞到了个完整代码。uses idMessage; procedure TForm1.Button1Click(Sender: TObject); var html: TStrings; htmpart, txtpart: TIdText; bmppart: TIdAttachment; email: TIdMessage; filename: string; begin filename := ExtractFilePath(Application.ExeName) + 'YouImg.jpg'; html := TStringList.Create(); html.Add('<html>'); html.Add('<head>'); html.Add('</head>'); html.Add('<body><h1>Hello</h1>'); html.Add('<img src="cid:YouImg.jpg" />'); //这里这个CID是什么意思，还没弄明白。 html.Add('This is a picture!</body>'); html.Add('</html>'); email := TIdMessage.Create(nil); email.From.Text := 'you@from.com'; email.Recipients.EMailAddresses := 'my@mail.com'; email.Subject := 'Hello'; email.ContentType := 'multipart/mixed'; email.Body.Assign(html); txtpart := TIdText.Create(email.MessageParts); txtpart.ContentType := 'text/plain'; txtpart.Body.Text := ''; htmpart := TIdText.Create(email.MessageParts, html); htmpart.ContentType := 'text/html'; bmppart := TIdAttachmentFile.Create(email.MessageParts, filename); bmppart.ContentType := 'image/jpeg'; bmppart.FileIsTempFile := true; bmppart.ContentDisposition := 'inline'; bmppart.ExtraHeaders.Values['content-id'] := 'YouImg.jpg'; bmppart.DisplayName := 'YouImg.jpg'; //以下发送代码，不用罗嗦end;
B
beij
Unregistered / Unconfirmed
GUEST, unregistred user!
谢谢lqcros:用你的代码发图片附件没有问题，可是插入邮件正文的图片只显示一个红色的叉号，不能正确显示。
L
lqcros
Unregistered / Unconfirmed
GUEST, unregistred user!
//delph 2009 indy10 通过procedure TformMain.butnSendMailClick(Sender: TObject);var html: TStrings; filename: string; htmpart, txtpart: TIdText; bmppart: TIdAttachmentFile;begin filename := ExtractFilePath(Application.ExeName) + 'YouImg.jpg'; html := TStringList.Create; html.Add('<html>'); html.Add('<head>'); html.Add('</head>'); html.Add('<body><h1>Hello</h1>'); html.Add('<img src="cid:YouImg.jpg" />'); //这里这个CID是什么意思，还没弄明白。 html.Add('This is a picture!</body>'); html.Add('</html>'); butnSendMail.Enabled := False; try with mesgMessage do begin Clear; From.Text := Trim(editFrom.Text); Recipients.EMailAddresses := Trim(editTo.Text); Subject := Trim(editSubject.Text); end; with TIdText.Create(mesgMessage.MessageParts, nil) do begin ContentType := 'multipart/alternative'; ParentPart :=-1; end; with TIdText.Create(mesgMessage.MessageParts, nil) do begin Body.Text := html.Text; ContentType := 'text/html'; ParentPart := 0; end; with TIdAttachmentFile.Create(mesgMessage.MessageParts, filename) do begin ContentID := filename; ContentType := 'image/*'; ContentDisposition := 'inline'; ParentPart := 0; end; mesgMessage.ContentType:='multipart/mixed'; mesgMessage.SaveToFile('1.txt'); with smtpSendMail do begin Host := Trim(editSMTPServer.Text); Connect; try Send(mesgMessage); finally Disconnect; end; end; Status('Completed'); finally butnSendMail.Enabled := True; end;end;
L
lqcros
Unregistered / Unconfirmed
GUEST, unregistred user!
上面哪段代码，我测试了的，可以在邮件正文件里显示图片,我用smtp.163.com服务器发送到 126的邮箱的，可以使用的下面的是编码的邮件From: "lqcros@163.com" <lqcros@163.com>Subject: testTo: lqcros@126.comContent-Type: multipart/mixed; boundary="u0L4NmilxB2BoOb=_P8qdZvhNn3ueG3gHJ"MIME-Version: 1.0Date: Sun, 22 Feb 2009 15:02:17 +0800This is a multi-part message in MIME format--u0L4NmilxB2BoOb=_P8qdZvhNn3ueG3gHJContent-Type: multipart/alternative; boundary="Q4ufHQ0DUcM5y=_OQNPTuwPNBvOGV6k48O"--Q4ufHQ0DUcM5y=_OQNPTuwPNBvOGV6k48O----u0L4NmilxB2BoOb=_P8qdZvhNn3ueG3gHJContent-Type: text/htmlContent-Transfer-Encoding: quoted-printableContent-Disposition: inline<html><head></head><body><h1>Hello</h1><img src=3D"cid:YouImg.jpg" />This is a picture!</body></html>--u0L4NmilxB2BoOb=_P8qdZvhNn3ueG3gHJContent-Type: image/* name="YouImg.jpg"Content-Transfer-Encoding: base64Content-Disposition: inline filename="YouImg.jpg"Content-ID: YouImg.jpgcontent-id: YouImg.jpg/9j/4AAQSkZJRgABAQEAYABgAAD/2wBDAAgGBgcGBQgHBwcJCQgKDBQNDAsLDBkSEw8UHRofHh0aHBwgJC4nICIsIxwcKDcpLDAxNDQ0Hyc5PTgyPC4zNDL/2wBDAQkJCQwLDBgNDRgyIRwhMjIyMjIyMjIyMjIyMjIyMjIyMjIyMjIyMjIyMjIyMjIyMjIyMjIyMjIyMjIyMjIyMjL/wAARCAA8AFADASIAAhEBAxEB/8QAHwAAAQUBAQEBAQEAAAAAAAAAAAECAwQFBgcICQoL/8QAtRAAAgEDAwIEAwUFBAQAAAF9AQIDAAQRBRIhMUEGE1FhByJxFDKBkaEII0KxwRVS0fAkM2JyggkKFhcYGRolJicoKSo0NTY3ODk6Q0RFRkdISUpTVFVWV1hZWmNkZWZnaGlqc3R1dnd4eXqDhIWGh4iJipKTlJWWl5iZmqKjpKWmp6ipqrKztLW2t7i5usLDxMXGx8jJytLT1NXW19jZ2uHi4+Tl5ufo6erx8vP09fb3+Pn6/8QAHwEAAwEBAQEBAQEBAQAAAAAAAAECAwQFBgcICQoL/8QAtREAAgECBAQDBAcFBAQAAQJ3AAECAxEEBSExBhJBUQdhcRMiMoEIFEKRobHBCSMzUvAVYnLRChYkNOEl8RcYGRomJygpKjU2Nzg5OkNERUZHSElKU1RVVldYWVpjZGVmZ2hpanN0dXZ3eHl6goOEhYaHiImKkpOUlZaXmJmaoqOkpaanqKmqsrO0tba3uLm6wsPExcbHyMnK0tPU1dbX2Nna4uPk5ebn6Onq8vP09fb3+Pn6/9oADAMBAAIRAxEAPwDwyRMN0pmDVicA8jmoDz1pI7GrMYalLO8gLny9wGDjAx0zxUdKPmI3Mdo4z1wKokUFFVcFycHI6YPb60pZmRy2fmOcjgZHt+NPZwJHkhVoeTgK3RTxjPU1f0T7CuvWz31lLc2SSB5LdXwSg5JJA5AHJHGR3FApNpXSuZ0gODGJVdI8kEHAP0zTEUs2BknsK09buoLjUryXT7eOGwMhSJAM7VzkYzznjOR/Lis0Ocgg428AjijoKD5km1YaRzTwowTTR97NSLyOoqWXYldP3ZzwarmrjjJbP61TYcnikipKw011nh7SvC2qaFqT6nqM+nX9vGHjbAdH+YDhep68jr3HTB5TqKTkHI61onYxqQclo7FrZArTDzzJgjYyKQH59D7c9KGjIh8wKoAOGx6nkf1/Ktrw9op1EOrIScqARn5Scnn8qv8AiDw22nW8J2fMxO7IPJwDj/x6lc3VN8vMcqlpc3d4IYLeWW4c8Rxxkk/QDmn3+l32lT+Rf20lvLgHZIMGp9I1m70HUfttm2LpUKo552kjGfcjt6HB7VTurq4vJ5Li4mkllc7md2LEmhiSjbzIalCk45/Coh1/+tVqNSjA8GpYoq5PKM/MvQ+tU5l5zV9Y2aDJyMdsVXkiJFTE1lFtXKY6VLaQNPeRRKMlmAxSImc1f0qa2g1G2e53RhJAfNUZAGf4h6e459jVN2VzPl7n0X4K8FQWcUVyUALbWZSOpA/+yNa/iHwnbajG8jxgjqFx7Ef1/StbwlqEWo6Bb3KFGOwBipyM9CP/AB3+VaWp3CW+nzzsuViVmOBngAn+lLSxbrSU7HxzrunfYNfuraUFCJGwAOgqo1gNgaOUH1DgLj9TWp4kvPt/iO7vpJNrSSEhFXcfxzx/OsvzXZcCRFHTlB/PFUndAlHXQSKxkMmN6Z+pqeS3Nt98gn0wePzFSW1vIULCeD2B2jJ/Gp3W8ciMznaBjAmGMfQGobLULK9izZ2+9XGSQc4qlNDj5lOATzmtG1cxzFV6ZqpMg8yQdgcis4vU6nFciMzytr+1SW8kUF5FMY1kCMG2yMQhwehxzj6EH0pJz++/Con55re1zmaWx7F8PfFiWatpkEUEVxPZyNZwxlx5jIN3O5m2khWCsWBPHygYzb8Y+LNd1SHxHb6ddzW0WjXUdvLsmwk6vuVtzcYIZWPPylScj5efMPDKLbanpd+BvmF7EgDE4GXAzxjn68eoNdr8V7qQLNDGEhtxdyQeRGuEJWRx5h7mQiKNdx7LgYFczjyyt3OVpqaR5xMLRFcKyzXEhJeRVCxp7IOM/XAA7DvT7e2iYDM6Lk9Gj3fjWbn5c1NbsRMtdNrI64NR0audpY6Pp/2VXl1OAHqFFrn+laZ8MaOsTT/2svyjPFuwrlJf9bEo4G2rF3I62CqGOD1rnkzutHXTY//Z--u0L4NmilxB2BoOb=_P8qdZvhNn3ueG3gHJ--.
B
beij
Unregistered / Unconfirmed
GUEST, unregistred user!
我在D7+INDY9下还是有问题。安装了INDY10 for D7,可是有问题，比如定义 htmpart, txtpart: TIdText居然说TIdText不能识别，我已经引用了 IDMessage不过不能打开IDMessage,都是乱码。
L
lqcros
Unregistered / Unconfirmed
GUEST, unregistred user!
delphi7 indy9 通过procedure TForm1.Button1Click(Sender: TObject);var filename: string;beginfilename := ExtractFilePath(Application.ExeName) + 'YouImg.jpg';//MemoInfo.Clear;//1:对所必须要的信息进行进行检验 //校验服务器属性 if (Trim(HostName.Text)='') or (Trim(HostPort.Text)='') thenbegin ShowMessage('请设置所要连接的SMTP服务器属性！'); HostPort.Text:='25';HostName.SetFocus;Exit;end;//检测地址信息 if (Trim(EditFrom.Text)='') or (Trim(EditTo.Text)='') thenbegin ShowMessage('请输入收信人或者发信人地址！'); EditFrom.SetFocus ; Exit; end;//用户账号检验if (Trim(EditUser.Text)='') or (Trim(EditPass.Text)='') thenbeginShowMessage('请正确输入用户登录帐号和密码！'); EditUser.SetFocus; Exit; end; //设置连接到服务器属性 with IdSMTP dobegin Host := Trim(HostName.Text); //SMTP服务器地址 Port := StrToInt(Trim(HostPort.Text)); //SMTP服务器端口 UserName := Trim(EditUser.Text); //用户账号 Password := Trim(EditPass.Text); // 用户密码end;//IdEncoderMIME1.EncodeString(//连接到服务器MemoInfo.Lines.Add('第一步：准备连接到服务器！'+HostName.Text);try IdSMTP.Connect(); //调用 Connect连接服务器 MemoInfo.Lines.Add('---------------------返回信息--连接服务器'+ ' ' + IntToStr(IdSMTP.LastCmdResult.NumericCode) ); MemoInfo.Lines.AddStrings(IdSMTP.LastCmdResult.Text);except //连接失败begin MemoInfo.Lines.Add('无法连接到服务器！'+HostName.Text); Exit;end ; end;MemoInfo.Lines.Add('第二步：服务器要求验证');//身份验证//检测SMTP服务器是否需要验证if (IdSMTP.AuthSchemesSupported.IndexOf ( 'LOGIN' ) <> -1) thenbegin //服务器要求验证 MemoInfo.Lines.Add('服务器要求验证'); IdSMTP.AuthenticationType:=atlogin;endelsebegin //服务器不要求验证 MemoInfo.Lines.Add('服务器不需要验证'); end;MemoInfo.Lines.Add('---------------------返回信息--要求验证'+ ' ' + IntToStr(IdSMTP.LastCmdResult.NumericCode) );MemoInfo.Lines.AddStrings(IdSMTP.LastCmdResult.Text);MemoInfo.Lines.Add('第三步：开始验证');try if IdSMTP.Authenticate then //验证通过 MemoInfo.Lines.Add('服务器验证通过') else MemoInfo.Lines.Add('服务器验证失败'); //验证失败except MemoInfo.Lines.Add('服务器验证失败1'); IdSMTP.Disconnect; exit;end;MemoInfo.Lines.Add('---------------------返回信息--验证'+ ' ' + IntToStr(IdSMTP.LastCmdResult.NumericCode) );MemoInfo.Lines.AddStrings(IdSMTP.LastCmdResult.Text);//对MailMessage属性进行赋值with MailMessage dobegin NoDecode := False;NoEncode := False;ContentType := 'multipart/mixed';Encoding := meMIME;MsgId := 'PrettyPic';References := ChangeFileExt(ExtractFileName(filename), ''); Subject := EditSubject.Text; //邮件主题// Body.Assign(MemoMesg.Lines);//邮件正文 From.Address:=Trim(EditFrom.Text); //发信人地址 Recipients.EMailAddresses := Trim(editTo.Text); //收件人地址 CCList.EMailAddresses := EditCC.Text; //抄送 BCCList.EMailAddresses:= EditBCC.Text; //暗送// for indexnum:=0 to ListBox1.Items.Count -1 do// TIdAttachment.Create(MailMessage.MessageParts,ListBox1.Items.Strings[indexnum]);end; with TIdText.Create(MailMessage.MessageParts, nil) do begin// ContentType := 'multipart/mixed';//'multipart/alternative'; ContentType := 'text/plain'; Body.Add('Hello, friends.'); Body.Add(''); end; with TIdText.Create(MailMessage.MessageParts, nil) do begin ContentType := 'text/html; charset=US-ASCII';ContentTransfer := '7bit';Body.Add('<html>');Body.Add(' <head>');Body.Add(' <title>Hello</title>');Body.Add(' </head>');Body.Add(' <body title="' + MailMessage.References + '" background="cid:BackgroundStars">');Body.Add(' Hello, friends.
');Body.Add('
');Body.Add(' <img src="cid
rettyPic" alt="' + ExtractFileName(Filename) + '" name="' + ExtractFileName(Filename) + '" title="Just an image included.">');Body.Add(' </body>');Body.Add('</html>'); end; with TIdAttachment.Create(MailMessage.MessageParts, filename) do begin ExtraHeaders.Values['Content-ID'] := '<PrettyPic>'; ContentType := 'image/jpeg'; end; with TIdAttachment.Create(MailMessage.MessageParts, filename) do begin ExtraHeaders.Values['Content-ID'] := '<BackgroundStars>'; ContentType := 'image/jpeg'; end; MailMessage.SaveToFile('1.txt');MemoInfo.Lines.Add('第四步：开始发送邮件');//发送信件try IdSMTP.Send(MailMessage); if IdSMTP.LastCmdResult.NumericCode = 250 then MemoInfo.Lines.Add('---------------------发送成功'+ ' ' + IntToStr(IdSMTP.LastCmdResult.NumericCode) ) else MemoInfo.Lines.Add('---------------------发送失败'+ ' ' + IntToStr(IdSMTP.LastCmdResult.NumericCode) );except MemoInfo.Lines.Add('发送失败');end;MemoInfo.Lines.Add('---------------------返回信息—发送邮件成功'+ ' ' + IntToStr(IdSMTP.LastCmdResult.NumericCode) );MemoInfo.Lines.AddStrings(IdSMTP.LastCmdResult.Text);MemoInfo.Lines.Add('第五步：断开服务器');IdSMTP.Disconnect;MemoInfo.Lines.Add('---------------------返回信息--连接断开' + ' ' + IntToStr(IdSMTP.LastCmdResult.NumericCode) );MemoInfo.Lines.AddStrings(IdSMTP.LastCmdResult.Text);//发送完成end;
');Body.Add('
');Body.Add(' <img src="cid
rettyPic" alt="' + ExtractFileName(Filename) + '" name="' + ExtractFileName(Filename) + '" title="Just an image included.">');Body.Add(' </body>');Body.Add('</html>'); end; with TIdAttachment.Create(MailMessage.MessageParts, filename) do begin ExtraHeaders.Values['Content-ID'] := '<PrettyPic>'; ContentType := 'image/jpeg'; end; with TIdAttachment.Create(MailMessage.MessageParts, filename) do begin ExtraHeaders.Values['Content-ID'] := '<BackgroundStars>'; ContentType := 'image/jpeg'; end; MailMessage.SaveToFile('1.txt');MemoInfo.Lines.Add('第四步：开始发送邮件');//发送信件try IdSMTP.Send(MailMessage); if IdSMTP.LastCmdResult.NumericCode = 250 then MemoInfo.Lines.Add('---------------------发送成功'+ ' ' + IntToStr(IdSMTP.LastCmdResult.NumericCode) ) else MemoInfo.Lines.Add('---------------------发送失败'+ ' ' + IntToStr(IdSMTP.LastCmdResult.NumericCode) );except MemoInfo.Lines.Add('发送失败');end;MemoInfo.Lines.Add('---------------------返回信息—发送邮件成功'+ ' ' + IntToStr(IdSMTP.LastCmdResult.NumericCode) );MemoInfo.Lines.AddStrings(IdSMTP.LastCmdResult.Text);MemoInfo.Lines.Add('第五步：断开服务器');IdSMTP.Disconnect;MemoInfo.Lines.Add('---------------------返回信息--连接断开' + ' ' + IntToStr(IdSMTP.LastCmdResult.NumericCode) );MemoInfo.Lines.AddStrings(IdSMTP.LastCmdResult.Text);//发送完成end;
B
beij
Unregistered / Unconfirmed
GUEST, unregistred user!
谢谢lqcros的热情帮助，能够显示一个矩形框，矩形框里的内容是一个红叉后面跟图片的名字。右击矩形框，选择属性显示：协议：未知协议类型：不可用地址：cidPrettyPic大小：不可用尺寸：99 X 30 pixels
B
beij
Unregistered / Unconfirmed
GUEST, unregistred user!
搞定了。