jclmapi.pas

East make Tray Icon in delphi

{**************************************************************************************************}
{                                                                                                  }
{ Project JEDI Code Library (JCL)                                                                  }
{                                                                                                  }
{ The contents of this file are subject to the Mozilla Public License Version 1.1 (the "License"); }
{ you may not use this file except in compliance with the License. You may obtain a copy of the    }
{ License at http://www.mozilla.org/MPL/                                                           }
{                                                                                                  }
{ Software distributed under the License is distributed on an "AS IS" basis, WITHOUT WARRANTY OF   }
{ ANY KIND, either express or implied. See the License for the specific language governing rights  }
{ and limitations under the License.                                                               }
{                                                                                                  }
{ The Original Code is JclMapi.pas.                                                                }
{                                                                                                  }
{ The Initial Developer of the Original Code is Petr Vones.                                        }
{ Portions created by Petr Vones are Copyright (C) Petr Vones. All Rights Reserved.                }
{                                                                                                  }
{ Contributors:                                                                                    }
{   Marcel van Brakel                                                                              }
{   Robert Marquardt (marquardt)                                                                   }
{   Matthias Thoma (mthoma)                                                                        }
{   Petr Vones (pvones)                                                                            }
{                                                                                                  }
{**************************************************************************************************}
{                                                                                                  }
{ Various classes and support routines for sending e-mail through Simple MAPI                      }
{                                                                                                  }
{ Unit owner: Petr Vones                                                                           }
{                                                                                                  }
{**************************************************************************************************}

// Last modified: $Date: 2005/03/08 08:33:22 $
// For history see end of file

unit JclMapi;     

{$I jcl.inc}

interface

uses
  Windows, Classes, Contnrs, Mapi, SysUtils,
  JclBase;

type
  EJclMapiError = class(EJclError)
  private
    FErrorCode: DWORD;
  public
    property ErrorCode: DWORD read FErrorCode;
  end;

  // Simple MAPI interface
  TJclMapiClient = record
    ClientName: string;
    ClientPath: string;
    RegKeyName: string;
    Valid: Boolean;
  end;

  TJclMapiClientConnect = (ctAutomatic, ctMapi, ctDirect);
                   
  TJclSimpleMapi = class(TObject)
  private
    FAnyClientInstalled: Boolean;
    FBeforeUnloadClient: TNotifyEvent;
    FClients: array of TJclMapiClient;
    FClientConnectKind: TJclMapiClientConnect;
    FClientLibHandle: THandle;
    FDefaultClientIndex: Integer;
    FDefaultProfileName: string;
    FFunctions: array[0..11] of ^Pointer;
    FMapiInstalled: Boolean;
    FMapiVersion: string;
    FProfiles: array of string;
    FSelectedClientIndex: Integer;
    FSimpleMapiInstalled: Boolean;
    { TODO : consider to move this to a internal single instance class with smart linking }
    FMapiAddress: TFNMapiAddress;
    FMapiDeleteMail: TFNMapiDeleteMail;
    FMapiDetails: TFNMapiDetails;
    FMapiFindNext: TFNMapiFindNext;
    FMapiFreeBuffer: TFNMapiFreeBuffer;
    FMapiLogOff: TFNMapiLogOff;
    FMapiLogOn: TFNMapiLogOn;
    FMapiReadMail: TFNMapiReadMail;
    FMapiResolveName: TFNMapiResolveName;
    FMapiSaveMail: TFNMapiSaveMail;
    FMapiSendDocuments: TFNMapiSendDocuments;
    FMapiSendMail: TFNMapiSendMail;
    function GetClientCount: Integer;
    function GetClients(Index: Integer): TJclMapiClient;
    function GetCurrentClientName: string;
    function GetProfileCount: Integer;
    function GetProfiles(Index: Integer): string;
    procedure SetSelectedClientIndex(const Value: Integer);
    procedure SetClientConnectKind(const Value: TJclMapiClientConnect);
    function UseMapi: Boolean;
  protected
    procedure BeforeUnloadClientLib; dynamic;
    procedure CheckListIndex(I, ArrayLength: Integer);
    function GetClientLibName: string;
    class function ProfilesRegKey: string;
    procedure ReadMapiSettings;
  public
    constructor Create;
    destructor Destroy; override;
    function ClientLibLoaded: Boolean;
    procedure LoadClientLib;
    procedure UnloadClientLib;
    property AnyClientInstalled: Boolean read FAnyClientInstalled;
    property ClientConnectKind: TJclMapiClientConnect read FClientConnectKind write SetClientConnectKind;
    property ClientCount: Integer read GetClientCount;
    property Clients[Index: Integer]: TJclMapiClient read GetClients; default;
    property CurrentClientName: string read GetCurrentClientName;
    property DefaultClientIndex: Integer read FDefaultClientIndex;
    property DefaultProfileName: string read FDefaultProfileName;
    property MapiInstalled: Boolean read FMapiInstalled;
    property MapiVersion: string read FMapiVersion;
    property ProfileCount: Integer read GetProfileCount;
    property Profiles[Index: Integer]: string read GetProfiles;
    property SelectedClientIndex: Integer read FSelectedClientIndex write SetSelectedClientIndex;
    property SimpleMapiInstalled: Boolean read FSimpleMapiInstalled;
    property BeforeUnloadClient: TNotifyEvent read FBeforeUnloadClient write FBeforeUnloadClient;
    // Simple MAPI functions
    property MapiAddress: TFNMapiAddress read FMapiAddress;
    property MapiDeleteMail: TFNMapiDeleteMail read FMapiDeleteMail;
    property MapiDetails: TFNMapiDetails read FMapiDetails;
    property MapiFindNext: TFNMapiFindNext read FMapiFindNext;
    property MapiFreeBuffer: TFNMapiFreeBuffer read FMapiFreeBuffer;
    property MapiLogOff: TFNMapiLogOff read FMapiLogOff;
    property MapiLogOn: TFNMapiLogOn read FMapiLogOn;
    property MapiReadMail: TFNMapiReadMail read FMapiReadMail;
    property MapiResolveName: TFNMapiResolveName read FMapiResolveName;
    property MapiSaveMail: TFNMapiSaveMail read FMapiSaveMail;
    property MapiSendDocuments: TFNMapiSendDocuments read FMapiSendDocuments;
    property MapiSendMail: TFNMapiSendMail read FMapiSendMail;
  end;

const
  // Simple email classes
  MapiAddressTypeSMTP = 'SMTP';
  MapiAddressTypeFAX  = 'FAX';
  MapiAddressTypeTLX  = 'TLX';

type
  TJclEmailRecipKind = (rkOriginator, rkTO, rkCC, rkBCC);

  TJclEmailRecip = class(TObject)
  private
    FAddress: string;
    FAddressType: string;
    FKind: TJclEmailRecipKind;
    FName: string;
  protected
    function SortingName: string;
  public
    function AddressAndName: string;
    class function RecipKindToString(const AKind: TJclEmailRecipKind): string;
    property AddressType: string read FAddressType write FAddressType;
    property Address: string read FAddress write FAddress;
    property Kind: TJclEmailRecipKind read FKind write FKind;
    property Name: string read FName write FName;
  end;

  TJclEmailRecips = class(TObjectList)
  private
    FAddressesType: string;
    function GetItems(Index: Integer): TJclEmailRecip;
    function GetOriginator: TJclEmailRecip;
  public
    function Add(const Address: string;
      const Name: string = '';
      const Kind: TJclEmailRecipKind = rkTO;
      const AddressType: string = ''): Integer;
    procedure SortRecips;
    property AddressesType: string read FAddressesType write FAddressesType;
    property Items[Index: Integer]: TJclEmailRecip read GetItems; default;
    property Originator: TJclEmailRecip read GetOriginator;
  end;

  TJclEmailFindOption = (foFifo, foUnreadOnly);
  TJclEmailLogonOption = (loLogonUI, loNewSession, loForceDownload);
  TJclEmailReadOption = (roAttachments, roHeaderOnly, roMarkAsRead);

  TJclEmailFindOptions = set of TJclEmailFindOption;
  TJclEmailLogonOptions = set of TJclEmailLogonOption;
  TJclEmailReadOptions = set of TJclEmailReadOption;

  TJclEmailReadMsg = record
    ConversationID: string;
    DateReceived: TDateTime;
    MessageType: string;
    Flags: FLAGS;
  end;

  TJclTaskWindowsList = array of HWND;

  TJclEmail = class(TJclSimpleMapi)
  private
    FAttachments: TStringList;
    FBody: string;
    FFindOptions: TJclEmailFindOptions;
    FHtmlBody: Boolean;
    FLogonOptions: TJclEmailLogonOptions;
    FParentWnd: HWND;
    FParentWndValid: Boolean;
    FReadMsg: TJclEmailReadMsg;
    FRecipients: TJclEmailRecips;
    FSeedMessageID: string;
    FSessionHandle: THandle;
    FSubject: string;
    FTaskWindowList: TJclTaskWindowsList;
    function GetAttachments: TStrings;
    function GetParentWnd: HWND;
    function GetUserLogged: Boolean;
    procedure SetBody(const Value: string);
    procedure SetParentWnd(const Value: HWND);
  protected
    procedure BeforeUnloadClientLib; override;
    procedure DecodeRecips(RecipDesc: PMapiRecipDesc; Count: Integer);
    function InternalSendOrSave(Save: Boolean; ShowDialog: Boolean): Boolean;
    function LogonOptionsToFlags(ShowDialog: Boolean): DWORD;
  public
    constructor Create;
    destructor Destroy; override;
    function Address(const Caption: string = ''; EditFields: Integer = 3): Boolean;
    procedure Clear;
    function Delete(const MessageID: string): Boolean;
    function FindFirstMessage: Boolean;
    function FindNextMessage: Boolean;
    procedure LogOff;
    procedure LogOn(const ProfileName: string = ''; const Password: string = '');
    function MessageReport(Strings: TStrings; MaxWidth: Integer = 80; IncludeAddresses: Boolean = False): Integer;
    function Read(const Options: TJclEmailReadOptions = []): Boolean;
    function ResolveName(var Name, Address: string; ShowDialog: Boolean = False): Boolean;
    procedure RestoreTaskWindows;
    function Save: Boolean;
    procedure SaveTaskWindows;
    function Send(ShowDialog: Boolean = True): Boolean;
    procedure SortAttachments;
    property Attachments: TStrings read GetAttachments;
    property Body: string read FBody write SetBody;
    property FindOptions: TJclEmailFindOptions read FFindOptions write FFindOptions;
    property HtmlBody: Boolean read FHtmlBody write FHtmlBody;
    property LogonOptions: TJclEmailLogonOptions read FLogonOptions write FLogonOptions;
    property ParentWnd: HWND read GetParentWnd write SetParentWnd;
    property ReadMsg: TJclEmailReadMsg read FReadMsg;
    property Recipients: TJclEmailRecips read FRecipients;
    property SeedMessageID: string read FSeedMessageID write FSeedMessageID;
    property SessionHandle: THandle read FSessionHandle;
    property Subject: string read FSubject write FSubject;
    property UserLogged: Boolean read GetUserLogged;
  end;

// Simple email send function
function JclSimpleSendMail(const Recipient, Name, Subject, Body: string;
  const Attachment: string = ''; ShowDialog: Boolean = True; ParentWND: HWND = 0;
  const ProfileName: string = ''; const Password: string = ''): Boolean;

function JclSimpleSendFax(const Recipient, Name, Subject, Body: string;
  const Attachment: string = ''; ShowDialog: Boolean = True; ParentWND: HWND = 0;
  const ProfileName: string = ''; const Password: string = ''): Boolean;

function JclSimpleBringUpSendMailDialog(const Subject, Body: string;
  const Attachment: string = ''; ParentWND: HWND = 0;
  const ProfileName: string = ''; const Password: string = ''): Boolean;

// MAPI Errors
function MapiCheck(const Res: DWORD; IgnoreUserAbort: Boolean = True): DWORD;

function MapiErrorMessage(const ErrorCode: DWORD): string;

implementation

uses
  JclFileUtils, JclLogic, JclRegistry, JclResources, JclStrings, JclSysInfo, JclSysUtils;

const
  MapiDll = 'mapi32.dll';
  MapiExportNames: array [0..11] of PChar = (
    'MAPIAddress',
    'MAPIDeleteMail',
    'MAPIDetails',
    'MAPIFindNext',
    'MAPIFreeBuffer',
    'MAPILogoff',
    'MAPILogon',
    'MAPIReadMail',
    'MAPIResolveName',
    'MAPISaveMail',
    'MAPISendDocuments',
    'MAPISendMail');
  AddressTypeDelimiter = ':';

//=== MAPI Errors check ======================================================

function MapiCheck(const Res: DWORD; IgnoreUserAbort: Boolean): DWORD;
var
  Error: EJclMapiError;
begin
  if (Res = SUCCESS_SUCCESS) or (IgnoreUserAbort and (Res = MAPI_E_USER_ABORT)) then
    Result := Res
  else
  begin
    Error := EJclMapiError.CreateResFmt(@RsMapiError, [Res, MapiErrorMessage(Res)]);
    Error.FErrorCode := Res;
    raise Error;
  end;
end;

function MapiErrorMessage(const ErrorCode: DWORD): string;
begin   
   case ErrorCode of
     MAPI_E_USER_ABORT:
       Result := RsMapiErrUSER_ABORT;
     MAPI_E_FAILURE:
       Result := RsMapiErrFAILURE;
     MAPI_E_LOGIN_FAILURE:   
       Result := RsMapiErrLOGIN_FAILURE;   
     MAPI_E_DISK_FULL:   
       Result := RsMapiErrDISK_FULL;   
     MAPI_E_INSUFFICIENT_MEMORY:   
       Result := RsMapiErrINSUFFICIENT_MEMORY;   
     MAPI_E_ACCESS_DENIED:   
       Result := RsMapiErrACCESS_DENIED;   
     MAPI_E_TOO_MANY_SESSIONS:   
       Result := RsMapiErrTOO_MANY_SESSIONS;   
     MAPI_E_TOO_MANY_FILES:   
       Result := RsMapiErrTOO_MANY_FILES;   
     MAPI_E_TOO_MANY_RECIPIENTS:   
       Result := RsMapiErrTOO_MANY_RECIPIENTS;   
     MAPI_E_ATTACHMENT_NOT_FOUND:   
       Result := RsMapiErrATTACHMENT_NOT_FOUND;   
     MAPI_E_ATTACHMENT_OPEN_FAILURE:   
       Result := RsMapiErrATTACHMENT_OPEN_FAILURE;   
     MAPI_E_ATTACHMENT_WRITE_FAILURE:   
       Result := RsMapiErrATTACHMENT_WRITE_FAILURE;   
     MAPI_E_UNKNOWN_RECIPIENT:   
       Result := RsMapiErrUNKNOWN_RECIPIENT;   
     MAPI_E_BAD_RECIPTYPE:   
       Result := RsMapiErrBAD_RECIPTYPE;   
     MAPI_E_NO_MESSAGES:   
       Result := RsMapiErrNO_MESSAGES;   
     MAPI_E_INVALID_MESSAGE:   
       Result := RsMapiErrINVALID_MESSAGE;   
     MAPI_E_TEXT_TOO_LARGE:   
       Result := RsMapiErrTEXT_TOO_LARGE;   
     MAPI_E_INVALID_SESSION:   
       Result := RsMapiErrINVALID_SESSION;   
     MAPI_E_TYPE_NOT_SUPPORTED:   
       Result := RsMapiErrTYPE_NOT_SUPPORTED;   
     MAPI_E_AMBIGUOUS_RECIPIENT:   
       Result := RsMapiErrAMBIGUOUS_RECIPIENT;   
     MAPI_E_MESSAGE_IN_USE:   
       Result := RsMapiErrMESSAGE_IN_USE;   
     MAPI_E_NETWORK_FAILURE:   
       Result := RsMapiErrNETWORK_FAILURE;   
     MAPI_E_INVALID_EDITFIELDS:   
       Result := RsMapiErrINVALID_EDITFIELDS;   
     MAPI_E_INVALID_RECIPS:   
       Result := RsMapiErrINVALID_RECIPS;   
     MAPI_E_NOT_SUPPORTED:   
       Result := RsMapiErrNOT_SUPPORTED;   
   else
     Result := '';
   end;
end;

procedure RestoreTaskWindowsList(const List: TJclTaskWindowsList);
var
  I: Integer;

  function RestoreTaskWnds(Wnd: HWND; List: TJclTaskWindowsList): BOOL; stdcall;
  var
    I: Integer;
    EnableIt: Boolean;
  begin
    if IsWindowVisible(Wnd) then
    begin
      EnableIt := False;
      for I := 1 to Length(List) - 1 do
        if List[I] = Wnd then
        begin
          EnableIt := True;
          Break;
        end;
      EnableWindow(Wnd, EnableIt);
    end;
    Result := True;
  end;

begin
  if Length(List) > 0 then
  begin
    EnumThreadWindows(MainThreadID, @RestoreTaskWnds, Integer(List));
    for I := 0 to Length(List) - 1 do
      EnableWindow(List[I], True);
    SetFocus(List[0]);
  end;
end;

function SaveTaskWindowsList: TJclTaskWindowsList;

  function SaveTaskWnds(Wnd: HWND; var Data: TJclTaskWindowsList): BOOL; stdcall;
  var
    C: Integer;
  begin
    if IsWindowVisible(Wnd) and IsWindowEnabled(Wnd) then
    begin
      C := Length(Data);
      SetLength(Data, C + 1);
      Data[C] := Wnd;
    end;
    Result := True;
  end;

begin
  SetLength(Result, 1);
  Result[0] := GetFocus;
  EnumThreadWindows(MainThreadID, @SaveTaskWnds, Integer(@Result));
end;

//=== { TJclSimpleMapi } =====================================================

constructor TJclSimpleMapi.Create;
begin
  inherited Create;
  FFunctions[0] := @@FMapiAddress;
  FFunctions[1] := @@FMapiDeleteMail;
  FFunctions[2] := @@FMapiDetails;
  FFunctions[3] := @@FMapiFindNext;
  FFunctions[4] := @@FMapiFreeBuffer;
  FFunctions[5] := @@FMapiLogOff;
  FFunctions[6] := @@FMapiLogOn;
  FFunctions[7] := @@FMapiReadMail;
  FFunctions[8] := @@FMapiResolveName;
  FFunctions[9] := @@FMapiSaveMail;
  FFunctions[10] := @@FMapiSendDocuments;
  FFunctions[11] := @@FMapiSendMail;
  FDefaultClientIndex := -1;