Development

unit MainUnit;

(*
  Since we were asked how one can visualize the AddressBook integrated into
  Outlook AddressBook and the GAL provided by Exchange Server,
  we developed this small example. With it we will start our new
  section "Applications upon request".

  MAPI provides 2 types of inbuilt address dialog boxes - modal and non-modal.
  It also provides a dialog box for entering new e-mail addresses - New Entry dialog box.

  In our example we will review the first two.

  You may find more information on
  http://msdn.microsoft.com/library/default.asp?url=/library/en-us/mapi/html/72b0dd95-eaf1-4a4c-ab84-71d99535ee50.asp

  of course we will not comment on any program code that was used in the previous examples
*)

interface

{ Please add "..\Library" to project search path }

{$I IMI.INC}

uses
  Classes, Controls, Forms, Buttons, ExtCtrls, ExtendedMAPI, ComCtrls, StdCtrls;

type
  TfrmMain = class(TForm)
    plTOP: TPanel;
    btLogOn: TSpeedButton;
    rgProfile: TRadioGroup;
    btLogOff: TSpeedButton;
    lwUser: TListView;
    Panel1: TPanel;
    sbShowAddressBook1: TSpeedButton;
    sbShowAddressBook2: TSpeedButton;
    procedure FormCreate(Sender: TObject);
    procedure btLogOnClick(Sender: TObject);
    procedure btLogOffClick(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure sbShowAddressBook2Click(Sender: TObject);
    procedure sbShowAddressBook1Click(Sender: TObject);
  private
    { Private declarations }
    FMapiSession: IMAPISession;
    // MAPI Session variable -> Interface IMAPISession
    FUserProp: IMAPIProp;
    hr: HRESULT; // MAPI Finction return HRESULT

    procedure InitializeMAPI;
    procedure MAPILocalInit(Flag: cardinal);
    procedure MapiInternalLogOff;
    procedure ItIsMe;
    procedure ShowAddressBook(Value: integer);
  public
    { Public declarations }
  end;

var
  frmMain: TfrmMain;

implementation

uses
{$IFDEF DELPHI2011XE2}
UITypes,
{$ENDIF}
SysUtils, Windows, Variants, Dialogs, MAPIMacros, EDK, MAPIUtils,
  MAPIVariantProp, SecondUnit;

{$R *.DFM}

procedure TfrmMain.InitializeMAPI;
begin
  FUserProp := nil;
  FMapiSession := nil;
end;

procedure TfrmMain.MAPILocalInit(Flag: cardinal);
begin
  hr := MAPILogonEx(Application.Handle, nil, nil, MAPI_EXTENDED or
    MAPI_NEW_SESSION or MAPI_NO_MAIL or MAPI_ALLOW_OTHERS or Flag, 
FMapiSession);

  if hr <> S_OK then
  begin
    case hr of
      MAPI_E_LOGON_FAILED:
        MessageDlg
          (WrapText(
          'The logon did not succeed, either because one or more of the parameters to Profile were invalid or because there were too many sessions open already.',
          80), mtError, [mbOK], 0);
      MAPI_E_TIMEOUT:
        MessageDlg
          (WrapText(
          'MAPI serializes all logons through a mutex. This is returned if the another thread held the mutex.',
          80), mtError, [mbOK], 0);
      MAPI_E_USER_CANCEL:
        ShowMessage
          (WrapText(
          'The user canceled the operation, typically by choosing the Cancel button in a dialog box.',
          80));
      MAPI_E_TOO_MANY_SESSIONS:
        MessageDlg
          (WrapText(
          'The user had too many sessions open simultaneously. No session handle was returned.',
          80), mtError, [mbOK], 0);
      MAPI_E_UNCONFIGURED:
        MessageDlg
          (WrapText(
          'A service provider has not been configured, and therefore the operation did not complete.',
          80), mtError, [mbOK], 0);
    else
      MessageDlg(WrapText('The logon did not succeed', 80), mtError, [mbOK], 0);
    end;
  end;

  btLogOn.Enabled := not Assigned(FMapiSession);
  btLogOff.Enabled := Assigned(FMapiSession);
  if ((btLogOff.Enabled) and Assigned(FMapiSession)) then
    ItIsMe;
end;

procedure TfrmMain.FormCreate(Sender: TObject);
var
  QMess: string;
  MAPIINIT: TMAPIINIT;
begin
  InitializeMAPI;
{$IF DEFINED (WIN64)}
  Self.Caption := Self.Caption + ' - WIN64';
{$ELSE}
  Self.Caption := Self.Caption + ' - WIN32';
{$IFEND}
  MAPIINIT.ulVersion := MAPI_INIT_VERSION;
  MAPIINIT.ulFlags := 0;

  hr := MapiInitialize(@MAPIINIT);

  if hr <> S_OK then
  begin
    case hr of
      MAPI_E_INVALID_PARAMETER or MAPI_E_UNKNOWN_FLAGS:
        QMess := 'Invalid parameter or flag!';
      MAPI_E_TOO_COMPLEX:
        QMess := 'The keys required by MAPI could not be initialized.';
      MAPI_E_VERSION:
        QMess := 'The version of OLE installed on the workstation is not compatible with this version of MAPI.';
      MAPI_E_SESSION_LIMIT:
        QMess := 'MAPI sets up context specific to the current process.' + #13 +
          'Failures may occur on Win16 if the number of processes exceeds a certain number,'
          + #13 + 'or on any system if available memory is exhausted.';
      MAPI_E_NOT_ENOUGH_RESOURCES:
        QMess := 'Not enough system resources were available to complete the operation.';
      MAPI_E_INVALID_OBJECT:
        QMess := 'May fail if system resources are exhausted.';
      MAPI_E_NOT_INITIALIZED:
        QMess := 'The MAPI profile provider has encountered an error.';
    else
      QMess := 'The MAPI Error!'
    end;
    raise Exception.Create(QMess);
  end;
end;

procedure TfrmMain.MapiInternalLogOff;
begin
  lwUser.Items.BeginUpdate;
  lwUser.Items.Clear;
  lwUser.Items.EndUpdate;
  lwUser.Repaint;

  if Assigned(FUserProp) then
    FUserProp := nil;

  if Assigned(FMapiSession) then
  begin
    FMapiSession.Logoff(Application.Handle, MAPI_LOGOFF_UI, 0);
    FMapiSession := nil;
  end;
end;

procedure TfrmMain.btLogOnClick(Sender: TObject);
begin
  case rgProfile.ItemIndex of
    0:
      MAPILocalInit(MAPI_USE_DEFAULT or MAPI_PASSWORD_UI);
    1:
      MAPILocalInit(MAPI_LOGON_UI);
  end;
end;

procedure TfrmMain.btLogOffClick(Sender: TObject);
begin
  MapiInternalLogOff;
  btLogOn.Enabled := True;
  btLogOff.Enabled := False;
end;

procedure TfrmMain.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  MapiInternalLogOff;
  MAPIUninitialize;
end;

procedure TfrmMain.ItIsMe;
var
  UserPropTagArray: PSPropTagArray;
  UserPropValue: PSPropValue;
  Count, Values: ULONG;
  ListItem: TListItem;
  Save_Cursor: TCursor;
  strTemp: string;
  _iCount: integer;
  FTempVariant: variant;

begin
  // We take the current screen cursor and we save it so that we can restore it,
  // after that procedure has used it
  Save_Cursor := Screen.Cursor;
  Screen.Cursor := crHourGlass;

  // Clearing IMAPIProp
  FUserProp := nil;
  try
    // We take  IMAPIProp interface for the user who has logged into the session
    hr := HrOpenSessionObject(FMapiSession, FUserProp);

    if failed(hr) then
    begin
      MessageDlg(GetMAPIError(FMapiSession, hr), mtError, [mbOK], 0);
      exit;
    end;

    Values := 0;
    UserPropTagArray := nil;

    hr := FUserProp.GetPropList(fMapiUnicode, UserPropTagArray);

    if Assigned(UserPropTagArray) then
      Values := UserPropTagArray.cValues;

    if failed(hr) or (Values = 0) then
    begin
      MessageDlg(GetMAPIError(FUserProp, hr), mtError, [mbOK], 0);
      exit;
    end;

    UserPropValue := nil;

    hr := FUserProp.GetProps(UserPropTagArray, fMapiUnicode, Values,
      UserPropValue);

    if (failed(hr) or (Values = 0) or (UserPropValue = nil)) then
    begin
      MessageDlg(GetMAPIError(FUserProp, hr), mtError, [mbOK], 0);
      exit;
    end;

    for Count := 0 to Values - 1 do
    begin
      ListItem := lwUser.Items.Add;
      ListItem.Caption := SzGetPropTag(PSPropValueArray(UserPropValue)
        [Count].ulPropTag);

      case PROP_TYPE(PSPropValueArray(UserPropValue)[Count].ulPropTag) of
        PT_SHORT, PT_LONG, PT_FLOAT, PT_DOUBLE, PT_BOOLEAN, PT_APPTIME,
          PT_SYSTIME, PT_STRING8, PT_UNICODE:
          begin
            ListItem.SubItems.Add(SzGetPropType(PSPropValueArray(UserPropValue)
              [Count].ulPropTag));
            ListItem.SubItems.Add
              (ConvertMAPIPropValueToVariant
              (@PSPropValueArray(UserPropValue)[Count]));
          end;
        PT_BINARY:
          begin
            ListItem.SubItems.Add(SzGetPropType(PSPropValueArray(UserPropValue)
              [Count].ulPropTag));
            strTemp := '';
            FTempVariant := ConvertMAPIPropValueToVariant
              (@PSPropValueArray(UserPropValue)[Count]);
            for _iCount := 0 to VarArrayHighBound(FTempVariant, 1) do
              strTemp := strTemp + ' ' +
                IntToHex(byte(FTempVariant[_iCount]), 2);
            strTemp := 'cb:' + IntToStr(VarArrayHighBound(FTempVariant, 1) + 1)
              + ', lpb:' + Trim(strTemp);
            ListItem.SubItems.Add(Trim(strTemp));
          end;
        PT_MV_STRING8, PT_MV_UNICODE:
          begin
            FTempVariant := ConvertMAPIPropValueToVariant
              (@PSPropValueArray(UserPropValue)[Count]);
            for _iCount := 0 to VarArrayHighBound(FTempVariant, 1) do
            begin
              if _iCount > 0 then
              begin
                ListItem := lwUser.Items.Add;
                ListItem.Caption := SzGetPropTag(PSPropValueArray(UserPropValue)
                  [Count].ulPropTag);
              end;
              ListItem.SubItems.Add
                (SzGetPropType(PSPropValueArray(UserPropValue)
                [Count].ulPropTag));
              ListItem.SubItems.Add(FTempVariant[_iCount]);
            end;
          end
      else
        begin
          ListItem.SubItems.Add(SzGetPropType(PSPropValueArray(UserPropValue)
            [Count].ulPropTag) + ' - Not implemented');
          ListItem.SubItems.Add('A MAPI Value');
        end
      end;

    end;

  finally
    if Assigned(UserPropTagArray) then
      MAPIFreeBuffer(UserPropTagArray);
    if Assigned(UserPropValue) then
      MAPIFreeBuffer(UserPropValue);
    Screen.Cursor := Save_Cursor;
    sbShowAddressBook1.Enabled := True;
    sbShowAddressBook2.Enabled := True;
  end;
end;

procedure TfrmMain.ShowAddressBook(Value: integer);
type
  ArrayDestTitles = array [0 .. 2] of PChar;
  ArrayDestComps = array [0 .. 2] of ULONG;

var
  AddressBook: IAddrBook;
  AddressDialogBoxParameters: TADRPARM;
  AddressListRecipientsProperties: PADRLIST;
  UIParam: ULONG_PTR;
  RecipientsProperties: TADRENTRY;
  DestTitles: ArrayDestTitles;
  DestComps: ArrayDestComps;
  TempString: string;
  iCount, jCount: integer;

begin
  AddressBook := nil;

  try
    hr := FMapiSession.OpenAddressBook(Self.Handle, nil, 0, AddressBook);
    if failed(hr) then
    begin
      MessageDlg(GetMAPIError(FMapiSession, hr), mtError, [mbOK], 0);
      exit;
    end;

    // TADRPARM
    // The TADRPARM structure describes the display and behavior of the common address dialog box.

    ZeroMemory(@AddressDialogBoxParameters, SizeOf(TADRPARM));

    // The following comments are according to MSDN

    // cbABContEntryID
    // Count of bytes in the entry identifier pointed to by lpABContEntryID
    AddressDialogBoxParameters.cbABContEntryID := 0;

    // lpABContEntryID
    // Pointer to the entry identifier of the container that initially supplies
    // the list of recipient addresses that are displayed in the address dialog box.
    AddressDialogBoxParameters.lpABContEntryID := nil;

    // ulFlags
    // Bitmask of flags associated with various address dialog box options.
    (*
      The following flags can be set:
      AB_RESOLVE
      Causes all names to be resolved after the address dialog box is closed.
      If there are ambiguous entries resulting from the name resolution process,
      a dialog box is displayed to prompt the user for help in resolving them.
      Setting this flag guarantees that all of the names returned
      by IAddrBook.Address are resolved.
      AB_SELECTONLY
      Disables the creation of one-off addresses for a recipient list.
      This flag is used only if the dialog box is modal, as indicated by
      the DIALOG_MODAL flag being set.
      ADDRESS_ONE
      The user can select exactly one recipient instead of multiple recipients
      from a list. This flag is valid only when cDestFields is zero and
      the dialog box is modal, as indicated by the DIALOG_MODAL flag being set.
      DIALOG_MODAL
      Causes the modal version of the common address dialog box to be displayed.
      Either this flag or DIALOG_SDI should be set; they cannot both be set.
      DIALOG_OPTIONS
      Causes the Send Options button to be displayed on the dialog box.
      This flag is used only if the dialog box is modal,
      as indicated by the DIALOG_MODAL flag being set.
      DIALOG_SDI
      Causes the modeless version of the common address dialog box to be displayed.
      Either this flag or DIALOG_MODAL should be set; they cannot both be set.
    *)

    AddressDialogBoxParameters.ulFlags := 0;

    // lpReserved
    // Reserved, must be nil.
    AddressDialogBoxParameters.lpReserved := nil;

    // ulHelpContext
    // Specifies the context within Help that will first be shown when the user
    // clicks the Help button in the address dialog box.
    AddressDialogBoxParameters.ulHelpContext := 0;

    // lpszHelpFileName
    // Pointer to the name of a Help file that will be associated with
    // the address dialog box. The lpszHelpFileName member is used in conjunction
    // with ulHelpContext to call the Windows WinHelp function.
    AddressDialogBoxParameters.lpszHelpFileName := nil;

    // lpfnABSDI
    // Pointer to a MAPI function based on the ACCELERATEABSDI prototype or nil.
    // This member applies to the modeless version of the dialog box only,
    // as indicated by the DIALOG_SDI flag being set.
    (*
      Clients building an ADRPARM structure to pass to IAddrBook.Address must always
      set the lpfnABSDI member to NULL. If the DIALOG_SDI flag is set,
      MAPI will then set it to a valid function before returning.
      Clients call this function from within their message loop to ensure
      that accelerators in the address book dialog box work.
      When the dialog box is dismissed and MAPI calls the function pointed
      to by the lpfnDismiss member, clients should unhook
      the ACCELERATEABSDI function from their message loop.
    *)
    AddressDialogBoxParameters.lpfnABSDI := nil;

    // lpfnDismiss
    (*
      Pointer to a function based on the DISMISSMODELESS prototype or nol.
      This member applies only to the modeless version of the dialog box only,
      as indicated by the DIALOG_SDI flag being set.
      MAPI calls the DISMISSMODELESS function when the user dismisses
      the modeless address dialog box, informing a client calling IAddrBook.Address
      that the dialog box is no longer active.
    *)
    AddressDialogBoxParameters.lpfnDismiss := nil;

    // lpvDismissContext
    // Pointer to context information to be passed to the DISMISSMODELESS function
    // pointed to by the lpfnDismiss member. This member applies only to the modeless
    // version of the dialog box, as indicated by the DIALOG_SDI flag being set.
    AddressDialogBoxParameters.lpvDismissContext := nil;

    // lpContRestriction
    // Pointer to an SRestriction structure that limits the type of address entries
    // that can be displayed in the dialog box.
    AddressDialogBoxParameters.lpContRestriction := nil;

    // lpHierRestriction
    // Pointer to an SRestriction structure that limits the address book containers
    // that can supply address entries to be displayed in the dialog box.
    AddressDialogBoxParameters.lpHierRestriction := nil;

    // lpszCaption
    // Pointer to text to be used as the title for the common address dialog box.
    AddressDialogBoxParameters.lpszCaption := 'MAPI TEST Address from DELPHI';

    // lpszNewEntryTitle
    // Pointer to text to be used as the button label for the button that invokes
    // either the New Entry dialog box or another dialog box.
    AddressDialogBoxParameters.lpszNewEntryTitle := 'For this test dialog';

    // nDestFieldFocus
    // Indicates the particular edit box control that should have the initial focus
    // when the modal version of the dialog box appears.
    // This value must be between 0 and the value of cDestFields minus 1.
    AddressDialogBoxParameters.nDestFieldFocus := 0;

    DestTitles[0] := 'To';
    DestTitles[1] := 'Cc';
    DestTitles[2] := 'Bcc';
    DestComps[0] := ULONG(MAPI_TO);
    DestComps[1] := ULONG(MAPI_CC);
    DestComps[2] := ULONG(MAPI_BCC);

    case Value of
      0:
        begin
          AddressDialogBoxParameters.ulFlags := DIALOG_SDI or AB_UNICODEUI or
            fMapiUnicode;
          AddressDialogBoxParameters.lpszDestWellsTitle := '0 wells here';
          AddressDialogBoxParameters.cDestFields := 0;
          AddressDialogBoxParameters.lppszDestTitles := nil;
          AddressDialogBoxParameters.lpulDestComps := nil;
        end;
      1:
        begin
          AddressDialogBoxParameters.ulFlags := DIALOG_MODAL or AB_UNICODEUI or
            fMapiUnicode;
          AddressDialogBoxParameters.lpszDestWellsTitle := '3 wells here';
          AddressDialogBoxParameters.cDestFields := 3;
          AddressDialogBoxParameters.lppszDestTitles := @DestTitles;
          AddressDialogBoxParameters.lpulDestComps := @DestComps;
        end;

    end;

    AddressListRecipientsProperties := nil;
    UIParam := Application.Handle;
    (*
      The IAddrBook.Address method displays the common address dialog box.

      Parameters
      var lpulUIParam
      Handle of the parent window of the dialog box.
      On input, a window handle must always be passed.
      On output, if the ulFlags member of the lpAdrParms parameter is set to DIALOG_SDI,
      then the window handle of the modeless dialog box is returned.
      var lpAdrParms
      Pointer to an ADRPARM structure that controls the presentation
      and behavior of the address dialog box.
      var lppAdrList
      Pointer to a pointer to an ADRLIST structure containing recipient information.
      On input, this parameter can be NIL or point to a valid pointer.
      On output, this parameter points to a pointer to valid recipient information.
    *)
    hr := AddressBook.Address(UIParam, @AddressDialogBoxParameters,
      AddressListRecipientsProperties);

    if failed(hr) then
    begin
      if hr <> MAPI_E_USER_CANCEL then
        MessageDlg(GetMAPIError(AddressBook, hr), mtError, [mbOK], 0);
      exit;
    end;

    if Assigned(AddressListRecipientsProperties) then
    begin
      frmYouChooce.ListBox.Items.Clear;
      for iCount := 0 to AddressListRecipientsProperties.cEntries - 1 do
      begin
        RecipientsProperties := AddressListRecipientsProperties.
          aEntries[iCount];
        TempString := '';
        for jCount := 0 to RecipientsProperties.cValues - 1 do
        begin
          if PSPropValueArray(RecipientsProperties.rgPropVals)
            [jCount].ulPropTag = PR_DISPLAY_NAME then
            TempString := TempString +
              StrPas(PSPropValueArray(RecipientsProperties.rgPropVals)
              [jCount].Value.lpsz);

          if PSPropValueArray(RecipientsProperties.rgPropVals)
            [jCount].ulPropTag = PR_RECIPIENT_TYPE then
            case PSPropValueArray(RecipientsProperties.rgPropVals)
              [jCount].Value.l of
              MAPI_TO:
                TempString := TempString + ' - RecipientType - ' +
                  DestTitles[0];
              MAPI_CC:
                TempString := TempString + ' - RecipientType - ' +
                  DestTitles[1];
              MAPI_BCC:
                TempString := TempString + ' - RecipientType - ' +
                  DestTitles[2];
            end;

          if PSPropValueArray(RecipientsProperties.rgPropVals)
            [jCount].ulPropTag = PR_EMAIL_ADDRESS then
            TempString := TempString + ' - ' +
              StrPas(PSPropValueArray(RecipientsProperties.rgPropVals)
              [jCount].Value.lpsz);
        end;
        frmYouChooce.ListBox.Items.Add(TempString);
      end;
      frmYouChooce.ShowModal;
    end;

  finally
    if Assigned(AddressListRecipientsProperties) then
      FreePadrlist(AddressListRecipientsProperties);
    if Assigned(AddressBook) then
      AddressBook := nil;
  end;
end;

procedure TfrmMain.sbShowAddressBook2Click(Sender: TObject);
begin
  ShowAddressBook(1);
end;

procedure TfrmMain.sbShowAddressBook1Click(Sender: TObject);
begin
  ShowAddressBook(0);
end;

end.