谈用Delphi设计Email程序

传统的Email发送是基于smtp协议.也就是说,只要你的程序遵守RFC821规范的应答方式即可.实际应用中还有例如Web中转,ISAPI,MMX等等变种方式.最近不是有位权威说"代码就是开发文档"吗?所以,其它说话无须多讲,让我们直接开始code吧.

一:用API方式实现email邮件的发送.

  我们首先将常用的网络操作单元集合为一个单元.注意:我们下面讲述Web发送的时候还会用到这个单元.

unit Unit_MyWinSock;

{=======================================================
项目: 谈用Delphi设计Email程序 － 封装常用网络API单元
模块: 网络API单元
描述:
版本: 2004
日期: 2004-03-09
作者: 陈经韬
更新:
=======================================================}

interface
uses
Windows, WinSock;

function GetIpbyHostName(Host: string): string;
function StartNet(host: string; port: integer; var FSocket: integer): Boolean;
procedure StopNet(Fsocket: integer);
function SendData(FSocket: integer; SendStr: string): integer;
function GetData(FSocket: integer): string;
implementation

function StrPas(const Str: PChar): string;
begin
Result := Str;
end;

function StrCopy(Dest: PChar; const Source: PChar): PChar;
asm
PUSH EDI
PUSH ESI
MOV ESI,EAX
MOV EDI,EDX
MOV ECX,0FFFFFFFFH
XOR AL,AL
REPNE SCASB
NOT ECX
MOV EDI,ESI
MOV ESI,EDX
MOV EDX,ECX
MOV EAX,EDI
SHR ECX,2
REP MOVSD
MOV ECX,EDX
AND ECX,3
REP MOVSB
POP ESI
POP EDI
end;

function StrLen(const Str: PChar): Cardinal; assembler;
asm
MOV EDX,EDI
MOV EDI,EAX
MOV ECX,0FFFFFFFFH
XOR AL,AL
REPNE SCASB
MOV EAX,0FFFFFFFEH
SUB EAX,ECX
MOV EDI,EDX
end;
{============================================================}

function GetIpbyHostName(Host: string): string;
{
功能描述:获取主机的IP地址
入口参数:主机名称.例如www.138soft.com
出口参数:主机IP地址
创建日期:2004,3,9.
修改记录:无
Author:jingtao.http://www.138soft.com
}
type
TaPInAddr = array[0..10] of PInAddr;
PaPInAddr = ^TaPInAddr;
var
phe: PHostEnt;
pptr: PaPInAddr;
i: Integer;
begin
Result := '';
phe := GetHostByName(pchar(Host));
if phe = nil then Exit;
pptr := PaPInAddr(Phe^.h_addr_list);
I := 0;
while pptr^[I] <> nil do
begin
if i = 0 then result := StrPas(inet_ntoa(pptr^[I]^));
Inc(I);
end;
end;

{============================================================}

function StartNet(host: string; port: integer; var FSocket: integer): Boolean;
{
功能描述:连接某IP地址
入口参数:
host:ip地址
port:端口
出口参数:
FSocket:连接后的Socket句柄
返回值:成功连接返回True,否则返回False
创建日期:2004,3,9.
修改记录:无
Author:jingtao.http://www.138soft.com
}
var
SockAddrIn: TSockAddrIn;
t: linger;

timeout: timeval;
r: TFDSet;
iTimeOut: integer;
ul, ul1: LongInt;
ret: integer;
begin
Result := False;
FSocket := socket(PF_INET, SOCK_STREAM, IPPROTO_IP);
if FSocket = invalid_socket then exit;

t.l_onoff := 1;
t.l_linger := 0;
setsockopt(FSocket, SOL_SOCKET, SO_LINGER, @t, sizeof(t)); {关闭Socket后立刻释放资源}

//set Recv and Send time out
iTimeOut := 6000; //设置发送超时6秒
if (setsockopt(FSocket, SOL_SOCKET, SO_SNDTIMEO, @iTimeOut, sizeof(TimeOut)) = SOCKET_ERROR) then Exit;
iTimeOut := 6000; //设置接收超时6秒
if (setsockopt(FSocket, SOL_SOCKET, SO_RCVTIMEO, @iTimeOut, sizeof(TimeOut)) = SOCKET_ERROR) then Exit;

//设置非阻塞方式连接
ul := 1;
ret := ioctlsocket(FSocket, FIONBIO, ul);
if (ret = SOCKET_ERROR) then Exit;

//连接
SockAddrIn.sin_addr.s_addr := inet_addr(PChar(host));
SockAddrIn.sin_family := PF_INET;
SockAddrIn.sin_port := htons(port);
ret := connect(FSocket, SockAddrIn, SizeOf(SockAddrIn));


//select 模型，即设置超时
FD_ZERO(r);
FD_SET(FSocket, r);
timeout.tv_sec := 5; //连接超时5秒
timeout.tv_usec := 0;
ret := select(0, nil, @r, nil, @timeout);
if (ret <= 0) then
begin
closesocket(FSocket);
Exit;
end;
//一般非锁定模式套接比较难控制，可以根据实际情况考虑 再设回阻塞模式
ul1 := 0;
ret := ioctlsocket(FSocket, FIONBIO, ul1);
if (ret = SOCKET_ERROR) then
begin
closesocket(FSocket);
Exit;
end;
Result := True;
end;

{============================================================}

procedure StopNet(Fsocket: integer);
{
功能描述:关闭一个Socket
入口参数:
Fsocket:欲关闭的socket
出口参数:无
返回值:无
创建日期:2004,3,9.
修改记录:无
Author:jingtao.http://www.138soft.com
}
begin
closesocket(FSocket);
end;

{============================================================}

function SendData(FSocket: integer; SendStr: string): integer;
{
功能描述:通过指定Socket发送字符数据
入口参数:
Fsocket:socket
SendStr:欲发送的字符
出口参数:无
返回值:成功返回发送的数据大小,否则返回-1(SOCKET_ERROR)
创建日期:2004,3,9.
修改记录:无
Author:jingtao.http://www.138soft.com
}
var
DataBuf: array[0..4096] of char;
err: integer;
begin
strcopy(DataBuf, pchar(SendStr));
err := send(FSocket, DataBuf, strlen(DataBuf), MSG_DONTROUTE);
Result := err;
end;

{============================================================}

function GetData(FSocket: integer): string;
{
功能描述:获取指定Socket的字符数据
入口参数:
Fsocket:socket
出口参数:无
返回值:以字符串形式返回数据
创建日期:2004,3,9.
修改记录:无
Author:jingtao.http://www.138soft.com
}
const
MaxSize = 1024;
var
DataBuf: array[0..MaxSize] of char;
err: integer;
begin
err := recv(FSocket, DataBuf, MaxSize, 0);
Result := Strpas(DataBuf);
end;
{
const
MaxSize = 1024;
var
DataBuf: array[0..MaxSize - 1] of char;
S: string;
iRet: integer;
begin
S := '';
repeat
FillChar(DataBuf, MaxSize, #0);
iRet := recv(FSocket, DataBuf, MaxSize, 0);
S := S + Strpas(DataBuf);
until iRet <= 0;
Result := S;
end;
}
{============================================================}
var
Re: integer;
Wsa: TWSAData;
initialization
Re := WSAStartup($101, Wsa); //初始化Wsock32.dll,如果是2.2版本,则使用MakeWord(2,2),
if Re <> 0 then Halt;
finalization
WSACleanUp;
end.


    另外,我们还要用到Base64编码.这里是它的Delphi版本.

unit BASE64;

interface

uses Classes;
//BaseTable为BASE64码表
const BaseTable:string='ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/=';
function EncodeStringBase64(Source:string):string;
function DecodeStringBASE64(Source:string):string;
function EncodeStreamBASE64(Encoded: TMemoryStream ; Decoded: TMemoryStream): Integer;
implementation

{对参数TMemoryStrema中的字节流进行Base64编码，编码后的结果保存在Encoded中，函数返回编码长度}
function EncodeStreamBASE64(Encoded: TMemoryStream ; Decoded: TMemoryStream): Integer;
const
_Code64: String[64] =('ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/');
var
I: LongInt;
B: array[0..2279] of Byte;
J, K, L, M, Quads: Integer;
Stream: string[76];
EncLine: String;
begin
Encoded.Clear;
Stream := '';
Quads := 0;
{为提高效率，每2280字节流为一组进行编码}
J := Decoded.Size div 2280;
Decoded.Position := 0;
{对前J*2280个字节流进行编码}
for I := 1 to J do
begin
Decoded.Read(B, 2280);
for M := 0 to 39 do
begin
for K := 0 to 18 do
begin
L:= 57*M + 3*K;
Stream[Quads+1] := _Code64[(B[L] div 4)+1];
Stream[Quads+2] := _Code64[(B[L] mod 4)*16 + (B[L+1] div 16)+1];
Stream[Quads+3] := _Code64[(B[L+1] mod 16)*4 + (B[L+2] div 64)+1];
Stream[Quads+4] := _Code64[B[L+2] mod 64+1];
Inc(Quads, 4);
if Quads = 76 then
begin
Stream[0] := #76;
EncLine := Stream+#13#10;
Encoded.Write(EncLine[1], Length(EncLine));
Quads := 0;
end;
end;
end;
end;

{对以2280为模的余数字节流进行编码}
J := (Decoded.Size mod 2280) div 3;
for I := 1 to J do
begin
Decoded.Read(B, 3);
Stream[Quads+1] := _Code64[(B[0] div 4)+1];
Stream[Quads+2] := _Code64[(B[0] mod 4)*16 + (B[1] div 16)+1];
Stream[Quads+3] := _Code64[(B[1] mod 16)*4 + (B[2] div 64)+1];
Stream[Quads+4] := _Code64[B[2] mod 64+1];
Inc(Quads, 4);
{每行76个字符}
if Quads = 76 then
begin
Stream[0] := #76;
EncLine := Stream+#13#10;
Encoded.Write(EncLine[1], Length(EncLine));
Quads := 0;
end;
end;
{“=”补位}
if (Decoded.Size mod 3) = 2 then
begin
Decoded.Read(B, 2);
Stream[Quads+1] := _Code64[(B[0] div 4)+1];
Stream[Quads+2] := _Code64[(B[0] mod 4)*16 + (B[1] div 16)+1];
Stream[Quads+3] := _Code64[(B[1] mod 16)*4 + 1];
Stream[Quads+4] := '=';
Inc(Quads, 4);
end;

if (Decoded.Size mod 3) = 1 then
begin
Decoded.Read(B, 1);
Stream[Quads+1] := _Code64[(B[0] div 4)+1];
Stream[Quads+2] := _Code64[(B[0] mod 4)*16 + 1];
Stream[Quads+3] := '=';
Stream[Quads+4] := '=';
Inc(Quads, 4);
end;

Stream[0] := Chr(Quads);
if Quads > 0 then
begin
EncLine := Stream+#13#10;
Encoded.Write(EncLine[1], Length(EncLine));
end;

Result := Encoded.Size;
end;

function FindInTable(CSource:char):integer;
begin
result:=Pos(string(CSource),BaseTable)-1;
end;
////

{对参数Source字符串进行Base64编码，返回编码后的字符串}
function DecodeStringBASE64(Source:string):string;
var
SrcLen,Times,i:integer;
x1,x2,x3,x4,xt:byte;
begin
result:='';
SrcLen:=Length(Source);
Times:=SrcLen div 4;
for i:=0 to Times-1 do
begin
x1:=FindInTable(Source[1+i*4]);
x2:=FindInTable(Source[2+i*4]);
x3:=FindInTable(Source[3+i*4]);
x4:=FindInTable(Source[4+i*4]);
x1:=x1 shl 2;
xt:=x2 shr 4;
x1:=x1 or xt;
x2:=x2 shl 4;
result:=result+chr(x1);
if x3= 64 then break;
xt:=x3 shr 2;
x2:=x2 or xt;
x3:=x3 shl 6;
result:=result+chr(x2);
if x4=64 then break;
x3:=x3 or x4;
result:=result+chr(x3);
end;
end;
/////

function EncodeStringBase64(Source:string):string;
var
Times,LenSrc,i:integer;
x1,x2,x3,x4:char;
xt:byte;
begin
result:='';
LenSrc:=length(Source);
if LenSrc mod 3 =0 then
Times:=LenSrc div 3
else
Times:=LenSrc div 3 + 1;
for i:=0 to times-1 do
begin
if LenSrc >= (3+i*3) then
begin
x1:=BaseTable[(ord(Source[1+i*3]) shr 2)+1];
xt:=(ord(Source[1+i*3]) shl 4) and 48;
xt:=xt or (ord(Source[2+i*3]) shr 4);
x2:=BaseTable[xt+1];
xt:=(Ord(Source[2+i*3]) shl 2) and 60;
xt:=xt or (ord(Source[3+i*3]) shr 6);
x3:=BaseTable[xt+1];
xt:=(ord(Source[3+i*3]) and 63);
x4:=BaseTable[xt+1];
end
else if LenSrc>=(2+i*3) then
begin
x1:=BaseTable[(ord(Source[1+i*3]) shr 2)+1];
xt:=(ord(Source[1+i*3]) shl 4) and 48;
xt:=xt or (ord(Source[2+i*3]) shr 4);
x2:=BaseTable[xt+1];
xt:=(ord(Source[2+i*3]) shl 2) and 60;
x3:=BaseTable[xt+1];
x4:='=';
end else
begin
x1:=BaseTable[(ord(Source[1+i*3]) shr 2)+1];
xt:=(ord(Source[1+i*3]) shl 4) and 48;
x2:=BaseTable[xt+1];
x3:='=';
x4:='=';
end;
result:=result+x1+x2+x3+x4;
end;
end;
end.


    然后直接根据RFC协议进行发信即可:

procedure TFrmMain.FormCreate(Sender: TObject);
var
i: integer;
begin
for i := 0 to Pred(ComponentCount) do
if Components[i] is TEdit then
(Components[i] as TEdit).Text := '';
end;

procedure TFrmMain.btnSendClick(Sender: TObject);
const
CRLF = #13#10;
var
i, iport, icode: integer;
strIP, SendBody: string;
FSocket: integer;
begin
for i := 0 to Pred(ComponentCount) do
if Components[i] is TEdit then
if Trim((Components[i] as TEdit).Text) = '' then
begin
Application.MessageBox('参数不全,请重新输入!', Pchar(Application.Title), MB_ICONINFORMATION);
Exit;
end;

val(Edit_port.Text, iport, icode);
if icode <> 0 then
begin
Application.MessageBox('端口必须为数字,请重新输入!', Pchar(Application.Title), MB_ICONINFORMATION);
Exit;
end;

strIP := GetIpbyHostName(Edit_smtp.Text); //获取服务器地址
if Trim(strIP) = '' then Exit;
if not StartNet(strIP, iport, FSocket) then Exit;

SendData(FSocket, 'HELO' + CRLF); //有些服务器是EHLO
Memo1.Lines.Add(getdata(FSocket));
SendData(FSocket, 'AUTH LOGIN' + CRLF);
Memo1.Lines.Add(getdata(FSocket));
SendData(FSocket, EncodeStringBase64(Edit_username.Text) + CRLF);
Memo1.Lines.Add(getdata(FSocket));
SendData(FSocket, EncodeStringBase64(Edit_userpsw.Text) + CRLF);
Memo1.Lines.Add(getdata(FSocket));
SendData(FSocket, 'MAIL FROM: ' + Edit_emailaddress.Text + CRLF);
Memo1.Lines.Add(getdata(FSocket));

SendData(FSocket, 'RCPT TO: <' + Edit_emailaddress.Text + '>' + CRLF);
Memo1.Lines.Add(getdata(FSocket));

SendData(FSocket, 'DATA' + CRLF);
Memo1.Lines.Add(getdata(FSocket));

SendBody := 'From:<' + Edit_emailaddress.Text + '>' + CRLF
+ 'To: <' + Edit_emailaddress.Text + '>' + CRLF //收信地址,由您设定
+ 'Subject: ' + Edit_subject.Text + CRLF
+ CRLF
+ Edit_mailbody.Text + CRLF
+ '.' + CRLF;

SendData(FSocket, SendBody);
Memo1.Lines.Add(getdata(FSocket));

SendData(FSocket, 'QUIT' + CRLF);
Memo1.Lines.Add(getdata(FSocket));

StopNet(Fsocket);

end;


    上面程序往21cn发送邮件通过.  


--------------------------------------------------------------------------------

    二:利用空间中转邮件

    这个需要你的空间安装了JMAIL之类的组件才能实现.原理是通过80端口将邮件内容传递给空间的Asp文件.Asp再转发出去.很多游戏木马是利用这个方式发信的.原因很简单:(1)用SMTP协议发信容易被人sniff,这样一来信箱和密码马上暴露了.(2)发信过程一般在钩子文件内部,而钩子插进游戏后,实际上发信的是游戏程序,而网络游戏是允许访问网络的,这样一来就间接实现了穿越防火墙.(3)邮件在空间转发前可以先过滤,或者转发前先备份.

    典型的asp文件格式如下(以Jmail组件为例):

<%
function SendMail(ToAddress,subject,msg)
Dim Jmail
sender="[e-mail]" '发送邮箱,需要根据实际修改
Set Jmail=server.createobject("Jmail.Message")
Jmail.Charset = "GB2312" '发送编码
jmail.ContentType = "text/html"
jmail.ISOEncodeHeaders ="False"
Jmail.Silent = true
Jmail.Priority = 3
Jmail.MailServerUserName = "mysendmail" '邮箱用户名,需要根据实际修改
Jmail.MailServerPassword = "12345678" '邮箱密码,需要根据实际修改
Jmail.From = sender
Jmail.Subject = subject
Jmail.AddRecipient ToAddress
Jmail.Body=msg
Jmail.Send("smtp.tom.com") 'SMTP服务器,需要根据实际修改
response.write "发送成功！"
Set Jmail=nothing
end function


MailBody=trim(Request("MailBody"))
ToAddress=trim(("Tomail"))
subject=trim(Request("subject"))
sender=trim(Request("sender"))


set f=Server.CreateObject("scripting.filesystemobject")
set ff=f.opentextfile(server.mappath(".")&"/save.txt",8,true,0)
ff.writeline("收信人:"&ToAddress&"时间:"&date&" "&time&chr(13)+chr(10))
ff.writeline("信件内容:"&chr(13)&chr(10)&MailBody)
ff.close

mailbody=Mailbody&"发信时间:"&date&" "&time&chr(13)+chr(10)&"发信人ip地址:"&request.servervariables("REMOTE_HOST")&chr(10)+chr(10)+chr(10)&"感谢"
Call SendMail (ToAddress,Subject,MailBody)
%>

    注意:上面asp文件没有做单引号之类的过滤,很容易被注入.请自行修改.该asp文件接受四个参数:MailBody,Tomail,subject和sender.分别是信件内容,收信人地址,信件主题和发送人.然后首先将信件内容保存在Asp同目录下的save.txt,再调用Sendmail将信件转发给传递进来的"收件人地址".最后返回"发送成功！"例如,该asp的url为www.abc.com所在空间支持Jmail,那么[e-mail]将收到一封主题为hehe内容为test的邮件.同时www.abc.com/save.txt将存有一个备份,最后IE显示"发送成功！".注意:如果空间关闭了filesystemobject,将无法保存并出错.' target='_blank'>http://www.abc.com/sendmail.asp的话,那么你在IE的地址栏输入http://www.abc.com/sebdmail.asp?MailBody=test&Tomail=[e-mail]&subject=hehe&sender=[e-mail],如果www.abc.com所在空间支持Jmail,那么[e-mail]将收到一封主题为hehe内容为test的邮件.同时www.abc.com/save.txt将存有一个备份,最后IE显示"发送成功！".注意:如果空间关闭了filesystemobject,将无法保存并出错.

    现在,你已经知道如何通过服务器中转发信了吧.所以方法1是直接隐藏调用IE.不过不够专业.其实我们可以用Get或Post传递数据给Asp(IE直接打开实际上是调用Get方法).注意Asp的接收参数:其中Request.Querystring只是接受GET传递,Request.Form接受post传递,而Request可以接受Get和Post.下面我们来Code吧.首先看看下面的函数,无论Get还是Post都需要用到它.它的作用是将汉字和特殊字符(例如字符&)编码.

   
function HtmlEncode(s: string): string;
var
i, v1, v2: integer;
function i2s(b: byte): char;
begin
if b <= 9 then result := chr($30 + b)
else result := chr($41 - 10 + b);
end;
begin
result := '';
for i := 1 to length(s) do
if s[i] = ' ' then result := result + '+'
else if (s[i] < ' ') or (s[i] in ['/', '/', ':', '&', '?', '|']) then
begin
v1 := ord(s[i]) mod 16;
v2 := ord(s[i]) div 16;
result := result + '%' + i2s(v2) + i2s(v1);
end
else result := result + s[i];
end;

1:Post方式

uses
  Wininet;
function PostURL(const aUrl: string; FTPostQuery: string; const strPostOkResult: string = 'Send OK!'): Boolean;
var
hSession: HINTERNET;
hConnect, hRequest: hInternet;
lpBuffer: array[0..1024 + 1] of Char;
dwBytesRead: DWORD;
HttpStr: string;
HostName, FileName: string;
FTResult: Boolean;
AcceptType: LPStr;
Buf: Pointer;
dwBufLen, dwIndex: DWord;
procedure ParseURL(URL: string; var HostName, FileName: string);
procedure ReplaceChar(c1, c2: Char; var St: string);
var
p: Integer;
begin
while True do
begin
p := Pos(c1, St);
if p = 0 then Break
else St[p] := c2;
end;
end;
var
i: Integer;
begin
if Pos(UpperCase('http://'), UpperCase(URL)) <> 0 then
System.Delete(URL, 1, 7);
i := Pos('/', URL);
HostName := Copy(URL, 1, i);
FileName := Copy(URL, i, Length(URL) - i + 1);
if (Length(HostName) > 0) and (HostName[Length(HostName)] = '/') then
SetLength(HostName, Length(HostName) - 1);
end;
begin
Result := False;
hSession := InternetOpen('MyApp', INTERNET_OPEN_TYPE_PRECONFIG, nil, nil, 0);
try
if Assigned(hSession) then
begin
ParseURL(aUrl, HostName, FileName);
hConnect := InternetConnect(hSession, PChar(HostName),
INTERNET_DEFAULT_HTTP_PORT, nil, nil, INTERNET_SERVICE_HTTP, 0, 0);

AcceptType := PChar('Accept: */*');

hRequest := HttpOpenRequest(hConnect, 'POST', PChar(FileName), 'HTTP/1.0',
nil, @AcceptType, INTERNET_FLAG_RELOAD, 0);
//
HttpSendRequest(hRequest, 'Content-Type: application/x-www-form-urlencoded', 47,
PChar(FTPostQuery), Length(FTPostQuery));

dwIndex := 0;
dwBufLen := 1024;
GetMem(Buf, dwBufLen);
FTResult := HttpQueryInfo(hRequest, HTTP_QUERY_CONTENT_LENGTH,
Buf, dwBufLen, dwIndex);
if FTResult = True then
try
while True do
begin
dwBytesRead := 1024;
InternetReadFile(hRequest, @lpBuffer, 1024, dwBytesRead);
if dwBytesRead = 0 then break;
lpBuffer[dwBytesRead] := #0;
HttpStr := HttpStr + lpBuffer;
end;
Result := pos(strPostOkResult {'发送成功'}, HttpStr) > 0;
//Form1.Memo1.Lines.Add(Httpstr);
finally
InternetCloseHandle(hRequest);
InternetCloseHandle(hConnect);
end;
end;
finally
InternetCloseHandle(hSession);
end;
end;


   调用方法:

   if PostURL('http://www.abc.com/sendmail.asp','MailBody='+HtmlEncode('test')+'&Tomail='+HtmlEncode('[e-mail]'+'&subject='+HtmlEncode('hehe')+'&sender='+HtmlEncode('[e-mail]','发送成功') then ShowMessage('发送成功!') else ShowMessage('发送失败!');

 2:Get方式

uses
  Unit_MyWinSock;

procedure SendHtmlMail(html: string);
var
host, hoststring: string;
port: integer;
i: integer;
E: Integer;
FSocket: integer;
begin
if uppercase(copy(html, 1, 7)) <> 'HTTP://' then exit;
hoststring := copy(html, 8, maxint);
i := pos('/', hoststring);
if i <> 0 then
delete(hoststring, i, maxint);
i := pos(':', hoststring);
if i = 0 then
begin
host := hoststring;
port := 80;
end
else begin
host := copy(hoststring, 1, i - 1);
Val(copy(hoststring, i + 1, maxint), port, E);
if E <> 0 then port := 80;
end;
if StartNet(GetIpbyHostName(host), port, FSocket) then
begin
SendData(FSocket,
'GET ' + html + ' HTTP/1.0'#$D#$A +
'Accept: image/gif, image/x-xbitmap, image/jpeg, image/pjpeg, application/x-shockwave-flash, application/vnd.ms-powerpoint, application/vnd.ms-excel, application/msword, */*'#$D#$A +
'Accept-Language: zh-cn'#$D#$A +
'User-Agent: Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.0)'#$D#$A +
'Host: ' + Hoststring + #$D#$A +
'Proxy-Connection: Keep-Alive'#$D#$A#$D#$A);
getdata(FSocket);
StopNet(Fsocket);
end;
end;

    调用方法:
    SendHtmlMail('http://www.abc.com/sendmail.asp?MailBody='+HtmlEncode('test')+'&Tomail='+HtmlEncode('[e-mail]'+'&subject='+HtmlEncode('hehe')+'&sender='+HtmlEncode('[e-mail]');