Here's some old code that I wrote a few years ago ...
unit ajMAPI;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
Mapi;
type
TajMapiErrorEvent = procedure(Sender : TObject; ErrCode : integer) of
object;
TajMapiControl = class(TComponent)
public
constructor Create (AOwner : TComponent); override;
destructor Destroy; override;
private
fSubject : string;
fMailText : string;
fFromName : string;
fFromAddress : string;
fTOAddress : TStrings;
fCCAddress : TStrings;
fBCCAddress : TStrings;
fAttachedFileName : TStrings;
fDisplayFileName : TStrings;
fShowDialog : boolean;
fOnUserAbort : TNotifyEvent;
fOnMapiError : TajMapiErrorEvent;
fOnSuccess : TNotifyEvent;
procedure SetToAddress (Value : TStrings);
procedure SetCCAddress (Value : TStrings);
procedure SetBCCAddress (Value : TStrings);
procedure SetAttachedFileName (Value : TStrings);
protected
public
procedure SendMail;
procedure Reset;
published
property Subject : string read fSubject
write fSubject;
property Body : string read fMailText
write fMailText;
property FromName : string read fFromName
write fFromName;
property FromAddress : string read fFromAddress
write fFromAddress;
property Recipients : TStrings read fTOAddress
write SetTOAddress;
property CopyTo : TStrings read fCCAddress
write SetCCAddress;
property BlindCopyTo : TStrings read fBCCAddress
write SetBCCAddress;
property AttachedFiles : TStrings read fAttachedFileName
write SetAttachedFileName;
property DisplayFileName : TStrings read fDisplayFileName;
property ShowDialog : boolean read fShowDialog
write fShowDialog;
property OnUserAbort : TNotifyEvent read fOnUserAbort
write fOnUserAbort;
property OnMapiError : TajMapiErrorEvent read fOnMapiError
write fOnMapiError;
property OnSuccess : TNotifyEvent read fOnSuccess
write fOnSuccess;
end;
procedure Register;
implementation
{--------------------------------------------------------------------------------------------------}
constructor TajMapiControl.Create(AOwner : TComponent);
begin
inherited;
fOnUserAbort := nil;
fOnMapiError := nil;
fOnSuccess := nil;
fSubject := '';
fMailtext := '';
fFromName := '';
fFromAddress := '';
fTOAddress := TStringList.Create;
fCCAddress := TStringList.Create;
fBCCAddress := TStringList.Create;
fAttachedFileName := TStringList.Create;
fDisplayFileName := TStringList.Create;
fShowDialog := false;
end; {constructor}
{--------------------------------------------------------------------------------------------------}
destructor TajMapiControl.Destroy;
begin
fTOAddress.Free;
FCCAddress.Free;
FBCCAddress.Free;
fAttachedFileName.Free;
fDisplayFileName.Free;
inherited;
end; {destructor}
{--------------------------------------------------------------------------------------------------}
procedure TajMapiControl.SetToAddress(Value : TStrings);
begin
fToAddress.Assign(Value);
end; {SetToAddress}
{--------------------------------------------------------------------------------------------------}
procedure TajMapiControl.SetCCAddress(Value : TStrings);
begin
fCCAddress.Assign(Value);
end; {SetCCAddress}
{--------------------------------------------------------------------------------------------------}
procedure TajMapiControl.SetBCCAddress(Value : TStrings);
begin
fBCCAddress.Assign(Value);
end; {SetBCCAddress}
{--------------------------------------------------------------------------------------------------}
procedure TajMapiControl.SetAttachedFileName(Value : TStrings);
begin
fAttachedFileName.Assign(Value);
end; {SetAttachedFileName}
{--------------------------------------------------------------------------------------------------}
procedure TajMapiControl.Reset;
begin
fSubject := '';
fMailtext := '';
fFromName := '';
fFromAddress := '';
fTOAddress.Clear;
fCCAddress.Clear;
fBCCAddress.Clear;
fAttachedFileName.Clear;
fDisplayFileName.Clear;
end; {Reset}
{--------------------------------------------------------------------------------------------------}
procedure TajMapiControl.SendMail;
var
MapiMessage : TMapiMessage;
MError : Cardinal;
Sender : TMapiRecipDesc;
PRecip, Recipients : PMapiRecipDesc;
PFiles, Attachments : PMapiFileDesc;
lp1 : integer;
begin
MapiMessage.nRecipCount := fTOAddress.Count + fCCAddress.Count +
fBCCAddress.Count;
GetMem(Recipients, MapiMessage.nRecipCount * SizeOf(TMapiRecipDesc));
try
with MapiMessage do begin
ulReserved := 0;
lpszSubject := PChar(fSubject);
lpszNoteText := PChar(fMailText);
lpszMessageType := nil;
lpszDateReceived := nil;
lpszConversationID := nil;
flFlags := 0;
Sender.ulReserved := 0;
Sender.ulRecipClass := MAPI_ORIG;
Sender.lpszName := PChar(FromName);
Sender.lpszAddress := PChar(FromAddress);
Sender.ulEIDSize := 0;
Sender.lpEntryID := nil;
lpOriginator := @Sender;
PRecip := Recipients;
if (nRecipCount > 0) then begin
for lp1 := 0 to pred(fTOAddress.Count) do begin
PRecip^.ulReserved := 0;
PRecip^.ulRecipClass := MAPI_TO;
PRecip^.lpszName := PChar(fTOAddress.Strings[lp1]);
PRecip^.lpszAddress := PChar('SMTP:' + fTOAddress.Strings[lp1]);
PRecip^.ulEIDSize := 0;
PRecip^.lpEntryID := nil;
inc(PRecip);
end; {for}
for lp1 := 0 to pred(fCCAddress.Count) do begin
PRecip^.ulReserved := 0;
PRecip^.ulRecipClass := MAPI_CC;
PRecip^.lpszName := PChar(fCCAddress.Strings[lp1]);
PRecip^.lpszAddress := PChar('SMTP:' + fCCAddress.Strings[lp1]);
PRecip^.ulEIDSize := 0;
PRecip^.lpEntryID := nil;
inc(PRecip);
end; {for}
for lp1 := 0 to pred(fBCCAddress.Count) do begin
PRecip^.ulReserved := 0;
PRecip^.ulRecipClass := MAPI_BCC;
PRecip^.lpszName := PChar(fBCCAddress.Strings[lp1]);
PRecip^.lpszAddress := PChar('SMTP:' +
fBCCAddress.Strings[lp1]);
PRecip^.ulEIDSize := 0;
PRecip^.lpEntryID := nil;
inc(PRecip);
end; {for}
end; {if}
lpRecips := Recipients;
if (fAttachedFileName.Count > 0) then begin
nFileCount := fAttachedFileName.Count;
GetMem(Attachments, MapiMessage.nFileCount * SizeOf(TMapiFileDesc));
PFiles := Attachments;
fDisplayFileName.Clear;
for lp1 := 0 to pred(fAttachedFileName.Count) do
fDisplayFileName.Add(ExtractFileName(fAttachedFileName[lp1]));
if (nFileCount > 0) then begin
for lp1 := 0 to pred(fAttachedFileName.Count) do begin
Attachments^.lpszPathName :=
PChar(fAttachedFileName.Strings[lp1]);
Attachments^.lpszFileName :=
PChar(fDisplayFileName.Strings[lp1]);
Attachments^.ulReserved := 0;
Attachments^.flFlags := 0;
Attachments^.nPosition := Cardinal(-1);
Attachments^.lpFileType := nil;
inc(Attachments);
end; {for}
end; {if}
lpFiles := PFiles;
end else begin
nFileCount := 0;
lpFiles := nil;
end; {if}
end; {if}
if fShowDialog then
MError := MapiSendMail(0, Application.Handle, MapiMessage,
MAPI_DIALOG or MAPI_LOGON_UI or MAPI_NEW_SESSION, 0)
else
MError := MapiSendMail(0, Application.Handle, MapiMessage, 0, 0);
case MError of
MAPI_E_USER_ABORT : begin
if Assigned(fOnUserAbort) then
fOnUserAbort(Self);
end;
SUCCESS_SUCCESS : begin
if Assigned(fOnSuccess) then
fOnSuccess(Self);
end else
begin
if Assigned(fOnMapiError) then
fOnMapiError(Self, MError);
end;
end;
finally
FreeMem(Recipients);
end; {try}
end; {SendMail}
{--------------------------------------------------------------------------------------------------}
procedure Register;
begin
RegisterComponents('SoftSpot', [TajMapiControl]);
end; {Register}
{--------------------------------------------------------------------------------------------------}
{ajMapi}
end.
Example use :
var
MapiControl : TajMapiControl;
begin
try
MapiControl := TajMapiControl.Create(nil);
MapiControl.ShowDialog := true;
MapiControl.Reset;
MapiControl.Recipients.Add('errors@errors.com');
MapiControl.Subject := 'Application Error Report';
MapiControl.Body := rchError.Text;
if FileExists(fLogFile) then
MapiControl.AttachedFiles.Add(fLogFile);
MapiControl.ShowDialog := false;
MapiControl.SendMail;
finally
FreeAndNil(MapiControl);
end; {try}
end;
// We don't do it this way anymore - Indy instead TIdSMTP !
Andrew
"Beto Neto" <betoneto.tbo@gmail.com> wrote in message
news:448da617$1@newsgroups.borland.com...
> How can I create a email using MAPI with the body as HTML and with any
> attachments ?
>
> Thank's!
