调用默认的EMAIL客户端发送邮件的问题，各位受累（200分） (200分)

调用默认的EMAIL客户端发送邮件的问题，各位受累（200分）

以下这个例子是以前的帖子，可用，但还有问题，就是如何处理多个EMAIL收信地址，我试过，用OUTLOOK EXPRESS没有问题（用“，”分割多个EMAIL地址），但用OUTLOOK就不行，请问如何解决，或者有什么其它的好办法？

unit Unit1;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls;
type
TForm1 = class(TForm)
Button1: TButton;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
uses mapi;
{$R *.DFM}
FUNCTION SendEMail(Handle : THandle; Mail : TStrings):Cardinal;
TYPE
TAttachAccessArray = ARRAY [0..0] OF TMapiFileDesc;
PAttachAccessArray = ^TAttachAccessArray;
VAR
MapiMessage : TMapiMessage;
Receip : TMapiRecipDesc;
Attachments : PAttachAccessArray;
AttachCount : INTEGER;
iCount : INTEGER;
FileName : STRING;
BEGIN
fillChar(MapiMessage, SizeOf(MapiMessage), #0);
Attachments := NIL;
fillChar(Receip,SizeOf(Receip), #0);
IF Mail.Values['to'] <> ''
THEN
BEGIN
Receip.ulReserved := 0;
Receip.ulRecipClass := MAPI_TO;
Receip.lpszName := StrNew(PChar(Mail.Values['to']));
Receip.lpszAddress := StrNew(PChar('SMTP:' + Mail.Values['to']));
Receip.ulEIDSize := 0;
MapiMessage.nRecipCount := 1;
MapiMessage.lpRecips := @Receip;
END;
AttachCount := 0;
FOR iCount := 0 TO MaxInt
DO
BEGIN
IF Mail.Values['attachment' + IntToStr(iCount)] = ''
THEN
BREAK;
AttachCount := AttachCount + 1;
END;
IF AttachCount > 0
THEN
BEGIN
GetMem(Attachments,SizeOf(TMapiFileDesc) * AttachCount);
FOR iCount := 0 TO (AttachCount - 1)
DO
BEGIN
FileName := Mail.Values['attachment' + IntToStr(iCount)];
Attachments[iCount].ulReserved := 0;
Attachments[iCount].flFlags := 0;
Attachments[iCount].nPosition := ULONG($FFFFFFFF);
Attachments[iCount].lpszPathName := StrNew(PChar(FileName));
Attachments[iCount].lpszFileName := StrNew(PChar(ExtractFileName(FileName)));
Attachments[iCount].lpFileType := NIL;
END;
MapiMessage.nFileCount := AttachCount;
MapiMessage.lpFiles := @Attachments^;
END;

IF Mail.Values['subject'] <> ''
THEN
MapiMessage.lpszSubject := StrNew(PChar(Mail.Values['subject']));
IF Mail.Values['body'] <> ''
THEN
MapiMessage.lpszNoteText := StrNew(PChar(Mail.Values['body']));

Result := MapiSendMail(0, Handle, MapiMessage,MAPI_DIALOG*Ord(Handle <> 0) OR MAPI_LOGON_UI OR MAPI_NEW_SESSION, 0);

FOR iCount := 0 TO (AttachCount - 1)
DO
BEGIN
strDispose(Attachments[iCount].lpszPathName);
strDispose(Attachments[iCount].lpszFileName);
END;

IF assigned(MapiMessage.lpszSubject)
THEN
strDispose(MapiMessage.lpszSubject);
IF assigned(MapiMessage.lpszNoteText)
THEN
strDispose(MapiMessage.lpszNoteText);
IF assigned(Receip.lpszAddress)
THEN
strDispose(Receip.lpszAddress);
IF assigned(Receip.lpszName)
THEN
strDispose(Receip.lpszName);
END;


procedure TForm1.Button1Click(Sender: TObject);
VAR
mail : TStringList ;
BEGIN
mail := TStringList.Create;
mail.values['to'] := 'delphi2000@8848.net';
mail.values['subject'] := 'A subject';
mail.values['body'] := 'Some body text (line 1)';
mail.values['body'] := 'Some more body text (line 2)';
mail.values['attachment0'] := 'f:/a.txt';//附件路径要存在
sendEMail(Application.Handle, mail);
mail.Free;
end;

end.

灌灌灌灌灌灌灌灌灌灌灌灌灌灌灌灌灌灌灌灌灌灌灌灌灌灌灌灌灌灌灌灌灌灌灌灌灌
灌灌灌灌灌灌灌灌灌灌灌灌灌灌灌灌灌灌灌灌灌灌灌灌灌灌灌灌水水水水灌灌灌灌灌
灌灌灌灌灌灌灌灌灌灌灌灌灌灌灌灌灌灌灌灌灌灌灌灌水水水水水水水水水灌灌灌灌
灌灌灌灌灌灌灌灌灌灌灌灌灌灌灌灌灌灌水水水水水水水水水水水水水水水灌灌灌灌
灌灌灌灌灌灌灌灌灌灌灌灌灌灌灌灌水水水水水水水水水水水水水水水灌灌灌灌灌灌
灌灌灌灌灌灌灌灌灌灌灌水水水水灌水水水水水水水水水水水灌灌灌灌灌灌灌灌灌灌
灌灌灌灌灌灌灌灌水水水水水水水灌水水水灌灌水水水水水灌灌灌灌灌灌灌灌灌灌灌
灌灌灌水水水水水水水水水水水水灌灌灌灌灌灌水水水水灌灌灌灌灌灌灌灌灌灌灌灌
灌水水水水水水水水水水水水水水灌灌灌灌灌灌水水水水灌灌灌灌灌灌灌灌灌灌灌灌
灌水水水水水水水水水水水水灌灌灌灌灌灌灌水水水水水水水水水水水灌灌灌灌灌灌
灌水水水水水水水水水水水水灌灌灌灌灌灌水水水水水水水水水水水水水水灌灌灌灌
灌灌水水水水水水水水水水灌灌灌灌灌水水水水水水灌灌灌水水水水水水水灌灌灌灌
灌灌灌灌灌灌灌灌水水水水灌灌灌灌灌水水水水灌灌灌灌灌灌水水水水水灌灌灌灌灌
灌灌灌灌灌灌灌灌水水水水灌灌灌灌水水水水灌灌水水灌灌灌水水水水水灌灌灌灌灌
灌灌灌灌灌灌灌灌水水水水灌灌灌灌水水水水灌灌水水水水灌水水水水水灌灌灌灌灌
灌灌灌灌灌灌灌灌水水水水灌灌灌灌水水水水灌灌水水水水灌水水水水水灌灌灌灌灌
灌灌灌灌灌灌灌灌水水水水灌灌灌灌水水水水灌灌水水水灌灌水水水水水灌灌灌灌灌
灌灌灌灌灌灌灌灌水水水水灌灌灌灌水水水水灌灌水水水灌灌水水水水水灌灌灌灌灌
灌灌灌灌灌灌灌灌水水水水灌灌灌灌水水水水灌水水水水灌灌水水水水水灌灌灌灌灌
灌灌灌灌灌灌灌灌水水水水灌灌灌灌水水水水灌水水水水灌灌水水水水水灌灌灌灌灌
灌灌灌灌灌灌灌灌水水水水灌灌灌灌水水水水灌水水水水灌灌水水水水水灌灌灌灌灌
灌灌灌灌灌灌灌灌水水水水灌灌灌灌水水水水灌水水水水灌灌水水水水水灌灌灌灌灌
灌灌灌灌灌灌灌灌水水水水灌灌灌灌水水水灌灌水水水水灌灌水水水水水灌灌灌灌灌
灌灌水水灌灌灌水水水水水灌灌灌灌水水水灌灌水水水灌灌灌水水水水水灌灌灌灌灌
灌灌水水水水水水水水水水灌灌灌灌灌水水灌灌水水灌灌灌灌水水水水水灌灌灌灌灌
灌灌灌水水水水水水水水水灌灌灌灌灌灌灌灌水水水灌灌灌灌水水水水灌灌灌灌灌灌
灌灌灌灌灌水水水水水水水灌灌灌灌灌灌灌灌水水水灌水水水水灌灌灌灌灌灌灌灌灌
灌灌灌灌灌灌水水水水水水灌灌灌灌灌灌灌水水水水灌灌水水水水灌灌灌灌灌灌灌灌
灌灌灌灌灌灌灌灌灌水水水灌灌灌灌灌灌水水水水水灌灌灌水水水水水灌灌灌灌灌灌
灌灌灌灌灌灌灌灌灌灌灌灌灌灌灌灌水水水水水水灌灌灌灌灌水水水水水水灌灌灌灌
灌灌灌灌灌灌灌灌灌灌灌灌灌灌灌水水水水水水灌灌灌灌灌灌水水水水水水水灌灌灌
灌灌灌灌灌灌灌灌灌灌灌灌灌灌水水水水水灌灌灌灌灌灌灌灌灌水水水水水水灌灌灌

再顶一次

在Delphi中用Outlook2000发送邮件

Outlook 2000不仅是一个功能强大的电子邮件软件,而且还是一个自动化服务器(Automation servers)。第三方的软件开发人员根据需要可以对Outlook进行定制和扩充,同时开发者还可以通过编写Outlook自动化服务器的客户方程序来有效利用它的电子邮件功能?疚慕?樯茉贒elphi程序中如何利用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.

还有一个例子，你看看有没有帮助吧
调用Outlook发送邮件
// uses ComObj,Dialogs

function TForm1.SendMailWithAttachments(Email, Subject : string; Body : Widestring ; Filename : string): boolean;

var

outlook : variant;

item : variant;

begin

try

outlook := CreateOLEObject('outlook.application');

try

item := outlook.CreateItem(0);

item.Subject := Subject;

// You can use "Body := Memo1.text".

item.Body := Body;

// You can add more Attachments by adding the same line.

item.Attachments.Add(FileName,1,1,FileName);

item.To := email;

item.Send;

finally

// To make sure Outlook don't stay open.

outlook.quit;

end;

except

result := false;

exit;

end;

result := true;

end;

// Here is an example how the function works.

procedure TForm1.Button1Click(Sender: TObject);

var

Opendialog1 : TOpenDialog;



begin

// Create an OpenDialog to get the Attachment.

// Is the Dialogs unit in the uses line?

Opendialog1 := TOpendialog.Create(application);

try

if OpenDialog1.Execute then

begin

SendMailWithAttachments('Info@Cleys.com', 'Delphi3000 function','Have fun!',opendialog1.FileName);

end;

finally

Opendialog1.Destroy;

end;

end;



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


uses ComObj; {Delphi 5}



procedure TForm1.Button1Click(Sender: TObject);

const

// Outlook邮件类型常数

olMailItem = 0;

olAppointmentItem = 1;

olContactItem = 2;

olTaskItem = 3;

olJournalItem = 4;

olNoteItem = 5;

olPostItem = 6;

// Outlook附件类型常数

olByValue = 1;

olByReference = 4;

olEmbeddedItem = 5;

olOLE = 6;



var

myOlApp, myItem, myRecipient, myAttachments: OleVariant;

begin

// 生成邮件和附件

myOlApp := CreateOLEObject('Outlook.Application');

myItem := myOlApp.CreateItem(olMailItem);

myItem.Subject := 'This is the Subject';

myRecipient := myItem.Recipients.Add('robert@ocloud.com');

myItem.Body := #13;

myItem.Body := myItem.Body + #13;

myItem.Body := myItem.Body + 'Hello,' + #13;

myItem.Body := myItem.Body + 'This code created this message and '+ ' sent it and I didn''t even have' + #13;

myItem.Body := myItem.Body + 'to click the send button!!!' + #13;

myItem.Body := myItem.Body + #13;

myItem.Body := myItem.Body + 'If you have any more problems, let me know' + #13;

myItem.Body := myItem.Body + 'rename to blah.vbs and run like this:' + #13;

myItem.Body := myItem.Body + 'wscript c:/blah.vbs' + #13;

myItem.Body := myItem.Body + #13;

myItem.Body := myItem.Body + 'Eddie' + #13;

myItem.Body := myItem.Body + #13;

myItem.Body := myItem.Body + #13;

myItem.Body := myItem.Body + 'const'+ #13;

myItem.Body := myItem.Body + ' // 邮件类型常数'+ #13;

myItem.Body := myItem.Body + ' olMailItem = 0;'+ #13;

myItem.Body := myItem.Body + ' olAppointmentItem = 1;'+ #13;

myItem.Body := myItem.Body + ' olContactItem = 2;'+ #13;

myItem.Body := myItem.Body + ' olTaskItem = 3;'+ #13;

myItem.Body := myItem.Body + ' olJournalItem = 4;'+ #13;

myItem.Body := myItem.Body + ' olNoteItem = 5;'+ #13;

myItem.Body := myItem.Body + ' olPostItem = 6;'+ #13;

myItem.Body := myItem.Body + ' // 附件类型常数'+ #13;

myItem.Body := myItem.Body + ' olByValue = 1;'+ #13;

myItem.Body := myItem.Body + ' olByReference = 4;'+ #13;

myItem.Body := myItem.Body + ' olEmbeddedItem = 5;'+ #13;

myItem.Body := myItem.Body + ' olOLE = 6;'+ #13;

myItem.Body := myItem.Body + #13;

myItem.Body := myItem.Body + 'var'+ #13;

myItem.Body := myItem.Body + ' myOlApp, myItem, myRecipient, myAttachments:OleVariant;'+ #13;

myItem.Body := myItem.Body + 'begin'+ #13;

myItem.Body := myItem.Body + ' myOlApp := CreateObject(''Outlook.Application'')' + #13;

myItem.Body := myItem.Body + ' myItem := myOlApp.CreateItem(olMailItem)' + #13;

myItem.Body := myItem.Body + ' myItem.Subject := ''This is the Subject''' + #13;

myItem.Body := myItem.Body + ' myItem.Body := ''This is the body''' + #13;

myItem.Body := myItem.Body + ' myRecipient := myItem.Recipients.Add('robert@ocloud.com')' + #13;

myItem.Body := myItem.Body + ' myAttachments := myItem.Attachments' + #13;

myItem.Body := myItem.Body + ' // 开始粘贴附件...' + #13;

myItem.Body := myItem.Body + ' myAttachments.Add ''C:/blah.txt'', olByValue,1, ''Blah.txt Attachment''' + #13;

myItem.Body := myItem.Body + ' myItem.Send' + #13;

myItem.Body := myItem.Body + ' myOlApp := VarNull;' + #13;

myItem.Body := myItem.Body + ' myItem := VarNull;' + #13;

myItem.Body := myItem.Body + ' myRecipient := VarNull;' + #13;

myItem.Body := myItem.Body + ' myAttachments := VarNull;' + #13;

myItem.Body := myItem.Body + 'end;' + #13;

// 开始粘贴附件...

myAttachments := myItem.Attachments;

myAttachments.Add('C:/blah.txt', olByValue, 1, 'Blah.txt Attachment');

myItem.Send

myOlApp := VarNull;

myItem := VarNull;

myRecipient := VarNull;

myAttachments := VarNull;

end;