在Delphi中用Outlook2000发送邮件 Outlook 2000不仅是一个功能强大的电子邮件软件,而且还是一个自动化服务器(Automation servers)。第三方的软件开发人员根据需要可以对Outlook进行定制和扩充,同时开发者还可以通过编写Outlook自动化服务器的客户方程序来有效利用它的电子邮件功能。本文将介绍在Delphi程序中如何利用Outlook自动化服务器的强大的电子邮件功能,调用Outlook来发送email。 一、 步骤 1. 创建Application应用程序对象 为了使用Outlook的服务,首先我们需要创建一个Outlook的Application自动化对象。使用CreateOleObject函数我们可以创建一个自动化对象,此函数的原型为:function CreateOleObject(const ClassName: string): IDispatch;使用CreateOleObject函数创建Outlook应用程序实例的代码如下: var Outlook: Variant; ... Outlook:= CreateOleObject (‘Outlook.Application'); 2. 创建MailItem对象 在Outlook中,一个MailItem代表一个邮件对象。Outlook的CreateItem方法可以创建一个MailItem对象: Var Outlook: Variant;Mail: Variant; ... Outlook := CreateOLEObject (‘Outlook.Application'); //创建一个MailItem对象 Mail:=Outlook.CreateItem(olMailItem); MailItem对象之下还包含有子对象以及方法,其中比较重要的有如下一些: 1 Recipients属性 用于指定邮件的接收人,我们可以指定3类收信人,To、CC(抄送)以及BCC(暗送)。 Var Recipient: Variant; ... Outlook := CreateOLEObject (‘Outlook.Application'); //创建一个MailItem对象 Mail:=Outlook.CreateItem(olMailItem); //添加类型为To的收件人 Recipient:=Mail.Recipients.Add(‘daisy@mhliu.dhs.org'); Recipient.Type:=olTo; //添加类型为CC(抄送)的收件人 Recipient:=Mail.Recipients.Add(‘simon@xyz.com'); Recipient.Type:=olCc; //添加类型为BCC(暗送)的收件人 Recipient:=Mail.Recipients.Add(‘ mailback@mhliu.dhs.org'); Recipient.Type:=olCc; 2Subject属性:邮件的标题。 Body属性:邮件的正文内容。 Attachments属性:邮件的全部附件。 增加附件: Mail.Attachments.Add(‘D:\Simon\Unit1.pas'); 删除附件: if Mail.Attachments.Count>0 then Mail.Attachments.Remove(1); {如果附件的数目不为0,则去掉第1个附件} Send方法:发送邮件。 二、 示例程序 下面是一个Outlook自动化服务器的客户程序的代码,你可以参考vbaoutl9.chm文档并对此程序进行改进和扩充。 unit Unit1; interface uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, ExtCtrls, ShellAPI, ComObj, ActiveX, ComCtrls; type TForm1 = class(TForm) Memo1: TMemo; Label1: TLabel; Label2: TLabel; Label3: TLabel; Label4: TLabel; Edit_To: TEdit; Edit_CC: TEdit; Edit_BCC: TEdit; Edit_Subject: TEdit; ListView1: TListView; Button1: TButton; Button2: TButton; Button3: TButton; OpenDialog1: TOpenDialog; procedure FormResize(Sender: TObject); procedure FormCreate(Sender: TObject); procedure Button1Click(Sender: TObject); procedure Button2Click(Sender: TObject); procedure Button3Click(Sender: TObject); end; const {Microsoft Outlook 常量} //OlItemType 常量(用于CreateItem方法) olMailItem=0; //邮件接收者类型(默认类型为"To") olTo=1; olCC=2; olBCC=3; var Form1: TForm1; ImageList:TImageList; TheIcon:TIcon; implementation {$R *.DFM} procedure TForm1.FormCreate(Sender: TObject); begin TheIcon:=TIcon.Create; ImageList:=TImageList.CreateSize(32,32); ListView1.LargeImages:=ImageList; ListView1.Visible:=False; end; //创建Outlook Automation对象,并发送邮件 procedure TForm1.Button1Click(Sender: TObject); var i:integer; Outlook: Variant; Mail: Variant; Recipient:Variant; begin //收件人是否为空 if Trim(Edit_To.Text)=‘' then exit; //创建Outlook.Application 自动化对象 Outlook := CreateOLEObject (‘Outlook.Application'); if VarIsEmpty(Outlook) then begin MessageBox(handle,‘Outlook自动化对象创建失败!',nil,0); Exit; end; //创建一个MailItem对象 Mail:=Outlook.CreateItem(olMailItem); // Mail.Display; //填写 收件人 Mail.Recipients.Add(Trim(Edit_To.Text)); //下面的代码将 Recipient 对象的类型从默认的("To")更改为"CC"。 if Trim(Edit_CC.Text)<>‘' then begin Recipient:=Mail.Recipients.Add(Edit_CC.Text); Recipient.Type:= olCC; end; //下面的代码将 Recipient 对象的类型从默认的("To")更改为"BCC"。 if Trim(Edit_BCC.Text)<>‘' then begin Recipient:=Mail.Recipients.Add(Edit_BCC.Text); Recipient.Type:=olBCC; end; //填写邮件主题 Mail.Subject:= Edit_Subject.Text; //填写邮件正文 Mail.Body:=Memo1.Text; //增添附件 for i:=0 to ListView1.Items.Count-1 do Mail.Attachments.Add(ListView1.Items[i].SubItems[0]); //发送邮件 Mail.Send; //释放Microsoft Outlook自动化对象 Outlook:=Unassigned; end; procedure TForm1.FormResize(Sender: TObject); begin Edit_TO.Width:=ClientWidth-Edit_TO.Left-2; Edit_CC.Width:=ClientWidth-Edit_CC.Left-2; Edit_BCC.Width:=ClientWidth-Edit_BCC.Left-2; Edit_Subject.Width:=ClientWidth-Edit_Subject.Left-2; Memo1.Top:=Edit_Subject.Top+Edit_Subject.Height+2; Memo1.Width:=ClientWidth; Button1.Top:=ClientHeight-4-Button1.Height; Button1.Left:=ClientWidth-Button1.Width -6; Button2.Left:=2; Button3.Left:=Button2.Left+Button2.Width+2; Button2.Top:=Button1.Top; Button3.Top:=Button1.Top; ListView1.Width:=ClientWidth; ListView1.Top:=Button1.Top-4-ListView1.Height; if ListView1.Items.Count>0 then Memo1.Height:=Listview1.Top-4-Memo1.Top else Memo1.Height:=Button1.Top-4-Memo1.Top; end; //增添附件 procedure TForm1.Button2Click(Sender: TObject); var i:integer; w:Word; L,h:LongWord; S,S2:String; NewItem:TListItem; begin w:=0; if not OpenDialog1.Execute then exit; for i:=0 to OpenDialog1.Files.Count-1 do begin S:=OpenDialog1.Files.Strings[i]; h:=CreateFile(PChar(S),GENERIC_READ, FILE_SHARE_READ,nil,OPEN_EXISTING,0,0); L:=GetFileSize(h,nil); L:=(L+1023)div 1024; if L<1000 then begin S2:=‘ ('+IntToStr(L)+‘K)' end else begin Str(L/1024:0:2,S2); S2:=‘ ('+S2+‘M)'; end; TheIcon.Handle:=ExtractAssociatedIcon(hInstance,PChar(S),w); NewItem:=ListView1.Items.Add; NewItem.ImageIndex:=ImageList.AddIcon(TheIcon); NewItem.Caption:=ExtractFileName(S)+S2; NewItem.SubItems.Add(S);//保存文件的完全路径名 end; if ListView1.Items.Count>0 then ListView1.Visible:=True else ListView1.Visible:=False; FormResize(self); end; //删除附件 procedure TForm1.Button3Click(Sender: TObject); var item:TListItem; begin item:=ListView1.Selected; ListView1.Items.BeginUpdate; while item<>nil do begin ListView1.Items.Delete(Item.Index); Item:=ListView1.Selected; end; ListView1.Items.EndUpdate; if ListView1.Items.Count<=0 then ListView1. Visible:=False; FormResize(self); end; end.