我把source贴上,大家研究下:
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, MAPI,
StdCtrls;
type
TForm1 = class(TForm)
Button1: TButton;
Button2: TButton;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.DFM}
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 - 1do
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 - 1do
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 - 1do
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 - 1do
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 Msgdo
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 howdo
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;
function SendMail(const aAtts: array of string;
ShowError: boolean = true):Integer;
var
SM: TFNMapiSendMail;
MAPIModule: HModule;
Msg: MapiMessage;
Att: array of MapiFileDesc;
p1,LenAtts: integer;
sErro: string;
begin
try
FillChar(Msg, SizeOf(Msg), 0);
{ get the length of all array passed to this function }
LenAtts := Length(aAtts);
{ ... }
Setlength(Att,LenAtts);
{ atts }
for p1 := 0 to LenAtts - 1do
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 Msgdo
begin
ulReserved := 0;
Msg.lpszMessageType := 0;
Msg.lpszDateReceived := 0;
Msg.lpszConversationID := 0;
Msg.flFlags := 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 howdo
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;
function SendToMail(const aAtts: string):Integer;
var
SM: TFNMapiSendMail;
MAPIModule: HModule;
Msg: MapiMessage;
Att: MapiFileDesc;
LenAtts: integer;
begin
FillChar(Msg, SizeOf(Msg), 0);
// LenAtts := Length(aAtts);
// Setlength(Att,LenAtts);
{ atts }
// FillChar(Att, SizeOf(Att), 0);
asm
xor eax, eax
mov [esp+$30], eax
xor eax, eax
mov [esp+$34], eax
mov [esp+$38], $ffffffff
mov eax, ebx
// call @LStrToPChar
mov [esp+$3c], eax
mov eax, $00443868
mov [esp+$40], eax
xor eax, eax
mov [esp+$44], eax
end;
Att.ulReserved := 0;
Att.flFlags := 0;
Att.nPosition := Cardinal($FFFFFFFF);
Att.lpszPathName := pchar(aAtts);
Att.lpszFileName := '';
Att.lpFileType := 0;
{ fill the message }
Msg.ulReserved := 0;
Msg.lpszMessageType := 0;
Msg.lpszDateReceived := 0;
Msg.lpszConversationID := 0;
Msg.flFlags := 0;
Msg.nFileCount := 1;
Msg.lpFiles := @Att;
MAPIModule := LoadLibrary(PChar(MAPIDLL));
if MAPIModule = 0 then
Result := -1
else
@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;
FreeLibrary(MAPIModule);
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
SendToMAPI(
[], // To
[], // CC
[], // BCC
['c:/config.sys'], // Atts
'', // Body
'', // Subject
'', // Sender Name
'', // Sender Email
true // Show Error or youwant to catch the error?
);
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
// SendMail(['c:/config.sys']);
SendToMail('c:/config.sys');
end;
end.