Internet - componente para enviar email

Top Previous Next

unit EmailUnit;

interface

uses

Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs;

type

// Introducing a new Type of Event to get the Errorcode

TMapiErrEvent = procedure(Sender: TObject; ErrCode: Integer) of object;

TEmail = class(TComponent)

constructor Create(AOwner: TComponent); override;

destructor Destroy; override;

private

FSubject: string;

FMailtext: string;

FFromName: string;

FFromAdress: string;

FTOAdr: TStrings;

FCCAdr: TStrings;

FBCCAdr: TStrings;

FAttachedFileName: TStrings;

FDisplayFileName: TStrings;

FShowDialog: Boolean;

FUseAppHandle: Boolean;

// Error Events:

FOnUserAbort: TNotifyEvent;

FOnMapiError: TMapiErrEvent;

FOnSuccess: TNotifyEvent;

procedure SetToAddr(newValue: TStrings);

procedure SetCCAddr(newValue: TStrings);

procedure SetBCCAddr(newValue: TStrings);

procedure SetAttachedFileName(newValue: TStrings);

public

ApplicationHandle: THandle;

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 FromAdress : string read FFromAdress write FFromAdress;

property Recipients : TStrings read FTOAdr write SetTOAddr;

property CopyTo : TStrings read FCCAdr write SetCCAddr;

property BlindCopyTo : TStrings read FBCCAdr write SetBCCAddr;

property AttachedFiles : TStrings read FAttachedFileName write SetAttachedFileName;

property DisplayFileName: TStrings read FDisplayFileName;

property ShowDialog : Boolean read FShowDialog write FShowDialog default False;

property UseAppHandle : Boolean read FUseAppHandle write FUseAppHandle default False;

// Events:

property OnUserAbort : TNotifyEvent read FOnUserAbort write FOnUserAbort;

property OnMapiError : TMapiErrEvent read FOnMapiError write FOnMapiError;

property OnSuccess : TNotifyEvent read FOnSuccess write FOnSuccess;

end;

procedure Register;

implementation

uses Mapi;

procedure Register;

begin

RegisterComponents('Samples', [TEmail]);

end;

constructor TEmail.Create(AOwner: TComponent);

begin

inherited Create(AOwner);

FOnUserAbort := nil;

FOnMapiError := nil;

FOnSuccess := nil;

FSubject := '';

FMailtext := '';

FFromName := '';

FFromAdress := '';

FTOAdr := TStringList.Create;

FCCAdr := TStringList.Create;

FBCCAdr := TStringList.Create;

FAttachedFileName := TStringList.Create;

FDisplayFileName := TStringList.Create;

FShowDialog := False;

FUseAppHandle := False;

ApplicationHandle := Application.Handle;

end;

procedure TEmail.SetToAddr(newValue: TStrings);

begin

FToAdr.Assign(newValue);

end;

procedure TEmail.SetCCAddr(newValue: TStrings);

begin

FCCAdr.Assign(newValue);

end;

procedure TEmail.SetBCCAddr(newValue: TStrings);

begin

FBCCAdr.Assign(newValue);

end;

procedure TEmail.SetAttachedFileName(newValue: TStrings);

begin

FAttachedFileName.Assign(newValue);

end;

destructor TEmail.Destroy;

begin

FTOAdr.Free;

FCCAdr.Free;

FBCCAdr.Free;

FAttachedFileName.Free;

FDisplayFileName.Free;

inherited destroy;

end;

procedure TEmail.Reset;

begin

FSubject := '';

FMailtext := '';

FFromName := '';

FFromAdress := '';

FTOAdr.Clear;

FCCAdr.Clear;

FBCCAdr.Clear;

FAttachedFileName.Clear;

FDisplayFileName.Clear;

end;

// Send the Mail via the API, this procedure composes and sends the Email

procedure TEmail.Sendmail;

var

MapiMessage: TMapiMessage;

Sender : TMapiRecipDesc;

MError : Cardinal;

i : Integer;

AppHandle : THandle;

PRecip, Recipients : PMapiRecipDesc;

PFiles, Attachments: PMapiFileDesc;

begin

// First we store the Application Handle, if not the Component might fail to send the Email or

// your calling Program gets locked up.

AppHandle := Application.Handle;

// Initialize the Attachment Pointer, to keep Delphi quiet

PFiles := nil;

// We need all recipients to alloc the memory

MapiMessage.nRecipCount := FTOAdr.Count + FCCAdr.Count + FBCCAdr.Count;

GetMem(Recipients, MapiMessage.nRecipCount * sizeof(TMapiRecipDesc));

try

with MapiMessage do

begin

ulReserved := 0;

// Setting the Subject:

lpszSubject := PChar(Self.FSubject);

// the Body:

lpszNoteText := PChar(FMailText);

lpszMessageType := nil;

lpszDateReceived := nil;

lpszConversationID := nil;

flFlags := 0;

// and the sender: (MAPI_ORIG)

Sender.ulReserved := 0;

Sender.ulRecipClass := MAPI_ORIG;

Sender.lpszName := PChar(FromName);

Sender.lpszAddress := PChar(FromAdress);

Sender.ulEIDSize := 0;

Sender.lpEntryID := nil;

lpOriginator := @Sender;

PRecip := Recipients;

// We have multiple recipients: (MAPI_TO) and setting up each:

if nRecipCount > 0 then

begin

for i := 1 to FTOAdr.Count do

begin

PRecip^.ulReserved := 0;

PRecip^.ulRecipClass := MAPI_TO;

// lpszName should carry the Name like in the contacts or the adress book, I will take the

// email adress to keep it short:

PRecip^.lpszName := PChar(FTOAdr.Strings[i - 1]);

// If you use this component with Outlook97 or 2000 and not some of Express versions you will have to set

// 'SMTP:' in front of each (email-) adress. Otherwise Outlook/Mapi will try to handle the Email on itself.

// Sounds strange, just erease the 'SMTP:', compile, compose a mail and take a look at the resulting email adresses

// (right click).

PRecip^.lpszAddress := StrNew(PChar('SMTP:' + FTOAdr.Strings[i - 1]));

PRecip^.ulEIDSize := 0;

PRecip^.lpEntryID := nil;

Inc(PRecip);

end;

// Same with the carbon copy recipients: (CC, MAPI_CC)

for i := 1 to FCCAdr.Count do

begin

PRecip^.ulReserved := 0;

PRecip^.ulRecipClass := MAPI_CC;

PRecip^.lpszName := PChar(FCCAdr.Strings[i - 1]);

PRecip^.lpszAddress := StrNew(PChar('SMTP:' + FCCAdr.Strings[i - 1]));

PRecip^.ulEIDSize := 0;

PRecip^.lpEntryID := nil;

Inc(PRecip);

end;

// and the blind copy recipients: (BCC, MAPI_BCC)

for i := 1 to FBCCAdr.Count do

begin

PRecip^.ulReserved := 0;

PRecip^.ulRecipClass := MAPI_BCC;

PRecip^.lpszName := PChar(FBCCAdr.Strings[i - 1]);

PRecip^.lpszAddress := StrNew(PChar('SMTP:' + FBCCAdr.Strings[i - 1]));

PRecip^.ulEIDSize := 0;

PRecip^.lpEntryID := nil;

Inc(PRecip);

end;

lpRecips := Recipients;

// Now we process the attachments:

nFileCount := FAttachedFileName.Count;

if nFileCount > 0 then

begin

GetMem(Attachments, nFileCount * sizeof(TMapiFileDesc));

PFiles := Attachments;

// Fist setting up the display names (without path):

FDisplayFileName.Clear;

for i := 1 to FAttachedFileName.Count do

FDisplayFileName.Add(ExtractFileName(FAttachedFileName[i - 1]));

if nFileCount > 0 then

begin

// Now we pass the attached file (their paths) to the structure:

for i := 1 to FAttachedFileName.Count do

begin

// Setting the complete Path

Attachments^.lpszPathName := PChar(FAttachedFileName.Strings[i - 1]);

// ... and the displayname:

Attachments^.lpszFileName := PChar(FDisplayFileName.Strings[i - 1]);

Attachments^.ulReserved := 0;

Attachments^.flFlags := 0;

// Position has to be -1, please see the WinApi Help for details.

Attachments^.nPosition := Cardinal(-1);

Attachments^.lpFileType := nil;

Inc(Attachments);

end;

lpFiles := PFiles;

end

else

begin

nFileCount := 0;

lpFiles := nil;

end;

{ Send the Mail, silent or verbose:

Verbose means in Express a Mail is composed and shown as setup.

In non-Express versions we show the Login-Dialog for a new

session and after we have choosen the profile to use, the

composed email is shown before sending

Silent does currently not work for non-Express version. We have

no Session, no Login Dialog so the system refuses to compose a

new email. In Express Versions the email is sent in the

background.

Please Note: It seems that your success on the delivery depends

on a combination of MAPI-Flags (MAPI_DIALOG, MAPI_LOGON_UI, ...)

and your used OS and Office Version. I am currently using

Win2K SP1 and Office 2K SP2 with no problems at all.

If you experience problems on another versions, please try

a different combination of flags for each purpose (Dialog or not).

I would be glad to setup a table with working flags on

each OS/Office combination, just drop me a line.

Possible combinations are also (with Dialog):

1. MAPI_DIALOG or MAPI_LOGON_UI MAPI_NEW_SESSION or MAPI_USE_DEFAULT

2. MAPI_SIMPLE_DEFAULT

See MAPI.PAS or MAPI.H (SDK) for more...

}

if FShowDialog then

MError := MapiSendMail(0, AppHandle, MapiMessage, MAPI_DIALOG or MAPI_LOGON_UI or MAPI_NEW_SESSION, 0)

else

MError := MapiSendMail(0, AppHandle, MapiMessage, 0, 0);

{ Now we have to process the error messages. There are some

defined in the MAPI unit please take a look at the unit to get

familiar with it.

I decided to handle USER_ABORT and SUCCESS as special and leave

the rest to fire the "new" error event defined at the top (as

generic error)

Not treated as special (constants from mapi.pas):

MAPI_E_FAILURE = 2;

MAPI_E_LOGON_FAILURE = 3;

MAPI_E_LOGIN_FAILURE = MAPI_E_LOGON_FAILURE;

MAPI_E_DISK_FULL = 4;

MAPI_E_INSUFFICIENT_MEMORY = 5;

MAPI_E_ACCESS_DENIED = 6;

MAPI_E_TOO_MANY_SESSIONS = 8;

MAPI_E_TOO_MANY_FILES = 9;

MAPI_E_TOO_MANY_RECIPIENTS = 10;

MAPI_E_ATTACHMENT_NOT_FOUND = 11;

MAPI_E_ATTACHMENT_OPEN_FAILURE = 12;

MAPI_E_ATTACHMENT_WRITE_FAILURE = 13;

MAPI_E_UNKNOWN_RECIPIENT = 14;

MAPI_E_BAD_RECIPTYPE = 15;

MAPI_E_NO_MESSAGES = 16;

MAPI_E_INVALID_MESSAGE = 17;

MAPI_E_TEXT_TOO_LARGE = 18;

MAPI_E_INVALID_SESSION = 19;

MAPI_E_TYPE_NOT_SUPPORTED = 20;

MAPI_E_AMBIGUOUS_RECIPIENT = 21;

MAPI_E_AMBIG_RECIP = MAPI_E_AMBIGUOUS_RECIPIENT;

MAPI_E_MESSAGE_IN_USE = 22;

MAPI_E_NETWORK_FAILURE = 23;

MAPI_E_INVALID_EDITFIELDS = 24;

MAPI_E_INVALID_RECIPS = 25;

MAPI_E_NOT_SUPPORTED = 26;

}

case MError of

MAPI_E_USER_ABORT: if Assigned(FOnUserAbort) then FOnUserAbort(Self);

SUCCESS_SUCCESS: if Assigned(FOnSuccess ) then FOnSuccess(Self);

else if Assigned(FOnMapiError) then FOnMapiError(Self, MError);

end;

finally

// Finally we do the cleanups, the message should be on its way

PRecip := Recipients;

for i := 1 to MapiMessage.nRecipCount do

begin

StrDispose(PRecip^.lpszAddress);

Inc(PRecip)

end;

FreeMem(Recipients, MapiMessage.nRecipCount * sizeof(TMapiRecipDesc));

if Assigned(PFiles) then

FreeMem(PFiles, MapiMessage.nFileCount * sizeof(TMapiFileDesc));

end;

end.

// -------------------- exemplo de uso

procedure TForm1.Button1Click(Sender: TObject);

begin

Email1.Body := 'corpo';

Email1.Subject := 'subject';

Email1.Recipients.Add('junior@market.com.br');

Email1.AttachedFiles.Add('c:\autoriza.txt');

Email1.Sendmail;

end;