网上找到的，好用，我试过
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, MAPI;
type
TForm1 = class(TForm)
Button1: TButton;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
// 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 := nil;
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 := nil;
Msg.lpszMessageType := nil;
Msg.lpszDateReceived := nil;
Msg.lpszConversationID := nil;
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:/mem.exe', 'C:/MG.C'], // 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;
end.
