diff --git a/Source/Base/Utiles/uEMailUtils.pas b/Source/Base/Utiles/uEMailUtils.pas
index dfae483a..80299c57 100644
--- a/Source/Base/Utiles/uEMailUtils.pas
+++ b/Source/Base/Utiles/uEMailUtils.pas
@@ -2,16 +2,76 @@ unit uEMailUtils;
interface
-function IsValidEmail(const Value: string): boolean;
-function SendMailMAPI(const Subject, Body, FileName, SenderName, SenderEMail,
- RecepientName, RecepientEMail: String) : boolean;
+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;
+
+ TMapiControl = class(TComponent)
+ constructor Create(AOwner: TComponent); override;
+ destructor Destroy; override;
+ private
+ { Private-Deklarationen }
+ 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;}
+ { +> Changes by Eugene Mayevski [mailto:Mayevski@eldos.org]}
+ procedure SetToAddr(newValue: TStrings);
+ procedure SetCCAddr(newValue: TStrings);
+ procedure SetBCCAddr(newValue: TStrings);
+ procedure SetAttachedFileName(newValue: TStrings);
+ { +< Changes }
+ protected
+ { Protected-Deklarationen }
+ public
+ { Public-Deklarationen }
+ ApplicationHandle: THandle;
+ function Sendmail: Boolean;
+ procedure Reset;
+ published
+ { Published-Deklarationen }
+ 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;
+ property UseAppHandle: Boolean read FUseAppHandle write FUseAppHandle;
+
+ { Events: }
+ {property OnUserAbort: TNotifyEvent read FOnUserAbort write FOnUserAbort;
+ property OnMapiError: TMapiErrEvent read FOnMapiError write FOnMapiError;
+ property OnSuccess: TNotifyEvent read FOnSuccess write FOnSuccess;}
+ end;
+
+function EsDireccionEMailValida(const Value: string): boolean;
+function EnviarEMailMAPI(const AAsunto, ACuerpo, AFicheroAdjunto, ANombreRemitente, AEMailRemitente,
+ ANombreDestinatario, AEMailDestinatario: String; AEnviarDirectamente: Boolean = false) : boolean;
implementation
uses
- Windows, SysUtils, MAPI, Forms, Dialogs;
+ MAPI;
-function IsValidEmail(const Value: string): boolean;
+function EsDireccionEMailValida(const Value: string): boolean;
function CheckAllowed(const s: string): boolean;
var
i: integer;
@@ -45,112 +105,353 @@ begin // of IsValidEmail
Result:= CheckAllowed(namePart) and CheckAllowed(serverPart);
end;
-function SendMailMAPI(const Subject, Body, FileName, SenderName, SenderEMail,
- RecepientName, RecepientEMail: String) : Boolean;
+function EnviarEMailMAPI(const AAsunto, ACuerpo, AFicheroAdjunto, ANombreRemitente, AEMailRemitente,
+ ANombreDestinatario, AEMailDestinatario: String; AEnviarDirectamente: Boolean = false) : boolean;
var
- message: TMapiMessage;
- lpSender,
- lpRecepient: TMapiRecipDesc;
- FileAttach: TMapiFileDesc;
- SM: TFNMapiSendMail;
- MAPIModule: HModule;
- ErrorCode : Integer;
+ AMAPIControl : TMapiControl;
begin
- FillChar(message, SizeOf(message), 0);
- with message do
- begin
- if (Subject<>'') then
+ AMAPIControl := TMapiControl.Create(NIL);
+ try
+ with AMAPIControl do
begin
- lpszSubject := PChar(Subject)
- end;
- if (Body<>'') then
- begin
- lpszNoteText := PChar(Body)
- end;
- if (SenderEMail<>'') then
- begin
- lpSender.ulRecipClass := MAPI_ORIG;
- if (SenderName='') then
- begin
- lpSender.lpszName := PChar(SenderEMail)
- end
- else
- begin
- lpSender.lpszName := PChar(SenderName)
- end;
- lpSender.lpszAddress := PChar('SMTP:'+SenderEMail);
- lpSender.ulReserved := 0;
- lpSender.ulEIDSize := 0;
- lpSender.lpEntryID := nil;
- lpOriginator := @lpSender;
- end;
- if (RecepientEMail<>'') then
- begin
- lpRecepient.ulRecipClass := MAPI_TO;
- if (RecepientName='') then
- begin
- lpRecepient.lpszName := PChar(RecepientEMail)
- end
- else
- begin
- lpRecepient.lpszName := PChar(RecepientName)
- end;
- lpRecepient.lpszAddress := PChar('SMTP:'+RecepientEMail);
- lpRecepient.ulReserved := 0;
- lpRecepient.ulEIDSize := 0;
- lpRecepient.lpEntryID := nil;
- nRecipCount := 1;
- lpRecips := @lpRecepient;
- end
- else
- begin
- lpRecips := nil
- end;
- if (FileName='') then
- begin
- nFileCount := 0;
- lpFiles := nil;
- end
- else
- begin
- FillChar(FileAttach, SizeOf(FileAttach), 0);
- FileAttach.nPosition := Cardinal($FFFFFFFF);
- FileAttach.lpszPathName := PChar(FileName);
- nFileCount := 1;
- lpFiles := @FileAttach;
- end;
- end;
- MAPIModule := LoadLibrary(PChar(MAPIDLL));
- if MAPIModule=0 then
- begin
- ErrorCode := -1
- end
- else
- begin
- try
- @SM := GetProcAddress(MAPIModule, 'MAPISendMail');
- if @SM<>nil then
- begin
- ErrorCode := SM(0, Application.Handle, message, MAPI_DIALOG or MAPI_LOGON_UI, 0);
- end
- else
- begin
- ErrorCode := 1
- end;
+ Subject := AAsunto;
+ Body := ACuerpo;
+ FromName := ANombreRemitente;
+ FromAdress := AEMailRemitente;
- finally
- FreeLibrary(MAPIModule);
- end;
- end;
+ Recipients.Add(AEMailDestinatario);
+ AttachedFiles.Add(AFicheroAdjunto);
- if ErrorCode <> 0 then
- begin
- //MessageDlg('Error sending mail (' + IntToStr(ErrorCode) + ').', mtError, [mbOk], 0);
- Result := False;
- end
- else
- Result := True;
+ ShowDialog := not AEnviarDirectamente;
+ end;
+ Result := AMAPIControl.Sendmail;
+ finally
+ FreeANDNIL(AMAPIControl);
+ end;
end;
+{ TMapiControl }
+
+constructor TMapiControl.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;
+ ApplicationHandle := Application.Handle;
+end;
+
+{ +> Changes by Eugene Mayevski [mailto:Mayevski@eldos.org]}
+
+procedure TMapiControl.SetToAddr(newValue: TStrings);
+begin
+ FToAdr.Assign(newValue);
+end;
+
+procedure TMapiControl.SetCCAddr(newValue: TStrings);
+begin
+ FCCAdr.Assign(newValue);
+end;
+
+procedure TMapiControl.SetBCCAddr(newValue: TStrings);
+begin
+ FBCCAdr.Assign(newValue);
+end;
+
+procedure TMapiControl.SetAttachedFileName(newValue: TStrings);
+begin
+ FAttachedFileName.Assign(newValue);
+end;
+{ +< Changes }
+
+destructor TMapiControl.Destroy;
+begin
+ FTOAdr.Free;
+ FCCAdr.Free;
+ FBCCAdr.Free;
+ FAttachedFileName.Free;
+ FDisplayFileName.Free;
+ inherited destroy;
+end;
+
+{ Reset the fields for re-use}
+
+procedure TMapiControl.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 }
+
+function TMapiControl.Sendmail: Boolean;
+var
+ MapiMessage: TMapiMessage;
+ MError: Cardinal;
+ Sender: TMapiRecipDesc;
+ PRecip, Recipients: PMapiRecipDesc;
+ PFiles, Attachments: PMapiFileDesc;
+ i: Integer;
+ AppHandle: THandle;
+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).
+ }
+ { +> Changes by Andreas Hoerig [mailto:andreas.hoerig@sillner.com] }
+ PRecip^.lpszAddress := StrNew(PChar('SMTP:' + FTOAdr.Strings[i - 1]));
+ { +< Changes }
+ 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]);
+ { +> Changes by Andreas Hoerig [mailto:andreas.hoerig@sillner.com] }
+ PRecip^.lpszAddress := StrNew(PChar('SMTP:' + FCCAdr.Strings[i - 1]));
+ { +< Changes }
+ 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]);
+ { +> Changes by Andreas Hoerig [mailto:andreas.hoerig@sillner.com] }
+ PRecip^.lpszAddress := StrNew(PChar('SMTP:' + FBCCAdr.Strings[i - 1]));
+ { +< Changes }
+ PRecip^.ulEIDSize := 0;
+ PRecip^.lpEntryID := nil;
+ Inc(PRecip);
+ end;
+ 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;
+ end;
+ lpFiles := PFiles;
+ end
+ else
+ begin
+ nFileCount := 0;
+ lpFiles := nil;
+ end;
+ 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:
+ 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;}
+ Result := (MError = 0);
+
+ finally
+ { Finally we do the cleanups, the message should be on its way }
+ { +> Changes by Andreas Hoerig [mailto:andreas.hoerig@sillner.com] }
+ PRecip := Recipients;
+ for i := 1 to MapiMessage.nRecipCount do
+ begin
+ StrDispose(PRecip^.lpszAddress);
+ Inc(PRecip)
+ end;
+ { +< Changes }
+ FreeMem(Recipients, MapiMessage.nRecipCount * sizeof(TMapiRecipDesc));
+ { +> Changes due to Ken Halliwell [mailto:kjhalliwell@aol.com] }
+ if Assigned(PFiles) then
+ FreeMem(PFiles, MapiMessage.nFileCount * sizeof(TMapiFileDesc));
+ { +< Changes }
+ end;
+end;
+
end.
diff --git a/Source/GUIBase/GUIBase.dpk b/Source/GUIBase/GUIBase.dpk
index 691c4397..63d3a294 100644
--- a/Source/GUIBase/GUIBase.dpk
+++ b/Source/GUIBase/GUIBase.dpk
@@ -76,6 +76,7 @@ contains
uViewGrid in 'uViewGrid.pas' {frViewGrid: TFrame},
uViewRichEditor in 'uViewRichEditor.pas' {frViewRichEditor: TCustomView},
uDialogElegirEMail in 'uDialogElegirEMail.pas' {fDialogElegirEMail},
- uViewDocumentos in 'uViewDocumentos.pas' {frViewDocumentos: TCustomView};
+ uViewDocumentos in 'uViewDocumentos.pas' {frViewDocumentos: TCustomView},
+ uDialogListaEnvioEMail in 'uDialogListaEnvioEMail.pas' {fDialogListaEnvioEMail: TCustomEditor};
end.
diff --git a/Source/GUIBase/GUIBase.dproj b/Source/GUIBase/GUIBase.dproj
index 991b81a5..8d4eeaa9 100644
--- a/Source/GUIBase/GUIBase.dproj
+++ b/Source/GUIBase/GUIBase.dproj
@@ -59,36 +59,36 @@
MainSource
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ TCustomEditor
+
TCustomEditor
@@ -180,6 +180,10 @@
TFrame
+
+
+
+