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
public
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
function SendMailMAPI(Subject, MsgText: String;
Filenames: TStrings;
SenderName, SenderEMail, RecepientName, RecepientEMail: String): Integer;
type
TAttachAccessArray = array [0..0] of TMapiFileDesc;
PAttachAccessArray = ^TAttachAccessArray;
var
MailMessage: TMapiMessage;
lpSender, lpRecepient: TMapiRecipDesc;
FileName: string;
Attachments: PAttachAccessArray;
SM: TFNMapiSendMail;
MAPIModule: HModule;
Counter: Byte;
AuxStr : String;
pAuxStr : Array[0..255] of AnsiChar;
pSubject : Array[0..255] of AnsiChar;
pMsgText : Array[0..9999] of AnsiChar;
pSenderName : Array[0..255] of AnsiChar;
pSenderEMail : Array[0..255] of AnsiChar;
pRecepientName : Array[0..255] of AnsiChar;
pRecepientEMail : Array[0..255] of AnsiChar;
pFileName : Array[0..255] of AnsiChar;
pPathName : Array[0..255] of AnsiChar;
begin
StrPCopy(pSubject,Subject);
StrPCopy(pMsgText,MsgText);
StrPCopy(pSenderName,SenderName);
StrPCopy(pSenderEMail,SenderEMail);
StrPCopy(pRecepientName,RecepientName);
StrPCopy(pRecepientEMail,RecepientEMail);
FillChar(MailMessage, SizeOf(MailMessage), 0);
with MailMessage do
begin
if (Subject <> '') then
MailMessage.lpszSubject := @pSubject;
if (MsgText <> '') then
MailMessage.lpszNoteText := @pMsgText;
if (SenderEMail <> '') then
begin
lpSender.ulRecipClass := MAPI_ORIG;
if (SenderName = '') then
lpSender.lpszName := @pSenderEMail
else
lpSender.lpszName := @pSenderName;
AuxStr := 'SMTP:' + SenderEMail;
StrPCopy(pAuxStr,AuxStr);
lpSender.lpszAddress := @pAuxStr;
lpSender.ulReserved := 0;
lpSender.ulEIDSize := 0;
lpSender.lpEntryID := nil;
lpOriginator := @lpSender;
end;
if (RecepientEMail <> '') then
begin
lpRecepient.ulRecipClass := MAPI_TO;
if (RecepientName = '') then
lpRecepient.lpszName := @pRecepientEMail
else
lpRecepient.lpszName := @pRecepientName;
AuxStr := 'SMTP:' + RecepientEMail;
StrPCopy(pAuxStr,AuxStr);
lpRecepient.lpszAddress := @pAuxStr;
lpRecepient.ulReserved := 0;
lpRecepient.ulEIDSize := 0;
lpRecepient.lpEntryID := nil;
nRecipCount := 1;
lpRecips := @lpRecepient;
end
else
lpRecips := nil;
if Filenames.Count > 0 then
begin
nFileCount := Filenames.Count;
GetMem(Attachments, SizeOf(TMapiFileDesc) * Filenames.Count);
for Counter := 0 to Filenames.Count - 1 do
begin
FileName := Filenames[counter];
Attachments[counter].ulReserved := 0;
Attachments[counter].flFlags := 0;
Attachments[counter].nPosition := ULONG($FFFFFFFF);
StrPCopy(pPathName, Filename);
Attachments[counter].lpszPathName := StrNew(pPathName);
StrPCopy(pFileName, ExtractFileName(Filename));
Attachments[counter].lpszFileName := StrNew(pFileName);
Attachments[counter].lpFileType := nil;
end;
lpFiles := @Attachments^;
end
else
begin
nFileCount := 0;
lpFiles := nil;
end;
end;
MAPIModule := LoadLibrary(PChar(MAPIDLL));
if MAPIModule = 0 then
Result := -1
else
begin
try
@SM := GetProcAddress(MAPIModule, 'MAPISendMail');
if @SM <> nil then
Result := SM(0, Application.Handle, MailMessage, MAPI_DIALOG or MAPI_LOGON_UI, 0)
else
Result := 1
finally
FreeLibrary(MAPIModule);
end;
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
var
Subject : String;
MsgText : TStringList;
FileName : String;
Filenames : TStringList;
SenderName, SenderEMail, RecepientName, RecepientEMail : String;
i : Integer;
begin
Subject := 'Prueba de Email con MAPI';
MsgText := TStringList.Create;
for i := 1 to 10 do
MsgText.Add('Línea de Texto-' + IntToStr(i));
Filenames := TStringList.Create;
FileName := IncludeTrailingBackslash(ExtractFilePath(Application.ExeName)) + 'TestFile1.txt';
if FileExists(FileName) then
Filenames.Add(FileName);
FileName := IncludeTrailingBackslash(ExtractFilePath(Application.ExeName)) + 'TestFile2.txt';
if FileExists(FileName) then
Filenames.Add(FileName);
FileName := IncludeTrailingBackslash(ExtractFilePath(Application.ExeName)) + 'TestFile3.txt';
if FileExists(FileName) then
Filenames.Add(FileName);
SenderName := 'UserName Surname';
SenderEMail := 'userName@gmail.com';
RecepientName := 'AnotherUserName AnotherSurname';
RecepientEMail := 'anotheruserName@gmail.com';
SendMailMAPI(Subject, MsgText.Text, Filenames,
SenderName, SenderEMail, RecepientName, RecepientEMail);
Filenames.Free;
MsgText.Free;
end;
end.