谈用Delphi设计Email程序(二)

陈经韬

三:利用ISAPI转发邮件

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

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

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

打开Delphi,New-->Web Server Application-->ISAPI/NSAPI Dynamic Link Library,并将工程保存为IsapiMail.dpr.为了发送邮件,我们为单元添加引用IdSMTP和IdMessage,并写了个简单的发送函数:

function TWebModule1.My_SendMail(const StrSMTP, StrUser, StrPSW, StrMailFrom,
StrMailTo, StrMailSubject, StrMailBody: String): Boolean;
var
MyIdSMTP: TIdSMTP;
MyIdMessage: TIdMessage;
begin
Result:=False;
try
MyIdSMTP:=TIdSMTP.Create(nil);
MyIdMessage:=TIdMessage.Create(nil);
except
Exit;
end;
if MyIdSMTP.Connected then MyIdSMTP.Disconnect;
MyIdSMTP.Host:=StrSmtp;
MyIdSMTP.Username:=StrUser;
MyIdSMTP.Password:=StrPSW;
MyIdSMTP.AuthenticationType:=atLogin;

MyIdMessage.Body.Clear;
MyIdMessage.Body.Text:=StrMailBody;
MyIdMessage.From.Text:=StrMailFrom;
MyIdMessage.Recipients.EMailAddresses:=StrMailTo;
MyIdMessage.Subject:=StrMailSubject;
MyIdMessage.ReceiptRecipient.Text := '';
try
MyIdSMTP.Connect;
except
Exit;
end;
try
try
MyIdSMTP.Send(MyIdMessage);
finally
MyIdSMTP.Disconnect;
end;
except
Exit;
end;
MyIdSMTP.Free;
MyIdMessage.Free;
Result:=True;
end;

回到主窗口,双击WebModule1,出现Editing WebModule1.Actions,新建一个小节WebActionItem1,将其PathInfo改为/SendMail,然后在其OnAction事件写代码:

procedure TWebModule1.WebModule1WebActionItem1Action(Sender: TObject;
Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
var
StrSMTP,StrUser,StrPSW,StrMailFrom,StrMailTo,StrMailSubject,StrMailBody: String;
begin
//依次取的传递进来的参数
StrSMTP:=Request.QueryFields.Values['StrSMTP'];
StrUser:=Request.QueryFields.Values['StrUser'];
StrPSW:=Request.QueryFields.Values['StrPSW'];
StrMailFrom:=Request.QueryFields.Values['StrMailFrom'];
StrMailTo:=Request.QueryFields.Values['StrMailTo'];
StrMailSubject:=Request.QueryFields.Values['StrMailSubject'];
StrMailBody:=Request.QueryFields.Values['StrMailBody'];
//调用发送过程
if My_SendMail(StrSMTP,StrUser,StrPSW,StrMailFrom,StrMailTo,StrMailSubject,StrMailBody) then
begin
Response.Content := '<Html><Head><Title>邮件发送反馈</Title></Head>邮件发送成功!';
Response.Content :=Response.Content +'</Html>';
end
else
begin
Response.Content := '<Html><Head><Title>邮件发送反馈</Title></Head>邮件发送失败!';
Response.Content :=Response.Content +'</Html>';
end;
end;

编译这个工程得到IsapiMail.dll,然后我们已经可以调用这个dll来发送邮件了.假设该文件的网络路径为http://www.138soft.com/test/IsapiMail.dll(注意:test目录必须有可执行权限),那么我们主要在IE地址栏输入

http://www.138soft.com/test/IsapiMail.dll?StrSMTP=smtp.21cn.com&StrUser=test&StrPSW=1234&StrMailFrom=test@21cn.com&StrMailTo=someone@21cn.com&StrMailSubject=邮件主题&StrMailBody=邮件内容

然后回车,那么页面将返回发送结果.

    回到程序设计IDE.可能各位已经注意到WebActionItem1还有几个属性.它们的意义如下:
    Default:是否为默认小节.
    Enable:设置为False将不公开接口.
    MethodType:接收何种方式传递进来的数据.
    Producer和ProducerContent用于涉及模板时才会用到.

我们再新建一个小节WebActionItem2,将其Default设置为True.然后新建一个包含一jpg图片的资源文件(详见<<谈Delphi中资源文件的利用>>一文).在其事件中写如下代码:

procedure TWebModule1.WebModule1WebActionItem2Action(Sender: TObject;
Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
var
MyRes:TResourceStream;
begin
{$R jpg.RES}
MyRes:=TResourceStream.Create(HInstance,'jpg','jpgfile');
//出于效率考虑,可以放在窗口创建时创建资源.这里暂时每次创建.
try
Response.SendStream(MyRes);
finally
MyRes.Free;
end;
end;

然后我们直接在IE输入http://www.138soft.com/test/IsapiMail.dll,将返回一jpeg图片.

    补充:
    1:实际上,可以先定义好模版,然后把整个站点封装成为一个dll文件.例如http://www.51delphi.com就是一个范例.
    2:为了方便调试ISAPI程序,可以在本机安装一个IIS.不过需要注意的是,ISAPI第一次调用后将常驻内存,在下次重启前该dll文件都无法删除的.这种情况下可以通过暂停IIS再启动来解决.或者直接在cmd状态下IISReset重启IIS.如果还是觉得不方便,那么可以使用Dr.Bob写的ISAPI Debugger(http://www.drbob42.com/tools/intrabob.htm),不过可惜的是它不支持get方式的调试.

四:自己撰写组件实现email邮件的发送.

我们在第一节已经给出了一个调用Jmail的例子.实际上,我们也可以自己写一个类似的组件.

打开Delphi,选择File--->New--->Other--->Activex--->ActiveX Library 建立一个ActiveX库.保存为MyJMailCom.dpr,然后再File--->New--->Other--->Activex--->Active Server Object,填写类名称,这里我们填写MyJMail..

菜单View--->Type Library,选中IMyJMail,右键New--->Property.将出现两个Property1,其中一个的Invoke Kind为Property Get,另外一个为Property Put.删除那个Get的,然后把Property1改成SmtpServer,Type改成VARIANT.用同样方法添加SmtpPort(类型为int),NeedValidate(类型为long),UserName(类型为VARIANT),UserPassword(类型为VARIANT),MailFrom(类型为VARIANT),MailTo(类型为VARIANT),Subject(类型为VARIANT),Priority(类型为int),ContentType(类型为VARIANT),Charset(类型为VARIANT),Body(类型为VARIANT),ReplyTo(类型为VARIANT),再添加一个类型为long的变量ResultOK,不过这次是删除Put留下Get.最后新添加一个过程SendEmail.

然后回到单元,我们为工程添加几个私有变量,

private
strSmtpServer:string;
intSmtpPort:integer;
intPriority:integer;
bNeedValidate,ResultOK:Boolean;
strCharset,strContentType:string;
strUserName,strUserPassword:string;
strMailFrom,strMailTo:string;
strSubject,strMsgBody:string;

在COM创建被调入的时候初始化变量:

procedure TMyJMail.OnStartPage(const AScriptingContext: IUnknown);
begin
inherited OnStartPage(AScriptingContext);
strSmtpServer:='';
intSmtpPort:=25;
intPriority:=3;{mpLowest,mpLow,mpNormal,mpHighest,mpHigh}
bNeedValidate:=True;
strCharset:='';
strContentType:='';
strUserName:='';strUserPassword:='';
strMailFrom:='';strMailTo:='';strSubject:='';strMsgBody:='';
ResultOK:=False;
end;

并填写各属性代码:

procedure TMyJMail.Set_NeedValidate(Value: Integer);
begin
bNeedValidate := Boolean(Value);
end;

procedure TMyJMail.Set_SmtpPort(Value: SYSINT);
begin
intSmtpPort := Value;
end;

procedure TMyJMail.Set_SmtpServer(Value: OleVariant);
begin
strSmtpServer := Value;
end;

procedure TMyJMail.Set_UserName(Value: OleVariant);
begin
strUserName := Value;
end;

procedure TMyJMail.Set_UserPassword(Value: OleVariant);
begin
strUserPassword := Value;
end;

function TMyJMail.Get_ResultOK: Integer;
begin
Result := Integer(ResultOK);
end;

procedure TMyJMail.Set_Body(Value: OleVariant);
begin
strMsgBody := Value;
end;

procedure TMyJMail.Set_Charset(Value: OleVariant);
begin
strCharset := Value;
end;

procedure TMyJMail.Set_ContentType(Value: OleVariant);
begin
strContentType := Value;
end;

procedure TMyJMail.Set_MailFrom(Value: OleVariant);
begin
strMailFrom := Value;
end;

procedure TMyJMail.Set_MailTo(Value: OleVariant);
begin
strMailTo := Value;
end;

procedure TMyJMail.Set_Priority(Value: SYSINT);
begin
intPriority := Value;
end;

procedure TMyJMail.Set_Subject(Value: OleVariant);
begin
strSubject := Value;
end;

procedure TMyJMail.SendEmail;
var
MyIdSMTP: TIdSMTP;
MyIdMessage: TIdMessage;
begin
try
MyIdSMTP := TIdSMTP.Create(nil);
MyIdMessage := TIdMessage.Create(nil);
except
Exit;
end;

MyIdSMTP.Host := strSmtpServer;
MyIdSMTP.Port := intSmtpPort;
if bNeedValidate then MyIdSMTP.AuthenticationType := atLogin
else MyIdSMTP.AuthenticationType := atNone;
MyIdSMTP.Username := strUserName;
MyIdSMTP.Password := strUserPassword;

MyIdMessage.CharSet := strCharset;
MyIdMessage.ContentType := strContentType;
case intPriority of
1: MyIdMessage.Priority := mpLowest;
2: MyIdMessage.Priority := mpLow;
3: MyIdMessage.Priority := mpNormal;
4: MyIdMessage.Priority := mpHigh;
5: MyIdMessage.Priority := mpHighest;
else
MyIdMessage.Priority := mpNormal;
end;
MyIdMessage.From.Text := strMailFrom;
MyIdMessage.Recipients.EMailAddresses := StrMailTo;
MyIdMessage.ReceiptRecipient.Text := '';
MyIdMessage.Subject := strSubject;
MyIdMessage.Body.Clear;
MyIdMessage.Body.Text := strMsgBody;

try
MyIdSMTP.Connect;
except
Exit;
end;

try
MyIdSMTP.Send(MyIdMessage);
except
MyIdSMTP.Disconnect;
MyIdSMTP.Free;
MyIdMessage.Free;
Exit;
end;

ResultOK := True;
end;

编译此工程,得到MyJMailCom.dll,这个就是我们的COM组件了.在使用之前,必须先注册.直接Regsvr32.exe MyJMailCom.dll即可提示注册成功.(反注册为Regsvr32.exe/u MyJMailCom.dll).我们写一个Asp来测试一下:

<HTML>
<BODY>
<TITLE> 邮件发送组件 </TITLE>
<CENTER>
<H3> 邮件发送组件 </H3>
</CENTER>
<HR>
<%
Dim MyEmai
Set MyEmai = Server.CreateObject("MyJMailCom.MyJMail")
MyEmai.SmtpServer="smtp.21cn.com" 'SMTP服务器名称,必须
MyEmai.SmtpPort=25 'SMTP服务器端口.默认为25,可不填
MyEmai.MailFrom="test@21cn.com" '发件人地址,必须
MyEmai.MailTo="someone@21cn.com" '收件人地址,必须
MyEmai.NeedValidate=True 'SMTP服务器是否需要验证用户名称密码.默认为True,可不填
MyEmai.UserName="test" '用户名称,如果需要验证则必须
MyEmai.UserPassword="123456" '用户密码,如果需要验证则必须
MyEmai.Subject="test" '邮件主题
MyEmai.Charset="GB2312" '发送编码.可不填
MyEmai.ContentType ="text" '可不填.若要为htm格式,修改为:XsdEmai.ContentType = "text/html"
MyEmai.Priority=3 '是否为紧急邮件(可不填,默认为3).其中1---5分别代表mpLowest,mpLow,mpNormal,mpHighest,mpHigh
MyEmai.SendEmail '调用发送过程
if MyEmai.ResultOK then
response.write"邮件发送成功!"
else
response.write"邮件发送失败!"
end if
%>
<HR>
</BODY>
</HTML>

    补充:
    1:用程序注册COM组件的方法如下:
type
TOleRegister = function : HResult;
var
hLib : THandle;
fnAdr: TFarProc;
begin
hLib := LoadLibrary(PCHAR(strFileName));
if (hLib > 0) then
begin
try
fnAdr := GetProcAddress(hLib, pchar('DllRegisterServer'))
//反注册用fnAdr := GetProcAddress(hLib, pchar('DllUnregisterServer'));
if (fnAdr <> nil) then
Result := (TOleRegister(fnAdr) >= 0);
finally
FreeLibrary(hLib);
end;
    2: 有些COM组件,例如IIS管理组件,因为权限问题,必须先把实现功能部分写成服务(详见<<用Delphi创建服务程序>>).然后再从组件间接调用它.(是否有点象Seru_V?呵呵).

五:其它发送邮件的方法

除了上面的发送方法,还有利用NT服务直接发送特急邮件,MMX发信等.因为有可能导致垃圾邮件发送器的泛滥,此处不再列举.