如何使用OLE技术调用outlook express,并在其中添加附件(40分)

  • 主题发起人 主题发起人 cowbird
  • 开始时间 开始时间
C

cowbird

Unregistered / Unconfirmed
GUEST, unregistred user!
很多贴子中都说,
若使用shellexecute没法在outlook express中用代码来添加附件。
只能使用OLE技术在 ms outlook中用代码来添加附件。

但是大家发现没有若装了winzip,winrar等软件后,可以直接压缩发送,
这时候调用的是outlook express,其中也有压缩后的文件。也就是说可以
调用outlook express并使其中有附件的。

怎么实现???
 
Outlook Express 不支持 Automation, 但是可以使用 MAPI 函数实现,一个范例

// Send to MAPI using array of consts
// You can change this function to work with TStrings instead array of conts
easy
function SendToMAPI(const aTo,aCC,aBCC,aAtts: array of string;
const body,subject,SenderName,SenderEmail: string;
ShowError: boolean = true):Integer;
var
SM: TFNMapiSendMail;
MAPIModule: HModule;

Msg: MapiMessage;
lpSender: MapiRecipDesc;
Recips: array of MapiRecipDesc;
Att: array of MapiFileDesc;
p1,p2,p3,LenTo,LenCC,LenBCC,LenAtts: integer;
sErro: string;
begin
try
FillChar(Msg, SizeOf(Msg), 0);
{ get the length of all array passed to this function }
LenTo := Length(aTo);
LenCC := Length(aCC);
LenBCC := Length(aBCC);
LenAtts := Length(aAtts);
{ ... }
Setlength(Recips,LenTo+LenCC+LenBCC);
Setlength(Att,LenAtts);
{ to }
for p1 := 0 to LenTo - 1 do begin
FillChar(Recips[p1], SizeOf(Recips[p1]), 0);
Recips[p1].ulReserved := 0;
Recips[p1].ulRecipClass := MAPI_TO;
Recips[p1].lpszName := pchar(aTo[p1]);
Recips[p1].lpszAddress := '';
end;
{ cc }
for p2 := 0 to LenCC - 1 do begin
FillChar(Recips[p1+p2], SizeOf(Recips[p1+p2]), 0);
Recips[p1+p2].ulReserved := 0;
Recips[p1+p2].ulRecipClass := MAPI_CC;
Recips[p1+p2].lpszName := pchar(aCC[p2]);
Recips[p1+p2].lpszAddress := '';
end;
{ bcc }
for p3 := 0 to LenBCC - 1 do begin
FillChar(Recips[p1+p2+p3], SizeOf(Recips[p1+p2+p3]), 0);
Recips[p1+p2+p3].ulReserved := 0;
Recips[p1+p2+p3].ulRecipClass := MAPI_BCC;
Recips[p1+p2+p3].lpszName := pchar(aBCC[p3]);
Recips[p1+p2+p3].lpszAddress := '';
end;
{ atts }
for p1 := 0 to LenAtts - 1 do begin
FillChar(Att[p1], SizeOf(Att[p1]), 0);
Att[p1].ulReserved := 0;
Att[p1].flFlags := 0;
Att[p1].nPosition := Cardinal($FFFFFFFF); // ULONG(-1);
Att[p1].lpszPathName := pchar(aAtts[p1]);
Att[p1].lpszFileName := '';
Att[p1].lpFileType := 0;
end;
{ fill the message }
with Msg do begin
ulReserved := 0;
if subject <> '' then
lpszSubject := pChar(subject);
if body <> '' then
lpszNoteText := pchar(body);
if SenderEmail <> '' then begin
lpSender.ulRecipClass := MAPI_ORIG;
if SenderName = '' then
lpSender.lpszName := pchar(SenderEmail)
else
lpSender.lpszName := pchar(SenderName);
lpSender.lpszAddress := pchar(SenderEmail);
lpSender.ulEIDSize := 0;
lpSender.lpEntryID := nil;
lpOriginator := @lpSender;
end
else
Msg.lpOriginator := 0;
Msg.lpszMessageType := 0;
Msg.lpszDateReceived := 0;
Msg.lpszConversationID := 0;
Msg.flFlags := 0;
Msg.nRecipCount := LenTo + LenCC + LenBCC;
Msg.lpRecips := @Recips[0];
Msg.nFileCount := LenAtts;
Msg.lpFiles := @Att[0];
end;
MAPIModule := LoadLibrary(PChar(MAPIDLL));
if MAPIModule = 0 then
Result := -1
else
try
@SM := GetProcAddress(MAPIModule, 'MAPISendMail');
if @SM <> nil then begin
Result := SM(0, Application.Handle, Msg, MAPI_DIALOG or MAPI_LOGON_UI, 0);
end
else
Result := 1;
finally
FreeLibrary(MAPIModule);
end;
if result <> SUCCESS_SUCCESS then begin
// Here I know that exist better way to get error strings direct from api calls
// If someone know how do this, please email me
case result of
MAPI_E_AMBIGUOUS_RECIPIENT: sErro :=
'"MAPI_E_AMBIGUOUS_RECIPIENT"';
MAPI_E_ATTACHMENT_NOT_FOUND: sErro :=
'"MAPI_E_ATTACHMENT_NOT_FOUND"';
MAPI_E_ATTACHMENT_OPEN_FAILURE: sErro :=
'"MAPI_E_ATTACHMENT_OPEN_FAILURE"';
MAPI_E_BAD_RECIPTYPE: sErro :=
'"MAPI_E_BAD_RECIPTYPE"';
MAPI_E_FAILURE: sErro := '"MAPI_E_FAILURE"';
MAPI_E_INSUFFICIENT_MEMORY: sErro :=
'"MAPI_E_INSUFFICIENT_MEMORY"';
MAPI_E_LOGIN_FAILURE: sErro :=
'"MAPI_E_LOGIN_FAILURE"';
MAPI_E_TEXT_TOO_LARGE: sErro :=
'"MAPI_E_TEXT_TOO_LARGE"';
MAPI_E_TOO_MANY_FILES: sErro :=
'"MAPI_E_TOO_MANY_FILES"';
MAPI_E_TOO_MANY_RECIPIENTS: sErro :=
'"MAPI_E_TOO_MANY_RECIPIENTS"';
MAPI_E_UNKNOWN_RECIPIENT: sErro :=
'"MAPI_E_UNKNOWN_RECIPIENT"';
MAPI_E_USER_ABORT: sErro := '"MAPI_E_USER_ABORT"';
end;
if ShowError then
MessageDlg('Error sending mail (' + sErro + ').', mtError,[mbOK],
0);
end;
finally
end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
SendToMAPI(
['to_one@email.com.br','to_two@email.com.br'], // To
['cc_one@email.com.br','cc_two@email.com.br'], // CC
[], // BCC
['c:/autoexec.bat','c:/config.sys'], // Atts
'Corpo da mensagem', // Body
'Assunto', // Subject
'Bruno Lovatti', // Sender Name
'blovatti@vix.terra.com.br', // Sender Email
true // Show Error or you
want to catch the error?
);
end;
 
可以发送Task吗?
 
接受答案了.
 
后退
顶部