Development

unit MAPIAddressBook;

(*
 So far in the previous examples we learned how to connect to Exchange Server,
 how to display our Properties in Address Book, to obtain the GAL contents,
 and see the embedded containers.
 We learned how to work with Content and Hierarchy Table, as well as with basic interfaces.
 Now we will try to include all this in one example that will be a GAL Viewer.
 There will be few or no code comments since this code was explained in the previous examples.

 This example requires connection to Microsoft Exchange Server for effective implementation.
*)
interface

{ Please add "..\Library" to project search path }
{$I IMI.INC}

uses
  Controls, Forms, Graphics, ComCtrls, ExtCtrls, ImgList, Menus, StdCtrls,
  ToolWin, Classes, ExtendedMAPI;

type
  POwnMAPIContainer = ^TOwnMAPIContainer;

  TOwnMAPIContainer = record
    DisplayName: String;
    Path: String;
    HierarPath: String;
    EntryID: String;
    PEntryID: String;
    DEPTH: byte;
  end;

type
  TfrmMAPI = class(TForm)
    ToolBar1: TToolBar;
    btLogOn: TToolButton;
    ToolButton2: TToolButton;
    btGetTree: TToolButton;
    ToolButton1: TToolButton;
    btLogOff: TToolButton;
    ToolButton3: TToolButton;
    ToolButton4: TToolButton;
    Panel1: TPanel;
    GALTreeView: TTreeView;
    ImageList: TImageList;
    Splitter1: TSplitter;
    ListViewRecipients: TListView;
    Splitter2: TSplitter;
    PanelHid: TPanel;
    ListViewProperites: TListView;
    ObjectHeaderControl: THeaderControl;
    PopupMenu1: TPopupMenu;
    DefaultMAPIProfile1: TMenuItem;
    ChoiseMAPIProfile1: TMenuItem;
    tbBreak: TToolButton;
    ToolButton6: TToolButton;
    procedure btLogOffClick(Sender: TObject);
    procedure btGetTreeClick(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure ListViewRecipientsClick(Sender: TObject);
    procedure ToolButton4Click(Sender: TObject);
    procedure DefaultMAPIProfile1Click(Sender: TObject);
    procedure ChoiseMAPIProfile1Click(Sender: TObject);
    procedure GALTreeViewChanging(Sender: TObject; Node: TTreeNode; var AllowChange: Boolean);
    procedure tbBreakClick(Sender: TObject);
    procedure GALTreeViewChange(Sender: TObject; Node: TTreeNode);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
    procedure FormCreate(Sender: TObject);

  private
    { Private declarations }
    hr: HRESULT;
    FMAPISession: IMAPISession;
    FAdrBook: IAddrBook;

    OrgFound: Boolean;
    OrgNode, SiteNode, ContNode: TTreeNode;
    BreakMe, InEnum: Boolean;
    SelectedNode: TTreeNode;
    SelectedItem: TListItem;
    strSite: string;
    procedure MAPILocalInit(Flag: Cardinal);
    procedure BuildTree(Value: PSRowSet);
    procedure AddOrgNodes(Value: POwnMAPIContainer);
    procedure GetObjectProperties(Value: POwnMAPIContainer);
    procedure GetContainerContent(Value: POwnMAPIContainer);
    procedure ClearListView;
  public
    { Public declarations }
  end;

var
  frmMAPI: TfrmMAPI;

implementation

uses
{$IFDEF DELPHI2011XE2}
  UITypes,
{$ENDIF}
  SysUtils, Windows, Dialogs, Variants, ActiveX, EDK, MAPIUtils,
  MAPIVariantProp, MAPIMacros, uAbout;
{$R *.DFM}

procedure TfrmMAPI.ClearListView;
var
  Count: Integer;
begin
  if ListViewRecipients.Items.Count < 1 then
    Exit;

  ListViewRecipients.Items.BeginUpdate;
  try
    for Count := 0 to ListViewRecipients.Items.Count - 1 do
      if Assigned(ListViewRecipients.Items[Count].Data) then
        FreeMem(ListViewRecipients.Items[Count].Data);
  finally
    ListViewRecipients.Items.Clear;
    ListViewRecipients.Items.EndUpdate;
  end;
end;

procedure TfrmMAPI.btLogOffClick(Sender: TObject);
begin
  if InEnum then
    Exit;

  BreakMe := True;
  InEnum := True;

  Sleep(100);
  ClearTTree(GALTreeView);
  ClearListView;
  Application.ProcessMessages;
  ListViewProperites.Items.BeginUpdate;
  try
    ListViewProperites.Items.Clear;
  finally
    ListViewProperites.Items.EndUpdate;
  end;
  Application.ProcessMessages;

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

  OrgFound := False;
  strSite := EmptyStr;

  btLogOff.Enabled := Assigned(FMAPISession);
  btGetTree.Enabled := Assigned(FMAPISession);
  btLogOn.Enabled := not Assigned(FMAPISession);
  GALTreeView.Refresh;
  InEnum := False;
end;

procedure TfrmMAPI.btGetTreeClick(Sender: TObject);
var
  ObjType: ULONG;
  HierarchyTable: IMAPITable;
  UnkObject: IMAPIContainer;

  TagArray: PSPropTagArray;
  Rows: PSRowSet;

  Count: ULONG;

begin
  ClearTTree(GALTreeView);
  TagArray := nil;
  UnkObject := nil;
  HierarchyTable := nil;
  ClearListView;
  InEnum := False;

  try
    hr := FAdrBook.OpenEntry(0, nil, @IID_IABContainer, MAPI_BEST_ACCESS or MAPI_NO_CACHE, ObjType, IUnknown(UnkObject));

    if (hr = MAPI_E_UNKNOWN_FLAGS)  or (MAPI_E_FAILONEPROVIDER=hr)  then
      hr := FAdrBook.OpenEntry(0, nil, @IID_IABContainer, MAPI_BEST_ACCESS, ObjType, IUnknown(UnkObject));

    if failed(hr) then
    begin
      ShowMessage(GetMAPIError(FAdrBook, hr));
      Exit;
    end;

    hr := UnkObject.GetHierarchyTable(CONVENIENT_DEPTH, HierarchyTable);

    if failed(hr) then
    begin
      ShowMessage(GetMAPIError(UnkObject, hr));
      Exit;
    end;

    hr := SizedSPropTagArray([PR_ENTRYID, PR_DEPTH], TagArray);

    if failed(hr) then
    begin
      ShowMessage(GetMAPIError(nil, hr));
      Exit;
    end;

    hr := HierarchyTable.SetColumns(TagArray, TBL_BATCH);

    if failed(hr) then
    begin
      ShowMessage(GetMAPIError(HierarchyTable, hr));
      Exit;
    end;

    hr := HierarchyTable.GetRowCount(0, Count);

    if failed(hr) then
    begin
      ShowMessage(GetMAPIError(HierarchyTable, hr));
      Exit;
    end;

    hr := HierarchyTable.QueryRows(Count, TBL_NOADVANCE, Rows);

    if failed(hr) then
    begin
      ShowMessage(GetMAPIError(HierarchyTable, hr));
      Exit;
    end;

  finally

    if not failed(hr) and Assigned(Rows) then
      BuildTree(Rows);

    if Assigned(Rows) then
      FreePRows(Rows);
    Rows := nil;

    if Assigned(TagArray) then
      MAPIFreeBuffer(TagArray);
    TagArray := nil;

    if Assigned(UnkObject) then
      UnkObject := nil;
    if Assigned(HierarchyTable) then
      HierarchyTable := nil;
    btGetTree.Enabled := False;

  end;

end;

procedure TfrmMAPI.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  btLogOffClick(nil);
  MAPIUninitialize;
end;

procedure TfrmMAPI.BuildTree(Value: PSRowSet);
var
  Count, Values: Integer;
  ObjType, cValues: ULONG;
  Container: IABContainer;
  TagArray: PSPropTagArray;
  PropArray: PSPropValue;
  MAPIContainer: POwnMAPIContainer;
  OrdPropID: byte;
begin

  try
    for Count := 0 to Value.cRows - 1 do
    begin
      hr := FAdrBook.OpenEntry(PSPropValueArray(Value.aRow[Count].lpProps)[0].Value.bin.cb,
        PEntryID(PSPropValueArray(Value.aRow[Count].lpProps)[0].Value.bin.lpb), @IID_IABContainer, MAPI_BEST_ACCESS or MAPI_NO_CACHE, ObjType,
        IUnknown(Container));

      if (hr = MAPI_E_UNKNOWN_FLAGS)  or (MAPI_E_FAILONEPROVIDER=hr)  then
        hr := FAdrBook.OpenEntry(PSPropValueArray(Value.aRow[Count].lpProps)[0].Value.bin.cb,
          PEntryID(PSPropValueArray(Value.aRow[Count].lpProps)[0].Value.bin.lpb), @IID_IABContainer, MAPI_BEST_ACCESS, ObjType, IUnknown(Container));

      if failed(hr) then
      begin
        ShowMessage(GetMAPIError(FAdrBook, hr));
        Exit;
      end;

      hr := SizedSPropTagArray([PR_ENTRYID, PR_DISPLAY_NAME], TagArray);

      hr := Container.GetProps(TagArray, fMapiUnicode, cValues, PropArray);
      if failed(hr) then
      begin
        ShowMessage(GetMAPIError(Container, hr));
        Exit;
      end;

      GetMem(MAPIContainer, SizeOf(TOwnMAPIContainer));
      ZeroMemory(MAPIContainer, SizeOf(TOwnMAPIContainer));

      OrdPropID := 0;

      if PSPropValueArray(Value.aRow[Count].lpProps)[OrdPropID + 1].ulPropTag = PR_DEPTH then
        MAPIContainer.DEPTH := PSPropValueArray(Value.aRow[Count].lpProps)[OrdPropID + 1].Value.l;

      for Values := 0 to cValues - 1 do
        case PSPropValueArray(PropArray)[Values].ulPropTag of
          // PR_ENTRYID:
          // MAPIContainer.EntryID :=
          // EntryIdToString(PSPropValueArray(PropArray)[Values].Value.bin);
          PR_DISPLAY_NAME:
            MAPIContainer.DisplayName := StrPas(PSPropValueArray(PropArray)[Values].Value.lpsz);
        end;

      MAPIContainer.EntryID := BinaryToHex(PSPropValueArray(Value.aRow[Count].lpProps)[0].Value.bin);

      AddOrgNodes(MAPIContainer);

      MAPIFreeBuffer(PropArray);
      PropArray := nil;
      MAPIFreeBuffer(TagArray);
      TagArray := nil;
      Container := nil;
    end;

  finally
    if Assigned(PropArray) then
      MAPIFreeBuffer(PropArray);
    PropArray := nil;
    if Assigned(TagArray) then
      MAPIFreeBuffer(TagArray);
    TagArray := nil;
    Container := nil;
    GALTreeView.FullExpand;
  end;
end;

procedure TfrmMAPI.AddOrgNodes(Value: POwnMAPIContainer);
var
  Count: Integer;
begin
  begin
    if (Value.DEPTH = 0) then
    begin
      OrgNode := GALTreeView.Items.AddObject(nil, Value.DisplayName, Value);
      OrgNode.ImageIndex := 0;
      OrgNode.SelectedIndex := 0;
      Exit;
    end;

    if (Value.DEPTH = 1) then
    begin
      strSite := Value.HierarPath;
      SiteNode := GALTreeView.Items.AddChildObject(OrgNode, Value.DisplayName, Value);
      SiteNode.ImageIndex := 1;
      SiteNode.SelectedIndex := 1;
      Exit;
    end;

    if (Value.DEPTH > 1) then
    begin
      for Count := 0 to GALTreeView.Items.Count - 1 do
        if AnsiSameText(POwnMAPIContainer(GALTreeView.Items[Count].Data).EntryID, Value.PEntryID) then
        begin
          ContNode := GALTreeView.Items[Count];
          break;
        end;
      ContNode := GALTreeView.Items.AddChildObject(ContNode, Value.DisplayName, Value);
      ContNode.ImageIndex := 2;
      ContNode.SelectedIndex := 2;
    end;
  end;
end;

procedure TfrmMAPI.GetObjectProperties(Value: POwnMAPIContainer);
var
  cbEntryID, ObjType, Values: ULONG;

  EntryID: PEntryID;
  CurrentMAPIObject: IMAPIProp;

  TagArray: PSPropTagArray;
  PropValue: PSPropValue;
  ListItem: TListItem;

  Count: Integer;
  strTemp: string;
  FTempVariant: variant;
begin

  if not Assigned(FAdrBook) then
    Exit;

  CurrentMAPIObject := nil;
  PropValue := nil;
  TagArray := nil;
  EntryID := nil;

  ListViewProperites.Items.BeginUpdate;
  try
    ListViewProperites.Items.Clear;

    StringToENTRYID(Value.EntryID, cbEntryID, EntryID);

    ObjectHeaderControl.Sections[0].Text := 'Properties for: ' + Value.DisplayName;

    hr := FAdrBook.OpenEntry(cbEntryID, EntryID, @IID_IMAPIProp, MAPI_BEST_ACCESS, ObjType, IUnknown(CurrentMAPIObject));

    if hr = MAPI_E_INVALID_PARAMETER then
      hr := FAdrBook.OpenEntry(cbEntryID, EntryID, nil, 0, ObjType, IUnknown(CurrentMAPIObject));

    if failed(hr) then
    begin
      ShowMessage(GetMAPIError(FAdrBook, hr));
      Exit;
    end;

    hr := CurrentMAPIObject.GetProps(nil, fMapiUnicode, ObjType, PropValue);
    if failed(hr) then
    begin
      ShowMessage(GetMAPIError(CurrentMAPIObject, hr));
      Exit;
    end;

    ObjectHeaderControl.Sections[1].Text := '# of Properties: ' + IntToStr(ObjType);

    for Values := 0 to ObjType - 1 do
    begin
      ListItem := ListViewProperites.Items.Add;

      ListItem.Caption := SzGetPropTag(PSPropValueArray(PropValue)[Values].ulPropTag);
      ListItem.SubItems.Add(IntToHEX(HiWord(PSPropValueArray(PropValue)[Values].ulPropTag), 4));

      case PROP_TYPE(PSPropValueArray(PropValue)[Values].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(PropValue)[Values].ulPropTag));
            ListItem.SubItems.Add(ConvertMAPIPropValueToVariant(@PSPropValueArray(PropValue)[Values]));
          end;
        PT_BINARY:
          begin
            ListItem.SubItems.Add(SzGetPropType(PSPropValueArray(PropValue)[Values].ulPropTag));
            strTemp := '';
            FTempVariant := ConvertMAPIPropValueToVariant(@PSPropValueArray(PropValue)[Values]);
            for Count := 0 to VarArrayHighBound(FTempVariant, 1) do
              strTemp := strTemp + IntToHEX(byte(FTempVariant[Count]), 2);
            strTemp := Trim(strTemp);
            ListItem.SubItems.Add(strTemp);
          end;
        PT_MV_STRING8, PT_MV_UNICODE:
          begin
            FTempVariant := ConvertMAPIPropValueToVariant(@PSPropValueArray(PropValue)[Values]);
            for Count := 0 to VarArrayHighBound(FTempVariant, 1) do
            begin
              if Count > 0 then
              begin
                ListItem := ListViewProperites.Items.Add;
                ListItem.Caption := SzGetPropTag(PSPropValueArray(PropValue)[Values].ulPropTag);
                ListItem.SubItems.Add(IntToHEX(HiWord(PSPropValueArray(PropValue)[Values].ulPropTag), 4));
              end;
              ListItem.SubItems.Add(SzGetPropType(PSPropValueArray(PropValue)[Values].ulPropTag));
              ListItem.SubItems.Add(FTempVariant[Count]);
            end;
          end
        else
        begin
          ListItem.SubItems.Add(SzGetPropType(PSPropValueArray(PropValue)[Values].ulPropTag) + ' - Not implemented');
          ListItem.SubItems.Add('A MAPI Value');
        end
      end;

    end;
  finally

    if Assigned(CurrentMAPIObject) then
      CurrentMAPIObject := nil;
    if Assigned(PropValue) then
      MAPIFreeBuffer(PropValue);
    if Assigned(TagArray) then
      MAPIFreeBuffer(TagArray);
    if Assigned(EntryID) then
      FreeMem(EntryID);
    ListViewProperites.Items.EndUpdate;
  end;
end;

procedure TfrmMAPI.GetContainerContent(Value: POwnMAPIContainer);
var
  cbEntryID, ObjType, Count: ULONG;
  EntryID: PEntryID;
  AddressBookContainer: IABContainer;
  ContentsMAPITable: IMAPITable;
  TagArray: PSPropTagArray;
  Rows: PSRowSet;
  MAPIContainer: POwnMAPIContainer;
  ListRecipient: TListItem;
  ContainerDisplayType: ULONG;
  Cursor: TCursor;
type
  PropEnum = (eENTRYID, eDisplayName, eEmailAddress, eDisplayType);

begin
  if not Assigned(FAdrBook) then
    Exit;

  ClearListView;

  EntryID := nil;
  AddressBookContainer := nil;
  ContentsMAPITable := nil;
  Rows := nil;
  TagArray := nil;

  Cursor := Screen.Cursor;
  Screen.Cursor := crHourGlass;

  InEnum := True;
  Application.ProcessMessages;

  try
    StringToENTRYID(Value.EntryID, cbEntryID, EntryID);

    hr := FAdrBook.OpenEntry(cbEntryID, EntryID, @IID_IABContainer, MAPI_BEST_ACCESS or MAPI_NO_CACHE, ObjType, IUnknown(AddressBookContainer));

    if (hr = MAPI_E_UNKNOWN_FLAGS)  or (MAPI_E_FAILONEPROVIDER=hr)  then
      hr := FAdrBook.OpenEntry(cbEntryID, EntryID, @IID_IABContainer, MAPI_BEST_ACCESS, ObjType, IUnknown(AddressBookContainer));

    if hr = MAPI_E_INVALID_PARAMETER then
      hr := FAdrBook.OpenEntry(cbEntryID, EntryID, @IID_IABContainer, 0, ObjType, IUnknown(AddressBookContainer));

    if failed(hr) then
    begin
      ShowMessage(GetMAPIError(FAdrBook, hr));
      Exit;
    end;

    hr := AddressBookContainer.GetContentsTable(0, ContentsMAPITable);

    if failed(hr) then
    begin
      if (hr <> MAPI_E_NO_SUPPORT) and (hr <> MAPI_E_CALL_FAILED) then
        ShowMessage(GetMAPIError(AddressBookContainer, hr));
      Exit;
    end;

    // Get Container type
    hr := HrMAPIGetPropLong(AddressBookContainer, PR_DISPLAY_TYPE, ContainerDisplayType);
    if failed(hr) then
      ContainerDisplayType := DT_NOT_SPECIFIC;

    if ContainerDisplayType <> DT_NOT_SPECIFIC then
      hr := SizedSPropTagArray([PR_ENTRYID, PR_DISPLAY_NAME, PR_SMTP_ADDRESS, PR_DISPLAY_TYPE], TagArray)
    else
      hr := SizedSPropTagArray([PR_ENTRYID, PR_DISPLAY_NAME, PR_EMAIL_ADDRESS, PR_DISPLAY_TYPE], TagArray);

    if failed(hr) then
    begin
      ShowMessage('Cannot perform the MAPIAllocateBuffer function');
      Exit;
    end;

    hr := ContentsMAPITable.SetColumns(TagArray, TBL_BATCH);

    if failed(hr) then
    begin
      ShowMessage(GetMAPIError(ContentsMAPITable, hr));
      Exit;
    end;

    Application.ProcessMessages;

    Count := 0;
    hr := ContentsMAPITable.GetRowCount(0, Count);

    if failed(hr) then
    begin
      ShowMessage(GetMAPIError(ContentsMAPITable, hr));
      Exit;
    end;

    ObjectHeaderControl.Sections[2].Text := '# of Recipients in  ' + Value.DisplayName + ':' + IntToStr(Count);

    if Count < 1 then
      Exit;

    BreakMe := False;

    while True do
    begin
      Rows := nil;
      Application.ProcessMessages;
      if BreakMe then
        Exit;

      // We will Query Table by 25 records

      if Assigned(ContentsMAPITable) then
        hr := ContentsMAPITable.QueryRows(25, 0, Rows);

      if Assigned(Rows) then
        if Rows.cRows = 0 then
        begin
          (*
           let's not forget to free the memory taken by the SrowSet returned by
           the execution of the FContentsTable.QueryRows(),
           using the FreePRows function

           FreeProws
           The FreeProws function destroys an SRowSet structure and frees
           associated memory, including memory allocated for all member arrays and structures.

           As part of its implementation of FreeProws, MAPI calls
           the MAPIFreeBuffer function to free every entry in the SRowSet
           structure before freeing the complete structure.
           Therefore all such entries must have followed the allocation rules
           for the SRowSet structure, using an individual MAPIAllocateBuffer
           call for each member array and structure.

           *)
          FreePRows(Rows);
          Rows := nil;

          break;
        end
        else
        begin

          for Count := 0 to Rows.cRows - 1 do
          begin
            Application.ProcessMessages;
            if BreakMe then
              Exit;

            GetMem(MAPIContainer, SizeOf(TOwnMAPIContainer));
            ZeroMemory(MAPIContainer, SizeOf(TOwnMAPIContainer));

            BinaryToHex(PSPropValueArray(Rows.aRow[Count].lpProps)[Ord(eENTRYID)].Value.bin.cb,
              PSPropValueArray(Rows.aRow[Count].lpProps)[Ord(eENTRYID)].Value.bin.lpb, MAPIContainer.EntryID);

            MAPIContainer.DisplayName := ConvertMAPIPropValueToVariant(@PSPropValueArray(Rows.aRow[Count].lpProps)[Ord(eDisplayName)]);

            if PSPropValueArray(Rows.aRow[Count].lpProps)[Ord(eEmailAddress)].ulPropTag = _PCardinalArray(@TagArray.aulPropTag)[Ord(eEmailAddress)] then
              MAPIContainer.Path := ConvertMAPIPropValueToVariant(@PSPropValueArray(Rows.aRow[Count].lpProps)[Ord(eEmailAddress)]);

            MAPIContainer.DEPTH := ConvertMAPIPropValueToVariant(@PSPropValueArray(Rows.aRow[Count].lpProps)[Ord(eDisplayType)]);

            ListRecipient := ListViewRecipients.Items.Add;
            ListRecipient.Caption := MAPIContainer.DisplayName;
            ListRecipient.SubItems.Add(MAPIContainer.Path);

            case MAPIContainer.DEPTH of
              DT_MAILUSER:
                ListRecipient.ImageIndex := 3;
              DT_DISTLIST, DT_PRIVATE_DISTLIST:
                ListRecipient.ImageIndex := 4;
              DT_FORUM:
                ListRecipient.ImageIndex := 7;
              DT_AGENT:
                ListRecipient.ImageIndex := 8;
              DT_REMOTE_MAILUSER:
                ListRecipient.ImageIndex := 5;
            end;

            ListRecipient.Data := MAPIContainer;
          end;

          if Assigned(Rows) then
          begin
            FreePRows(Rows);
            Rows := nil;
          end;
        end;
    end;

  finally
    if Assigned(ContentsMAPITable) then
      ContentsMAPITable := nil;
    if Assigned(TagArray) then
      MAPIFreeBuffer(TagArray);
    if Assigned(AddressBookContainer) then
      AddressBookContainer := nil;
    if Assigned(Rows) then
      FreePRows(Rows);
    if Assigned(EntryID) then
      FreeMem(EntryID);
    BreakMe := False;
    InEnum := False;
    Screen.Cursor := Cursor;
  end;
end;

procedure TfrmMAPI.ListViewRecipientsClick(Sender: TObject);
begin
  if Assigned(ListViewRecipients.Selected) and (SelectedItem <> ListViewRecipients.Selected) then
  begin
    if Assigned(ListViewRecipients.Selected.Data) then
      GetObjectProperties(POwnMAPIContainer(ListViewRecipients.Selected.Data));
    SelectedItem := ListViewRecipients.Selected;
  end;

end;

procedure TfrmMAPI.ToolButton4Click(Sender: TObject);
begin
  with TAboutBox.Create(Self) do
  begin
    ShowModal;
    Free;
  end;
end;

procedure TfrmMAPI.DefaultMAPIProfile1Click(Sender: TObject);
begin
  MAPILocalInit(MAPI_USE_DEFAULT or MAPI_PASSWORD_UI);
end;

procedure TfrmMAPI.MAPILocalInit(Flag: DWORD);
begin
  FMAPISession := nil;
  FAdrBook := nil;
  BreakMe := False;
  SelectedNode := nil;
  SelectedItem := nil;
  try

    hr := MAPILogonEx(Application.Handle, nil, nil, MAPI_EXTENDED or MAPI_NEW_SESSION or MAPI_ALLOW_OTHERS or MAPI_NO_MAIL or Flag, FMAPISession);

    if failed(hr) 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;
      Exit;
    end;

    hr := FMAPISession.OpenAddressBook(0, nil, 0 { AB_NO_DIALOG } , FAdrBook);

    if failed(hr) then
    begin
      ShowMessage(GetMAPIError(FMAPISession, hr));
      Exit;
    end;

  finally
    if failed(hr) then
    begin
      FAdrBook := nil;
      if Assigned(FMAPISession) then
      begin
        FMAPISession.Logoff(0, 0, 0);
        FMAPISession := nil;
      end;
    end;

    btLogOff.Enabled := Assigned(FMAPISession);
    btGetTree.Enabled := Assigned(FMAPISession);
    btLogOn.Enabled := not Assigned(FMAPISession);
  end;
end;

procedure TfrmMAPI.ChoiseMAPIProfile1Click(Sender: TObject);
begin
  MAPILocalInit(MAPI_LOGON_UI);
end;

procedure TfrmMAPI.GALTreeViewChanging(Sender: TObject; Node: TTreeNode; var AllowChange: Boolean);
begin
  AllowChange := (BreakMe = False) and (InEnum = False);
end;

procedure TfrmMAPI.tbBreakClick(Sender: TObject);
begin
  BreakMe := True;
end;

procedure TfrmMAPI.GALTreeViewChange(Sender: TObject; Node: TTreeNode);
begin
  if InEnum then
    Exit;
  tbBreak.Enabled := True;
  try
    if Assigned(Node) and (Node <> SelectedNode) then
    begin
      if Assigned(Node.Data) then
      begin
        BreakMe := True;
        GetObjectProperties(POwnMAPIContainer(Node.Data));
        GetContainerContent(POwnMAPIContainer(Node.Data));
      end;
    end;
  finally
    SelectedNode := Node;
    tbBreak.Enabled := False;
  end;
end;

procedure TfrmMAPI.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
  CanClose := not InEnum;
end;

procedure TfrmMAPI.FormCreate(Sender: TObject);
var
  ErrorString: string;
begin
{$IF DEFINED (WIN64)}
  Self.Caption := Self.Caption + ' - WIN64';
{$ELSE}
  Self.Caption := Self.Caption + ' - WIN32';
{$IFEND}
  hr := MapiInitialize(nil);

  if failed(hr) then
  begin
    case hr of
      MAPI_E_INVALID_PARAMETER or MAPI_E_UNKNOWN_FLAGS:
        ErrorString := 'Invalid parameter or flag!';
      MAPI_E_TOO_COMPLEX:
        ErrorString := 'The keys required by MAPI could not be initialized.';
      MAPI_E_VERSION:
        ErrorString := 'The version of OLE installed on the workstation is not compatible with this version of MAPI.';
      MAPI_E_SESSION_LIMIT:
        ErrorString := '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:
        ErrorString := 'Not enough system resources were available to complete the operation.';
      MAPI_E_INVALID_OBJECT:
        ErrorString := 'May fail if system resources are exhausted.';
      MAPI_E_NOT_INITIALIZED:
        ErrorString := 'The MAPI profile provider has encountered an error.';
    else
      ErrorString := 'The MAPI Error!'
    end;
    raise Exception.Create(WrapText(ErrorString, 80));
  end;
end;

end.