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:='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;//直接将文件名作为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;
现在问题是没有乱码了，没用编码(IdMessage支持自动编码成base64，我从它的单元文件中看到好像是的)
现在是内嵌式图片(inline )为什么会当作附件显示，邮件却没有附件标志
而且添加个附件的话,邮件中就会有附件标志，也能显示
说明两者还是有不同
用的是smtp.163.com
收用的是yahoo的邮箱
此内容由惯性聚合(RSS阅读器)自动聚合整理，仅供阅读参考。 原文来自 — 版权归原作者所有。