(************************************************************************
*    This File is Part of the AHM Triton Tools                          *
*    for Borland Delphi and C++ Builder.                                *
*************************************************************************
* Copyright © 1995-1999 Alexander H. Mehlhorn (AHM) and Tritontools.com *
* All Rights reserved.                                                  *
*                                                                       *
*    For more Information contact us at                                 *
*    E-Mail : support@tritontools.com                                   *
*    URL : http://www.tritontools.com                                   *
*                                                                       *
*    AHM is copyright by Alexander H. Mehlhorn                          *
*    All Parts of this Collection were developed,                       *
*    designed and implemented by AHM                                    *
*                                                                       *
*    Under no Circumstances may you distribute this file                *
*    in this or any other format. This File is supplied                 *
*    as Evaluation of Source only. No Delphi Components may be developed*
*    using extracts or subsets of this code without expressed permission*
*    by AHM.                                                            *
*                                                                       *
*************************************************************************)
Unit AHMTMapiMail;

Interface

Uses
  Windows,Classes,Mapi,AHMMailClass,SysUtils,AHMMailConst;

Type
  TAHMExceptdllerror = Class(Exception);
  TAHMExceptAttachmentError = Class(Exception);
  TAHMExceptunavailable = Class(Exception);
  UINT = Integer;
  ULONG = LongInt;
  lpULONG = ^LongInt;
  LHANDLE = LongInt;
  lpLHANDLE = ^LHANDLE;
  DWORD = Longint;
  LPVOID = Pointer;

Type
  lpMapiFileDesc = ^TMapiFileDesc;
  TMapiFileDesc = Record
    ulReserved :ULONG;
    flFlags :ULONG;
    nPosition :ULONG;
    lpszPathName :PChar;
    lpszFileName :PChar;
    lpFileType :Pointer;
  End;
  lpMapiRecipDesc = ^TMapiRecipDesc;
  lppMapiRecipDesc = ^lpMapiRecipDesc;
  TMapiRecipDesc = Record
    ulReserved :ULONG;
    ulRecipClass :ULONG;
    lpszName :PChar;
    lpszAddress :PChar;
    ulEIDSize :ULONG;
    lpEntryID :Pointer;
  End;
  lpMapiMessage = ^TMapiMessage;
  TlppMapiMessage = ^lpMapiMessage;
  TMapiMessage = Record
    ulReserved :ULONG;
    lpszSubject :PChar;
    lpszNoteText :PChar;
    lpszMessageType :PChar;
    lpszDateReceived :PChar;
    lpszConversationID :PChar;
    flFlags :ULONG;
    lpOriginator :lpMapiRecipDesc;
    nRecipCount :ULONG;
    lpRecips :lpMapiRecipDesc;
    nFileCount :ULONG;
    lpFiles :lpMapiFileDesc;
  End;


Type
  TAHMMapiMail = Class;
  TAHMMapiMessages = Class;
  TAHMMapiMessage = Class;
  TAHMMapiAttachments = Class;
  TAHMOnSendError = Procedure(Sender :TObject;ErrorNo :Integer;Mail :TAHMMapiMessage) Of Object;
  TAHMMapiSend = Procedure(Sender :TObject;Mail :TAHMMapiMessage) Of Object;
  TAHMMapiConnect = Procedure(Sender :TObject;ErrorNo :Integer) Of Object;
  TAHMMapiRecipArray = Array[1..999] Of TMapiRecipdesc;
  TAHMMapiAttachment = Class(TCollectionItem)
  Private
    FFilename :String;
    FAHMMapiMessage :TAHMMapiMessage;
  protected
    Function GetDisplayName :String;Override;
  Public
    Constructor Create(Collection :TCollection);Override;
    Property Owner :TAHMMapiMessage Read FAHMMapiMessage;
  Published
    Property Filename :String Read FFilename Write FFilename;
  End;
  TAHMFaxorMail = (ccMail,ccFax);
  TAHMMapiAttachments = Class(TCollection)
  Private
    FAHMMapiMessage :TAHMMapiMessage;
    Function GeTAHMMapiAttachment(Index :Integer) :TAHMMapiAttachment;
    Procedure SeTAHMMapiAttachment(Index :Integer;Value :TAHMMapiAttachment);
  Protected
    Function GetOwner :TPersistent;Override;
  Public
    Constructor Create(AOwner :TAHMMapiMessage);
    Function Add(Filename :String) :TAHMMapiAttachment;
    Property Items[Index :Integer] :TAHMMapiAttachment
      Read GetAHMMapiAttachment Write SeTAHMMapiAttachment;Default;
  End;

  TAHMMapiMessage = Class(TCollectionItem)
  Private
    FAHMMapiMail :TAHMMapiMail;
    FSendSuccess :Boolean;
    FSubject :String;
    FMessage :TStrings;
    FReceipt :Boolean;
    FDialog :Boolean;
    FRecipientsTo,FRecipientsCC,FRecipientsBC :TStrings;
    FAHMMapiAttachments :TAHMMapiAttachments;
    FFaxNumber :String;
    FSendMethod :TAHMFaxOrMail;
    FFaxTo :String;
    Procedure SeTAHMMapiAttachments(Value :TAHMMapiAttachments);
    Procedure SetRecipientsTo(Value :TStrings);
    Procedure SetRecipientsCC(Value :TStrings);
    Procedure SetRecipientsBC(Value :TStrings);
    Procedure SetMessage(Value :TStrings);
  Protected
    Function GetDisplayName :String;Override;
  Public
    Constructor Create(Collection :TCollection);Override;
    Destructor Destroy;Override;
    Property Owner :TAHMMapiMail Read FAHMMapiMail;
  Published
    Property Message :TStrings Read FMessage Write SetMessage;
    Property SendMethod :TAHMFaxOrMail Read FSendMethod Write FSendMethod;
    Property FaxNumber :String Read FFaxNumber Write FFaxNumber;
    Property FaxTo :String Read FFaxTo Write FFaxTo;
    Property Attachments :TAHMMapiAttachments Read FAHMMapiAttachments Write SeTAHMMapiAttachments;
    Property Subject :String Read FSubject Write FSubject;
    Property RecipientsTo :TStrings Read FRecipientsTo Write SetRecipientsTo;
    Property RecipientsCC :TStrings Read FRecipientsCC Write SetRecipientsCC;
    Property RecipientsBC :TStrings Read FRecipientsBC Write SetRecipientsBC;
    Property Receipt :Boolean Read FReceipt Write FReceipt Default False;
    Property Dialog :Boolean Read FDialog Write FDialog Default False;
  End;
  TAHMMapiMessages = Class(TCollection)
  Private
    FAHMMapiMail :TAHMMapiMail;
    Function GetAHMMapiMessage(Index :Integer) :TAHMMapiMessage;
    Procedure SetAHMMapiMessage(Index :Integer;Value :TAHMMapiMessage);
  Protected
    Function GetOwner :TPersistent;Override;
  Public
    Property Owner :TAHMMapiMail Read FAHMMapiMail;
    Constructor Create(AOwner :TAHMMapiMail);
    Function Add :TAHMMapiMessage;
    Function Delete(Index :Integer) :Boolean;
    Property Items[Index :Integer] :TAHMMapiMessage Read GetAHMMapiMessage Write SetAHMMapiMessage;Default;
  End;
  TAHMMapiMail = Class(TAHMMailsComponent)
  Private
    FAHMMapiMessages :TAHMMapiMessages;
    FLogonFlags :ULONG;
    FNewSession :Boolean;
    FProfile,FPassword :String;
    FDefaultProfile :Boolean;
    FSignature :TStrings;
    FBeforeLogOff,FAfterSendAll,FBeforeSendAll,FBeforeLogon,
      FAfterExecute,FOnLogonSuccess,FOnLogoffSuccess :TNotifyEvent;
    FOnSendError :TAHMOnSendError;
    FOnDeleteMail,FBeforeSendMail,FAfterSendMail :TAHMMapiSend;
    FOnLogonFailure,FOnLogoffFailure :TAHMMapiConnect;
    FDeleteAfterSend :Boolean;
    FOnMapiNotAvailable :TNotifyevent;
    Function GetMAPIAvail :boolean;
    Procedure SetMapiAvail(Const Value : Boolean);
    Procedure SeTAHMMapiMessages(Value :TAHMMapiMessages);
    Function TheRecipients(AHMMessage :TAHMMapiMessage) :Pointer;
    Procedure SetSignature(Value :TStrings);
  Protected
    hSession :ULONG;
    Procedure CheckMAPI;Virtual;
    Function SendMapi :Integer;
    Function Logoff :Integer;
    Function Logon :Integer;
  Public
    Constructor Create(AOwner :TComponent);Override;
    Destructor Destroy;Override;
    Function Execute :Boolean;Override;
  Published
    Property MapiInstalled : Boolean read GetMapiAvail write SetMapiAvail stored False; 
    Property NewSession :Boolean Read FNewSession Write FNewSession Default False;
    Property Messages :TAHMMapiMessages Read FAHMMapiMessages Write SeTAHMMapiMessages;
    Property Password :String Read FPassword Write FPassword;
    Property Profile :String Read FProfile Write FProfile;
    Property DefaultProfile :Boolean Read FDefaultProfile Write FDefaultProfile Stored True Default True;
    Property Signature :TStrings Read FSignature Write SetSignature;
    Property DeleteAfterSend :Boolean Read FDeleteAfterSend Write FDeleteAfterSend Default true;
    Property BeforeLogon :TNotifyEvent Read FBeforeLogon Write FBeforeLogon;
    Property BeforeSendAll :TNotifyEvent Read FBeforeSendAll Write FBeforeSendAll;
    Property AfterSendAll :TNotifyevent Read FAfterSendAll Write FAfterSendAll;
    Property BeforeLogoff :TNotifyEvent Read FBeforeLogoff Write FBeforeLogoff;
    Property AfterExecute :TNotifyEvent Read FAfterExecute Write FAfterExecute;
    Property OnSendError :TAHMOnSendError Read FOnSendError Write FOnSendError;
    Property OnLogonSuccess :TNotifyevent Read FOnLogonSuccess Write FOnLogonSuccess;
    Property OnLogonFailure :TAHMMapiConnect Read FOnLogonFailure Write FOnLogonFailure;
    Property OnLogoffSuccess :TNotifyEvent Read FOnLogoffSuccess Write FOnLogoffSuccess;
    Property OnMapiNotAvailable :TNotifyevent Read FOnMapiNotAvailable Write FOnMapiNotAvailable;
    Property OnLogoffFailure :TAHMMapiConnect Read FOnLogoffFailure Write FOnLogoffFailure;
    Property BeforeSendMail :TAHMMapiSend Read FBeforeSendMail Write FBeforeSendMail;
    Property AfterSendMail :TAHMMapiSend Read FAfterSendMail Write FAfterSendMail;
    Property OnDeleteMail :TAHMMapiSend Read FOnDeleteMail Write FOnDeleteMail;
  End;
  TAHMQuickMail = Class(TAHMMailsComponent)
  Private
    fname,femail :String;
    foe,fbs :TNotifyevent;
    fmf :TAHMFaxorMail;
    fsubject :String;
    ferr :String;
    ftext :TStrings;
    Procedure SetText(value :TStrings);
  Protected
  Public
    Function Execute :Boolean;Override;
    Constructor Create(AOwner :TComponent);Override;
    Destructor Destroy;Override;
  Published
    Property ToEmailorFaxAddress :String Read femail Write femail;
    Property ToName :String Read fname Write fname;
    Property TextToSend :TStrings Read ftext Write Settext;
    Property Subject :String Read fsubject Write fsubject;
    Property MailorFax :TAHMFaxormail Read fmf Write fmf default ccMail;
    Property ErrorNo :String Read ferr Write ferr;
    Property BeforeSend :TNotifyevent Read fbs Write fbs;
    Property OnError :TNotifyevent Read foe Write foe;
  End;


Implementation

Uses IniFiles,Registry,Forms;


Var
  DLLinitialized :boolean;
  DLLHandle :THandle;

Type
  CAHMMAPIFindNext = Function(lhSession :LHANDLE;ulUIParam :ULONG;lpszMessageType :PChar;
    lpszSeedMessageID :PChar;flFlags :ULONG;ulReserved :ULONG;
    lpszMessageID :PChar) :ULONG Stdcall;
  CAHMMAPILogoff = Function(lhSession :LHANDLE;ulUIParam :ULONG;flFlags :ULONG;
    ulReserved :ULONG) :ULONG Stdcall;
  CAHMMAPILogon = Function(ulUIParam :ULONG;lpszName :PChar;lpszPassword :PChar;
    flFlags :ULONG;ulReserved :ULONG;lplhSession :LPLHANDLE) :ULONG Stdcall;
  CAHMMAPISendMail = Function(lhSession :LHANDLE;ulUIParam :ULONG;lpMessage :lpMapiMessage;
    flFlags :ULONG;ulReserved :ULONG) :ULONG Stdcall;
  CAHMMAPIReadMail = Function(lhSession :LHANDLE;ulUIParam :ULONG;lpszMessageID :PChar;
    flFlags :ULONG;ulReserved :ULONG;lpMessage :lpMapiMessage) :ULONG Stdcall;
  CAHMMAPIDeleteMail = Function(lhSession :LHANDLE;ulUIParam :ULONG;lpszMessageID :PChar;
    flFlags :ULONG;ulReserved :ULONG) :ULONG Stdcall;
  CAHMMAPIResolveName = Function(lhSession :LHANDLE;ulUIParam :ULONG;lpszName :Pchar;
    flFlags :ULONG;ulReserved :ULONG;lppRecips :lppMapiRecipDesc) :ULONG Stdcall;
  CAHMMAPIFreeBuffer = Function(pv :LPVOID) :ULONG Stdcall;
  CAHMMAPIAddress = Function(lhSession :LHANDLE;ulUIParam :ULONG;lpszCaption :PChar;
    nEditFields :ULONG;lpszLabels :PChar;nRecips :ULONG;
    Var lpRecips :TMapiRecipDesc;flFlags :ULONG;ulReserved :ULONG;
    lpnNewRecips :lpULONG;Var lppNewRecips :lpMapiRecipDesc) :ULONG Stdcall;
  CAHMMAPISaveMail = Function(lhSession :LHANDLE;ulUIParam :ULONG;lpMessage :lpMapiMessage;
    flFlags :ULONG;ulReserved :ULONG;lpszMessageID :PChar) :ULONG Stdcall;
Var
  AHMMAPIFindNext :CAHMMAPIFindNext = Nil;
  AHMMAPILogoff :CAHMMAPILogoff = Nil;
  AHMMAPILogon :CAHMMAPILogon = Nil;
  AHMMAPISendMail :CAHMMAPISendMail = Nil;
  AHMMAPIReadMail :CAHMMAPIReadMail = Nil;
  AHMMAPIDeleteMail :CAHMMAPIDeletemail = Nil;
  AHMMAPIResolveName :CAHMMAPIResolveName = Nil;
  AHMMAPIFreeBuffer :CAHMMAPIFreeBuffer = Nil;
  AHMMAPIAddress :CAHMMAPIAddress = Nil;
  AHMMAPISaveMail :CAHMMAPISaveMail = Nil;

Const
  MAPI_ORIG = 0;
  MAPI_TO = 1;
  MAPI_CC = 2;
  MAPI_BCC = 3;
  MAPI_RECEIPT_REQUESTED :ULONG = $0002;
  MAPI_LOGON_UI :ULONG = $0001;
  MAPI_NEW_SESSION :ULONG = $0002;
  MAPI_DIALOG :ULONG = $0008;
  SUCCESS_SUCCESS = 0;
  MAPI_USER_ABORT = 1;
  MAPI_E_FAILURE = 2;
  MAPI_E_LOGIN_FAILURE = 3;
  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_MESSAGE_IN_USE = 22;
  MAPI_E_NETWORK_FAILURE = 23;
  MAPI_E_INVALID_EDITFIELDS = 24;
  MAPI_E_INVALID_RECIPS = 25;
  MAPI_E_NOT_SUPPORTED = 26;

Function MAPILogoff(lhSession :LHANDLE;ulUIParam :ULONG;flFlags :ULONG;ulReserved :ULONG) :ULONG;
Begin
  Result := AHMMAPILogoff(lhSession,ulUIParam,flFlags,ulReserved);
End;

Function MAPILogon(ulUIParam :ULONG;lpszName :PChar;lpszPassword :PChar;flFlags :ULONG;
  ulReserved :ULONG;lplhSession :LPLHANDLE) :ULONG;
Begin
  Result := AHMMAPILogon(ulUIParam,lpszName,lpszPassword,flFlags,ulReserved,lplhSession);
End;

Function MAPISendMail(lhSession :LHANDLE;ulUIParam :ULONG;lpMessage :lpMapiMessage;
  flFlags :ULONG;ulReserved :ULONG) :ULONG;
Begin
  Result := AHMMAPISendMail(lhSession,ulUIParam,lpMessage,flFlags,ulReserved);
End;

Function MAPIResolveName(lhSession :LHANDLE;ulUIParam :ULONG;lpszName :Pchar;
  flFlags :ULONG;ulReserved :ULONG;lppRecips :lppMapiRecipDesc) :ULONG;
Begin
  Result := AHMMAPIResolveName(lhSession,ulUIParam,lpszName,flFlags,ulReserved,lppRecips);
End;


Function MAPIFreeBuffer(pv :LPVOID) :ULONG;
Begin
  Result := AHMMAPIFreeBuffer(pv);
End;

Function MAPIavailable :boolean;
Begin
  result := DLLinitialized;
End;


Constructor TAHMQuickmail.Create(AOwner :TComponent);
Begin
  ftext := TStringList.Create;
  fname := AHMRcMailQDefName;
  femail := AHMRcMailQDefMail;
  fmf := ccmail;
  Inherited Create(AOwner);
End;


Destructor TAHMQuickmail.Destroy;
Begin
  ftext.free;
  Inherited Destroy;
End;


Function TAHMQuickmail.Execute :Boolean;
Var
  CurrentMapiMsg :TMapiMessage;
  Mapirecipdesc :TMapiRecipdesc;
  MError :Cardinal;
  h1 :String;
Begin
  FillChar(CurrentMapiMsg,Sizeof(TMapiMessage),0);
  FillChar(MapiRecipDesc,Sizeof(TMapiRecipDesc),0);
  If assigned(fbs) Then fbs(Self);
  If fmf = ccmail Then
    h1 := concat(AHMRcMailSmtp,femail)
  Else h1 := concat(AHMRcMailFax,femail);
  With Mapirecipdesc Do
  Begin
    ulReserved := 0;
    ulRecipClass := MAPI_TO;
    lpszName := StrNew(pchar(fname));
    lpszAddress := StrNew(pchar(h1));
    ulEIDSize := 0;
    lpEntryID := Nil;
  End;
  With CurrentMapiMsg Do
  Begin
    ulReserved := 0;
    lpszSubject := StrNew(pchar(fsubject));
    lpszNoteText := StrNew(pchar(ftext.text));
    lpszMessageType := Nil;
    lpszDateReceived := Nil;
    lpszConversationID := Nil;
    flFlags := MAPI_RECEIPT_REQUESTED;
    lpOriginator := Nil;
    nRecipCount := 1;
    lpRecips := @Mapirecipdesc;
    nFileCount := 0;
    lpFiles := Nil;
  End;
  MError := MapiSendMail(0,0,@CurrentMapiMsg,MAPI_LOGON_UI,0);
  If MError <> 0 Then
  Begin
    ferr := Inttostr(Merror);If assigned(foe) Then foe(self);
  End Else ferr := '0';
  result := true;
End;

Procedure TAHMQuickmail.Settext(value :TStrings);
Begin
  Ftext.Assign(value);
End;

Constructor TAHMMapiMail.Create(AOwner :TComponent);
Begin
  FDeleteAfterSend := True;
  FNewSession := False;
  FDefaultProfile := True;
  Inherited Create(AOwner);
  FAHMMapiMessages := TAHMMapiMessages.Create(self);
  FSignature := TStringlist.Create;
End;

Destructor TAHMMapiMail.Destroy;
Begin
  If hSession <> 0 Then Logoff;
  FSignature.Free;
  FAHMMapiMessages.Free;
  Inherited Destroy;
End;

Procedure TAHMMapiMail.SetMapiAvail(Const Value : Boolean);
begin
  //For Designtime viewing only
end;

Function TAHMMapiMail.GetMAPIavail :boolean;
Begin
  Result := MAPIavailable;
End;

Procedure TAHMMapiMail.SetSignature(Value :TStrings);
Begin
  FSignature.Assign(Value);
End;

Procedure TAHMMapiMail.CheckMAPI;
begin
  if Not(MAPIavailable) Then
  if (csDesigning In Componentstate) Then Raise TAHMExceptunavailable.Create(AHMRcMailNoMapi) Else
  begin
    If Assigned(FOnMapiNotAvailable) Then FOnMapiNotAvailable(self);
  end;
end;

Function TAHMMapiMail.Logon :Integer;
Var
  ProfileKey :PChar;
  Reg :TRegistry;
Begin
  CheckMAPI;
  If Assigned(FBeforeLogon) Then FBeforeLogon(Self);
  Result := SUCCESS_SUCCESS;
  If hSession = 0 Then
  Begin
    If FDefaultProfile Then
    Begin
      Reg := TRegistry.Create;
      Try
        If Reg.KeyExists(AHMRcMailProfileKeyNT) Then ProfileKey := PChar(AHMRcMailProfileKeyNT)
        else ProfileKey := PChar(AHMRcMailProfileKey95);
        Reg.Rootkey := HKEY_CURRENT_USER;
        If Reg.OpenKey(ProfileKey,False) Then
        Begin
          Try
            FProfile := Reg.Readstring(AHMRcMailDefaultProfile);
          Except
            FProfile := '';
          End;
        End;
      Finally
        Reg.Free;
      End;
    End Else FLogonFlags := FLogonFlags Or MAPI_Logon_UI;
    If FNewSession Then FLogonFlags := FLogonFlags Or MAPI_NEW_SESSION;
    Result := MAPILogon(0,StrNew(PChar(FProfile)),StrNew(PChar(FPassword)),FLogonFlags,0,@hSession);
    If (Result <> SUCCESS_SUCCESS) Then
      Result := MAPILogon(0,Nil,Nil,FLogonFlags Or MAPI_Logon_UI,0,@hSession);
    If Result <> SUCCESS_SUCCESS Then
    Begin
      If assigned(FOnLogonFailure) Then FOnLogonFailure(self,Result);
    End Else
    Begin
      If assigned(FOnLogonSuccess) Then FOnLogonSuccess(Self);
    End;
  End;
End;

Function TAHMMapiMail.Logoff :Integer;
Begin
  CheckMAPI;
  If Assigned(FBeforeLogoff) Then FBeforeLogoff(Self);
  Result := SUCCESS_SUCCESS;
  If hSession <> 0 Then
  Begin
    Result := MAPILogoff(hSession,0,0,0);
    If Result <> SUCCESS_SUCCESS Then
    Begin
      If assigned(FOnLogoffFailure) Then FOnLogoffFailure(self,Result);
    End Else
    Begin
      If assigned(FOnLogoffSuccess) Then FOnLogoffSuccess(Self);
    End;
    hSession := 0;
  End;
End;

Function TAHMMapiMail.SendMapi :integer;
Var
  MapiMessage :TMapiMessage;
  MapiRecipDesc :TMapiRecipDesc;
  MapiFileDescArray :Array[1..100] Of TMapiFileDesc;
  MapiFileDesc :TMapiFileDesc;
  flFlags :ULONG;
  I,AL :Integer;
  MyRecipients :TAHMMapiRecipArray;
  SEmpty :String;
Begin
  CheckMAPI;
  result := 0;
  For Al := 0 To Messages.Count - 1 Do
    With Messages[Al] Do
    Begin
      FSendSuccess := False;
      If Assigned(FBeforeSendMail) Then FBEforeSendMail(Self,Messages[Al]);
      If (RecipientsTo.Count + RecipientsCC.Count + RecipientsBC.Count) > 1000 Then
      Begin
        Result := MAPI_E_TOO_MANY_RECIPIENTS;
        exit;
      End;
      If (Attachments.Count > 100) Then
      Begin
        Result := MAPI_E_TOO_MANY_FILES;
        exit;
      End;
      SEmpty := '';
      FillChar(MapiMessage,Sizeof(TMapiMessage),0);
      FillChar(MapiRecipDesc,Sizeof(TMapiRecipDesc),0);
      FillChar(MapiFileDesc,Sizeof(TMapiFileDesc),0);
      If Attachments.Count > 0 Then
        For i := 1 To Attachments.Count Do
        Begin
          FillChar(MapiFileDescArray[i],Sizeof(TMapiFileDesc),0);
          SEmpty := SEmpty + ' ';
        End;

      If SendMethod = ccMail Then
      Try
        MapiMessage.nRecipCount := RecipientsTo.Count + RecipientsCC.Count + RecipientsBC.Count;
        MapiMessage.lpszSubject := StrNew(PChar(Subject));
        MapiMessage.lpszNoteText := StrNew(PChar(SEmpty + #13 + Message.Text + FSignature.Text));
        If (MapiMessage.nRecipCount > 0) Then
        Begin
          If Dialog Then flFlags := MAPI_DIALOG Else flFlags := 0;
          MyRecipients := TAHMMapiRecipArray(TheRecipients(Messages[AL])^);
          MapiMessage.lpRecips := @MyRecipients;
        End Else
        Begin
          flFlags := MAPI_DIALOG;
          MapiMessage.lpRecips := Nil;
        End;
        For i := 0 To (Attachments.Count - 1) Do
        Begin
          If FileExists(Attachments[I].Filename) Then
          Begin
            MapiFileDescArray[i + 1].nPosition := DWord($FFFFFFFF);
            MapiFileDescArray[i + 1].lpszPathName := StrNew(PChar(Attachments[i].Filename));
            MapiFileDescArray[i + 1].lpszFileName := StrNew(PChar(ExtractFileName(Attachments[i].Filename)));
          End Else
          Begin
            MapiFileDescArray[i + 1].nPosition := DWord($FFFFFFFF);
            MapiFileDescArray[i + 1].lpszPathName := Nil;
            MapiFileDescArray[i + 1].lpszFileName := Nil;
          End;
        End;
        MapiMessage.nFileCount := Attachments.Count;
        If (Attachments.Count > 0) Then MapiMessage.lpFiles := @MapiFileDescArray
        Else MapiMessage.lpFiles := Nil;
        If Receipt Then MapiMessage.flFlags := MapiMessage.flFlags Or MAPI_RECEIPT_REQUESTED;
        Result := MAPISendMail(hSession,0,@MapiMessage,flFlags,0);
        If Result <> 0 Then
        Begin
          If Assigned(FOnSendError) Then FOnSendError(self,Result,Messages[Al])
        End Else
        Begin
          FSendSuccess := True;
          If Assigned(FAfterSendMail) Then FAfterSendMail(Self,Messages[Al]);
        End;
      Except
        Application.HandleException(self);
      End
      Else
      Try
        MapiMessage.nRecipCount := 1;
        MapiMessage.lpszSubject := StrNew(PChar(Subject));
        MapiMessage.lpszNoteText := StrNew(PChar(SEmpty + #13 + Message.Text + FSignature.Text));
        flFlags := 0;
        If (FaxNumber <> '') Then
        Begin
          With MyRecipients[1] Do
          Begin
            ulReserved := 0;
            ulRecipClass := MAPI_TO;
            lpszName := StrNew(pchar(FFaxTo));
            lpszAddress := StrNew(PChar(AHMRcMailFax + FaxNumber));
            ulEIDSize := 0;
            lpEntryID := Nil;
          End;
          MapiMessage.lpRecips := @MyRecipients;
        End;
        MapiMessage.nFileCount := 0;
        MapiMessage.lpFiles := Nil;
        If Receipt Then MapiMessage.flFlags := MapiMessage.flFlags Or MAPI_RECEIPT_REQUESTED;
        Result := MAPISendMail(hSession,0,@MapiMessage,flFlags,0);
        If Result <> 0 Then
        Begin
          If Assigned(FOnSendError) Then FOnSendError(self,Result,Messages[Al])
        End Else
        Begin
          FSendSuccess := True;
          If Assigned(FAfterSendMail) Then FAfterSendMail(Self,Messages[Al]);
        End;
      Except
        Application.HandleException(self);
      End;
    End;
  Al := 0;
  If FDeleteAfterSend Then
    While (Al < Messages.Count - 1) Do
      If Messages[Al].FSendSuccess Then Messages.Delete(Al) Else Inc(Al);
End;

Function TAHMMapiMail.TheRecipients(AHMMessage :TAHMMapiMessage) :Pointer;
Const
  RecipSize = 256;
Var
  I :Integer;
  s :String;
  AllRecipients :TStringList;
  MYResult :ULOng;
  CurrentMapiRecipDesc :lpMapiRecipDesc;
  MyRecips : TAHMMapiRecipArray;
Begin
  AllRecipients := TStringList.Create;
  AllRecipients.Text := AHMMessage.RecipientsTo.Text;
  AllRecipients.Text := AllRecipients.Text + AHMMessage.RecipientsCC.Text;
  AllRecipients.Text := AllRecipients.Text + AHMMessage.RecipientsBC.Text;
  AllRecipients.Text := AllRecipients.Text;
  FillChar(myrecips,Sizeof(TMapiRecipDesc) * AllRecipients.Count - 1,0);
  With AHMMessage Do
    For i := 0 To (AllRecipients.Count - 1) Do
    Begin
      If Length(AllRecipients[i]) > 0 Then
      Begin
        MyResult := MAPIResolveName(hSession,0,StrNew(PChar(Copy(AllRecipients[i],1,255))),0,0,@CurrentMapiRecipDesc);
        If ((MyResult = MAPI_E_AMBIGUOUS_RECIPIENT) Or (MyResult = MAPI_E_UNKNOWN_RECIPIENT)) Then
          MyResult := MAPIResolveName(hSession,0,StrNew(PChar(Copy(AllRecipients[i],1,255))),MAPI_DIALOG,0,@CurrentMapiRecipDesc);
        If Not (MyResult <> SUCCESS_SUCCESS) Then
        Begin
          If ((Pos('[',AllRecipients[i]) > 0) And
            (Pos(']',AllRecipients[i]) > 0)) And
            ((StrScan(CurrentMapiRecipDesc.lpszName, '[') = Nil) And
            (StrRScan(CurrentMapiRecipDesc.lpszName, ']') = Nil)) Then
          Begin
            MAPIFreeBuffer(@CurrentMapiRecipDesc);
            With myrecips[I + 1] Do
            Begin
              s := AllRecipients[i];
              Delete(s,Pos(']',s),1);
              Delete(s,Pos('[',s),1);
              If I <= AHMMessage.RecipientsTo.Count Then ulRecipClass := MAPI_TO Else
                If I <= (AHMMessage.RecipientsTo.Count) + (AHMMessage.RecipientsCC.Count) Then
                  ulRecipClass := MAPI_CC Else ulRecipClass := MAPI_BCC;
              lpszAddress := StrNew(PChar(s));
              lpszName := StrNew(PChar(s));
            End;
          End Else
          Begin
            AllRecipients[i] := String(CurrentMapiRecipDesc.lpszName);
            MAPIFreeBuffer(@CurrentMapiRecipDesc);
            With myrecips[I + 1] Do
            Begin
              If I < AHMMessage.RecipientsTo.Count Then ulRecipClass := MAPI_TO Else
                If I < (AHMMessage.RecipientsTo.Count) + (AHMMessage.RecipientsCC.Count) Then
                  ulRecipClass := MAPI_CC Else ulRecipClass := MAPI_BCC;
              lpszName := StrNew(PChar(AllRecipients[i]));
            End;
          End;
        End;
      End;
    End;
  AllRecipients.Free;
  result:=@myrecips;
End;

Constructor TAHMMapiMessage.Create(Collection :TCollection);
Begin
  Inherited Create(Collection);
  FAHMMapiMail := (((Collection As TAHMMapiMessages).GetOwner) As TAHMMapiMail);
  FAHMMapiAttachments := TAHMMapiAttachments.Create(self);
  FMessage := TStringlist.Create;
  FRecipientsTo := TStringList.Create;
  FRecipientsBC := TStringList.Create;
  FRecipientsCC := TStringList.Create;
  FSendSuccess := False;
  FReceipt := False;
End;

Destructor TAHMMapiMessage.Destroy;
Begin
  FAHMMapiAttachments.Free;
  FRecipientsTo.Free;
  FRecipientsBC.Free;
  FRecipientsCC.Free;
  FMessage.Free;
  Inherited Destroy;
End;

Procedure TAHMMapiMessage.SeTAHMMapiAttachments(Value :TAHMMapiAttachments);
Begin
  FAHMMapiAttachments.Assign(Value);
End;

Function TAHMMapiMessage.GetDisplayName :String;
Begin
  Result := AHMRcMailOutgoing;
End;

Procedure TAHMMapiMessage.SetRecipientsTo(Value :TStrings);
Begin
  FRecipientsTo.Assign(Value);
End;

Procedure TAHMMapiMessage.SetRecipientsCC(Value :TStrings);
Begin
  FRecipientsCC.Assign(Value);
End;

Procedure TAHMMapiMessage.SetRecipientsBC(Value :TStrings);
Begin
  FRecipientsBC.Assign(Value);
End;

Procedure TAHMMapiMessage.SetMessage(Value :TStrings);
Begin
  FMessage.Assign(Value);
End;

Function TAHMMapiMessages.GetOwner :TPersistent;
Begin
  Result := FAHMMapiMail;
End;

Constructor TAHMMapiMessages.Create(AOwner :TAHMMapiMail);
Begin
  Inherited Create(TAHMMapiMessage);
  FAHMMapiMail := AOwner;
End;

Function TAHMMapiMessages.Add :TAHMMapiMessage;
Begin
  Result := TAHMMapiMessage(Inherited Add);
End;

Function TAHMMapiMessages.Delete(Index :Integer) :Boolean;
Begin
  result := true;
  If assigned(FAHMMapiMail.FOnDeleteMail) Then
    FAHMMapiMail.FOnDeleteMail(self,Items[Index]);
  Try
    Items[Index].Free;
  Except
    result := false;
    Application.HandleException(self);
  End;
End;

Function TAHMMapiMessages.GetAHMMapiMessage(Index :Integer) :TAHMMapiMessage;
Begin
  Result := TAHMMapiMessage(Inherited GetItem(Index));
End;

Procedure TAHMMapiMessages.SetAHMMapiMessage(Index :Integer;Value :TAHMMapiMessage);
Begin
  Inherited SetItem(Index,Value);
End;

Procedure TAHMMapiMail.SeTAHMMapiMessages(Value :TAHMMapiMessages);
Begin
  FAHMMapiMessages.Assign(Value);
End;

Function TAHMMapiMail.Execute :Boolean;
Begin
  result := false;
  if not(MapiInstalled) then exit;
  If Logon = 0 Then
  Begin
    If Assigned(FBeforeSendAll) Then FBeforeSendAll(Self);
    SendMapi;
    If Assigned(FAfterSendAll) Then FAfterSendAll(Self);
    Logoff;
    result:=True;
  end;
  If Assigned(FAfterExecute) Then FAfterExecute(Self);
End;

Constructor TAHMMapiAttachment.Create(Collection :TCollection);
Begin
  Inherited Create(Collection);
  FAHMMapiMessage := (((Collection As TAHMMapiAttachments).GetOwner) as TAHMMapiMessage);
End;

Function TAHMMapiAttachment.GetDisplayName :String;
Begin
  Result := AHMRcMailAttachment;
End;

Function TAHMMapiAttachments.GetOwner :TPersistent;
Begin
  Result := FAHMMapiMessage;
End;

Constructor TAHMMapiAttachments.Create(AOwner :TAHMMapiMessage);
Begin
  Inherited Create(TAHMMapiAttachment);
  FAHMMapiMessage := AOwner;
End;

Function TAHMMapiAttachments.Add(Filename :String) :TAHMMapiAttachment;
Begin
  Result := TAHMMapiAttachment(Inherited Add);
  Result.Filename := Filename;
End;

Function TAHMMapiAttachments.GeTAHMMapiAttachment(Index :Integer) :TAHMMapiAttachment;
Begin
  Result := TAHMMapiAttachment(Inherited GetItem(Index));
End;

Procedure TAHMMapiAttachments.SeTAHMMapiAttachment(Index :Integer;Value :TAHMMapiAttachment);
Begin
  Inherited SetItem(Index,Value);
End;

Procedure InitializeSMAPI;
Var
  OldErrorMode :word;
  OSVersionInfo :TOSVersionInfo;
  RegHandle :HKey;
  MapiDetectBuf :Array[0..8] Of char;
  MapiDetectBufSize :integer;
  RegValueType :integer;
Begin
  OSVersionInfo.dwOSVersionInfoSize := SizeOf(OSVersionInfo);
  GetVersionEx(OSVersionInfo);
  If (OSVersionInfo.dwMajorVersion > 3) Or
    ((OSVersionInfo.dwMajorVersion = 3) And (OSVersionInfo.dwMinorVersion > 51)) Then
  Begin
    If RegOpenKeyEx(HKEY_LOCAL_MACHINE, PChar(AHMRcMailSub1),
      0,KEY_READ,RegHandle) <> ERROR_SUCCESS Then exit;

    MAPIDetectBufSize := SizeOf(MAPIDetectBuf);
    If RegQueryValueEx(RegHandle, PChar(AHMRcMailMapiStr),Nil,@RegValueType,@MAPIDetectBuf,@MAPIDetectBufSize) <> ERROR_SUCCESS Then exit;
    RegCloseKey(RegHandle);
    If Not ((MAPIDetectBuf[0] = '1') And (MAPIDetectBuf[1] = #0)) Then exit;
  End Else
    If GetProfileInt(Pchar(AHMRcMailStr), PChar(AHMRcMailMapiStr),0) = 0 Then Exit;
  OldErrorMode := SetErrorMode(SEM_FAILCRITICALERRORS + SEM_NOOPENFILEERRORBOX);
  DLLHandle := LoadLibrary(PChar(Copy(AHMRcMailMapiDLL,1,Pos('.',AHMRcMailMapiDLL)-1)));
  SetErrorMode(OldErrorMode);
  If DLLHandle = 0 Then
  Begin
    OldErrorMode := SetErrorMode(SEM_FAILCRITICALERRORS + SEM_NOOPENFILEERRORBOX);
    Try
      DLLHandle := LoadLibrary(PChar(AHMRcMailMapiDLL));
      If DLLHandle = 0 Then exit;
    Finally
      SetErrorMode(OldErrorMode);
    End;
  End;
  Begin
    DLLinitialized := true;
    @AHMMAPIFindNext := GetProcAddress(DLLHandle,Pchar(AHMRcMailMAPIFindNext));
    @AHMMAPILogoff := GetProcAddress(DLLHandle,Pchar(AHMRcMailMAPILogoff));
    @AHMMAPILogon := GetProcAddress(DLLHandle,Pchar(AHMRcMailMAPILogon));
    @AHMMAPISendMail := GetProcAddress(DLLHandle,Pchar(AHMRcMailMAPISendMail));
    @AHMMAPIReadMail := GetProcAddress(DLLHandle,Pchar(AHMRcMailMAPIReadMail));
    @AHMMAPIDeleteMail := GetProcAddress(DLLHandle,Pchar(AHMRcMailMAPIDeleteMail));
    @AHMMAPIResolveName := GetProcAddress(DLLHandle,Pchar(AHMRcMailMAPIResolveName));
    @AHMMAPIFreeBuffer := GetProcAddress(DLLHandle,Pchar(AHMRcMailMAPIFreeBuffer));
    @AHMMAPIAddress := GetProcAddress(DLLHandle,Pchar(AHMRcMailMAPIAddress));
    @AHMMAPISaveMail := GetProcAddress(DLLHandle,Pchar(AHMRcMailMAPISaveMail));
    If (@AHMMAPIAddress = Nil) Or (@AHMMAPIFreeBuffer = Nil) Or (@AHMMAPIResolveName = Nil)
      Or (@AHMMAPIDeleteMail = Nil) Or (@AHMMAPIReadMail = Nil) Or (@AHMMAPISendMail = Nil)
      Or (@AHMMAPILogon = Nil) Or (@AHMMAPILogoff = Nil) Or (@AHMMAPIFindNext = Nil)
      Or (@AHMMAPISaveMail = Nil) Then Raise TAHMExceptDllerror.Create(AHMRcMailMapiGetProcAdressFailed);
  End;
End;

Procedure FinalizeSMAPI;Far;
Begin
  If DLLinitialized Then FreeLibrary(DLLHandle);
End;

Initialization
  DLLinitialized := false;
  DLLHandle := 0;
  InitializeSMAPI;

Finalization
  FinalizeSMAPI;

End.

