在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.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;
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.
