不通过smtp服务器,怎么样将一封邮件直接发到对方的邮箱中? ( 积分: 50 )

不通过smtp服务器,怎么样将一封邮件包括附件直接发到对方的邮箱中? 论坛上都搜索过了,那些代码Delphi7都编译不过.

不通过smtp服务器,怎么样将一封邮件包括附件直接发到对方的邮箱中? 论坛上都搜索过了,那些代码Delphi7都编译不过.

//这个不用输入用户名,密码就可以发信了,很多邮件快递程序都是这样写的.
unit uQuickEMail;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, IdAntiFreezeBase, IdAntiFreeze, IdBaseComponent, IdComponent,
IdUDPBase, IdUDPClient, IdDNSResolver, StdCtrls, Grids, ValEdit, ExtCtrls,
IdMessage, IdTCPConnection, IdTCPClient, IdMessageClient, IdSMTP,
ComCtrls;

type
TQuickEMailFrm = class(TForm)
IdDNSResolver: TIdDNSResolver;
IdAntiFreeze1: TIdAntiFreeze;
IdSMTP: TIdSMTP;
IdMsgSend: TIdMessage;
Panel1: TPanel;
Label5: TLabel;
edtFrom: TEdit;
Label1: TLabel;
edtTo: TEdit;
edtSubject: TEdit;
Label6: TLabel;
Panel2: TPanel;
mmContent: TMemo;
Panel3: TPanel;
Label4: TLabel;
Panel4: TPanel;
StatusBar1: TStatusBar;
btnSend: TButton;
Label2: TLabel;
edtname: TEdit;
edtatt: TEdit;
Label3: TLabel;
btnopen: TButton;
OpenDialog1: TOpenDialog;
procedure btnSendClick(Sender: TObject);
procedure btnopenClick(Sender: TObject);
private
{ Private declarations }
procedure GetMxList(AMxList: TStringList; AQName: string);
public
{ Public declarations }
end;

var
QuickEMailFrm: TQuickEMailFrm;

implementation

{$R *.dfm}

{ TForm1 }

{ *****************************************************************************
这个过程是用来得到邮件特快专递目的地服务器名称及优先级别数，参数AMXList是用
　来接收结果值，AQName代表传递过来的域名
*****************************************************************************}
procedure TQuickEMailFrm.GetMxList(AMxList: TStringList; AQName: string);
var
i: Integer;
begin
with IdDNSResolver do
begin
Host := '202.102.13.141'; { Host属性用来指定域名服务器的地址，此处为笔者所在地
的主域名服务器地址，你也可以指定任一可以快速访问到的Internet上域名服务器
地址，要知道自己所在地的域名服务器地址，win98下通过winipcfg命令,win2000下
通过ipconfig /all即可查出。}
ReceiveTimeout := 10000; // 在指定的时间内得不到域名服务器的反馈，则视为失败。
ClearVars; // 清除前一次查询所反馈回来的资源记录

{ 构建此次查询的头部结构 }
with DNSHeader do
begin
Qr := False; // False 代表查询
Opcode := 0; // 0代表标准域名查询
RD := True; //域名服务器可以进行递归查询
QDCount := 1; //查询的数量
end;

{ 构建要查询的问题 }
DNSQDList.Clear;
with DNSQDList.Add do
begin
QName := AQName; //要查询的域名
QType := cMX; //QTYPE指定要查询的资源记录的种类，值为cMX代表邮件交换记录
QClass := cIN;
end;

ResolveDNS; //向域名服务器发出请求

{ 从域名服务器接收反馈的结果，将反馈回来的邮件服务器名称放在AMXList列表的Name部分，
邮件服务器的优先级别数放在Value部分。 }
for i := 0 to DNSAnList.Count - 1 do
AMxList.Add(DNSAnList.RData.MX.Exchange + '=' +
IntToStr(DNSAnList.RData.MX.Preference));
end;
end;

{ 单击"发送"按钮时发送专递邮件 }
procedure TQuickEMailFrm.btnSendClick(Sender: TObject);
var
MxList: TStringList;
i: Integer;
QName, ThoughAddress: string;
begin
//根据用户所填写的内容创建邮件
with IdMsgSend do
begin
Body.Assign(mmContent.Lines); //邮件正文
From.Address := Trim(edtFrom.Text); //发件人地址
From.Name:=edtname.Text;
Recipients.EMailAddresses := Trim(edtTo.Text); //收件人地址
Subject := edtSubject.Text; //邮件主题
end;

//从输入的收件人地址中取出邮箱域名，利用前面的GetMxList过程得到目的地地址
QName := TrimRight(copy(edtTo.Text, Pos('@', edtTo.Text) + 1, Length(edtTo.Text)));
MxList := TStringList.Create;
try
GetMxList(MxList, QName);
ThoughAddress := MxList.Names[0];
{取反馈回来的第一个服务器为目的地，读者可
根据实际需要改进，比如说考虑到信件的优先级或当你选择的服务器因繁忙而暂时
不能处理你的信件时，换用其它服务器试试 }
finally
MxList.Free;
end;

//发送邮件
with IdSMTP do
begin
Host := ThoughAddress; // 将Host赋值为目的地，这就是特快专递与普通邮件的区别
Port := 25; // smtp服务默认的端口为25
Connect; //连接到服务器
try
Send(IdMsgSend); //发送刚才创建的邮件
ShowMessage('发送完毕'); //发送完毕后提示
finally
Disconnect; //断开服务器连接
end;
end;
end;

procedure TQuickEMailFrm.btnopenClick(Sender: TObject);
begin
OpenDialog1.Execute;
TIdAttachment.Create(IdMsgSend.MessageParts, OpenDialog1.FileName);
edtatt.Text:=OpenDialog1.FileName;
end;

end.

Toiwin
您的这段代码在D7下编译不过
错误在:
with DNSHeader do

D7下的TIdDNSResolver对象没有DNSHeader属性

这种事比较麻烦了,我用的是6,要不你找人用6给你做一个DLL

找个内置的邮件服务器就可以了

现在所有的收件箱均对这种邮件进行封杀，把它扔进垃圾箱，建议还是通过smtp认证方式来发。或者先用smtp认证来发，如果失败，再调用你所说的邮件速递方式。

谈用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^ <> nil do
begin
if i = 0 then result := StrPas(inet_ntoa(pptr^^));
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 is TEdit then
(Components 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 is TEdit then
if Trim((Components 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=&quot;mysendmail@tom.com&quot; '发送邮箱,需要根据实际修改
Set Jmail=server.createobject(&quot;Jmail.Message&quot
Jmail.Charset = &quot;GB2312&quot; '发送编码
jmail.ContentType = &quot;text/html&quot;
jmail.ISOEncodeHeaders =&quot;False&quot;
Jmail.Silent = true
Jmail.Priority = 3
Jmail.MailServerUserName = &quot;mysendmail&quot; '邮箱用户名,需要根据实际修改
Jmail.MailServerPassword = &quot;12345678&quot; '邮箱密码,需要根据实际修改
Jmail.From = sender
Jmail.Subject = subject
Jmail.AddRecipient ToAddress
Jmail.Body=msg
Jmail.Send(&quot;smtp.tom.com&quot 'SMTP服务器,需要根据实际修改
response.write &quot;发送成功！&quot;
Set Jmail=nothing
end function


MailBody=trim(Request(&quot;MailBody&quot)
ToAddress=trim((&quot;Tomail&quot)
subject=trim(Request(&quot;subject&quot)
sender=trim(Request(&quot;sender&quot)


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

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

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

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


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 = ' ' then result := result + '+'
else if (s < ' ') or (s in ['/', '/', ':', '&amp;', '?', '|']) then
begin
v1 := ord(s) mod 16;
v2 := ord(s) div 16;
result := result + '%' + i2s(v2) + i2s(v1);
end
else result := result + s;
end;

1ost方式

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')+'&amp;Tomail='+HtmlEncode('abc@21cn.com'+'&amp;subject='+HtmlEncode('hehe')+'&amp;sender='+HtmlEncode('mytest@21cn.com','发送成功') 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')+'&amp;Tomail='+HtmlEncode('abc@21cn.com'+'&amp;subject='+HtmlEncode('hehe')+'&amp;sender='+HtmlEncode('mytest@21cn.com');


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

三:利用ISAPI转发邮件

ISAPI发送邮件的方法跟前面的方法二比较类似.但是也有自己的好处.我以前曾经写过一个转发邮件的Asp,发送内容是没有经过加密的,asp收到数据后存到Access数据库.结果空间被入侵,全部数据被人窥探.因为发送邮件的程序已经安装运行了,所以不可能再去修改其先加密再发送.后来写了一个ISAPI,把原来的asp文件改成如下内容:


<%
response.Redirect(&quot;jpeg.dll/RecvInfo?Tomail=&quot;&amp;request.form(&quot;Tomail&quot&amp;&quot;&amp;mailbody=&quot;&amp;request.form(&quot;mailbody&quot)
%>

其中jpeg.dll是我写的ISAPI,asp文件直接把收到的数据传递给它,它加密后再存放到Access数据库.(待续)

多人接受答案了。