请问在DELPHI中如何嵌入整个OUTLOOK程序?
请问在DELPHI中如何嵌入整个OUTLOOK程序?
[解决办法]
一、步骤
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
//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);
(AdWords) 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.
[解决办法]
那就这样吧：
1、启动OutLook程序
2、使用Windows.SetParent(hOutlook,hForm1);
