Development

unit MainUnit;

(*
  Message Store stores the e-mails and other user information.
  Message Store is organized as hierarchical system and its architecture "repeats" the file system.

  The message store is implemented in multiple levels, with containers called
  folders holding messages of different types. There is no limit to the number
  of levels in a message store; folders can contain many subfolders.

  Client application users can access a summary view of the messages contained
  within each folder or view them individually with a form.

  Message store data can be used in a variety of ways.
  Besides the traditional electronic mail usage, folders can be used as a forum
  for public discussion, as a repository for reference documents.

  Each Message store must contain a special folder called Root.
  When you start Outlook for the first time, it will create in
  the Root folder several special folders - "Top of Personal Folders",
  "Search Root", that contain Custom and Default View.

  All folders you can see in Outlook, such as Inbox, Outbox, Sent Items, Deleted Items,
  Calendar are in "Top of Personal Folders".
  They are known as IPM subtree (interpersonal message subtree)

  I.e. the structure may be presented in the following way:


  Root
  +---------------------+-------------------+....
  |                     |                   |
  |                     |                   |
  "Search Root"  "Top of Personal Folders"   "IPM_VIEWS"
  |
  |
  |
  +-------+-----+-------+-------+----------+---....
  |       |     |       |       |          |
  |       |     |       |       |          |
  Inbox   Outbox  Sent Deleted  Calendar   XXXXX ........



  Each of these folders also contains two tables - Contents and Hierarchy tables
  The first table provides information of the folder contents - e-mails, documents, etc,
  and the second one contains information of the nested folders.

  Some Message store providers also maintain Search Table that contains the result
  when you run a Search by some parameters in the folder.
  Simply put, it is these folders and tables that are our MailBox

  In this example we will try to connect to Exchange Server and get the folders
  that we work with and into which we save our e-mails, documents, and contacts.
  In an Exchange Server environment the place of all user MailBoxes is known
  as Private Information Store.
  We will build the tree while not showing the hidden (system) folders.

  Legal comment of the new MAPI functions.
  The ones that we have used in the previous examples are not explained here.

  This example requires connection to Exchange Server for effective functioning.
*)

interface

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

uses
  Classes, Controls, Dialogs, Forms, Graphics, Buttons, ComCtrls, ExtCtrls,
  ImgList, StdCtrls, ExtendedMAPI, System.ImageList;

type
  TfrmMain = class(TForm)
    plTOP: TPanel;
    btLogOn: TSpeedButton;
    btLogOff: TSpeedButton;
    rgProfile: TRadioGroup;
    MailboxTreeView: TTreeView;
    ilMailboxes: TImageList;
    rbStore: TRadioGroup;
    procedure FormCreate(Sender: TObject);
    procedure btLogOnClick(Sender: TObject);
    procedure btLogOffClick(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
  private
    { Private declarations }
    FMapiSession: IMAPISession; // Extended MAPI Session
    FMDB: IMsgStore; // Message Store
    hr: HRESULT; // MAPI Finction return HRESULT

    procedure ClearMAPIInterface;
    procedure MAPILocalInit(Flag: cardinal);
    procedure MapiInternalLogOff;
    procedure OpenPrivateIS;
    procedure GetFolderRoot;
    procedure EnumFolders(ParentFolder: IMAPIFolder; ParentNode: TTreeNode);
  public
    { Public declarations }
  end;

var
  frmMain: TfrmMain;

implementation

uses
{$IFDEF DELPHI2011XE2}
  UITypes,
{$ENDIF}
  SysUtils, StrUtils, Windows, EDK, MAPIMacros, MAPIUtils, MAPIFldUtils;
{$R *.DFM}

procedure TfrmMain.ClearMAPIInterface;
begin
  FMDB := nil;
  FMapiSession := nil;
end;

procedure TfrmMain.MAPILocalInit(Flag: cardinal);
begin
  ClearTTreeBinary(MailboxTreeView);
  try

    hr := MAPILogonEx(Application.Handle, nil, nil, MAPI_EXTENDED or MAPI_NEW_SESSION or MAPI_NO_MAIL or MAPI_ALLOW_OTHERS 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;

  finally
    if Failed(hr) then
    begin
      if Assigned(FMapiSession) then
      begin
        FMapiSession.Logoff(0, 0, 0);
        FMapiSession := nil;
      end;
    end;

    btLogOn.Enabled := not Assigned(FMapiSession);
    btLogOff.Enabled := Assigned(FMapiSession);

    (*
      If the MAPI initialization is successful, then we have performed a session
      with the Exchange Server, we will open our Information Store
    *)
    if Assigned(FMapiSession) then
      OpenPrivateIS;
  end;

end;

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

procedure TfrmMain.MapiInternalLogOff;
var
  Flags: ULONG;
begin
  ClearTTreeBinary(MailboxTreeView);
  Flags := LOGOFF_NO_WAIT;

  if Assigned(FMDB) then
  begin
    FMDB.StoreLogoff(Flags);
    FMDB := nil;
  end;

  if Assigned(FMapiSession) then
  begin
    FMapiSession.Logoff(Application.Handle, MAPI_LOGOFF_UI, 0);
    FMapiSession := nil;
  end;
  ClearMAPIInterface;
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.OpenPrivateIS;
var
  ENTRYID: TSBinary;
  Flags: ULONG;
begin
  Flags := LOGOFF_NO_WAIT;
  FMDB := nil;

  if rbStore.ItemIndex = 0 then
    (*
      To find our Mailbox, placed in the Exchange Server we will
      use a function of the EDK - HrOpenExchangePrivateStore.

      The HrOpenExchangePrivateStore function locates the primary user information store provider.
      If there are two or more information store providers available,
      HrOpenExchangePrivateStore returns a pointer to the first one it encounters.
    *)

    hr := HrOpenExchangePrivateStore(FMapiSession, FMDB)

  else
  begin
    ENTRYID.cb := 0;
    ENTRYID.lpb := nil;

    hr := HrMAPIFindDefaultMsgStore(FMapiSession, ENTRYID.cb, PENTRYID(ENTRYID.lpb));

    if Failed(hr) then
    begin
      ShowMessage('I cannot find "Default MsgStore"');
      Exit;
    end;

    hr := FMapiSession.OpenMsgStore(Application.Handle, ENTRYID.cb, PENTRYID(ENTRYID.lpb), @IID_IMsgStore,
      MAPI_BEST_ACCESS or MDB_ONLINE, FMDB);

    if hr = MAPI_E_UNKNOWN_FLAGS then
      hr := FMapiSession.OpenMsgStore(Application.Handle, ENTRYID.cb, PENTRYID(ENTRYID.lpb), @IID_IMsgStore, MAPI_BEST_ACCESS, FMDB);

    if Assigned(ENTRYID.lpb) then
      MAPIFreeBuffer(ENTRYID.lpb);

  end;

  if Failed(hr) then
  begin
    if Assigned(FMDB) then

      (*
       The IMsgStore.StoreLogoff method enables the orderly logoff
        of the message store.

        Parameters
        lpulFlags
        [in, out] Bitmask of flags that controls logoff from the message store. On input, all flags set for this parameter are mutually exclusive; a caller must specify only one flag per call. The following flags are valid on input:
        LOGOFF_ABORT - Any transport provider activity for this message store should be stopped before logoff. Control is returned to the caller after activity is stopped. If any transport provider activity is taking place, the logoff does not occur and no change in the behavior of the MAPI spooler or transport providers occurs. If transport provider activity is quiet, the MAPI spooler releases the store.
        LOGOFF_NO_WAIT - The message store should not wait for messages from transport providers before closing. Outbound messages that are ready to be sent are sent. If this store contains the default Inbox, any in-process messages are received, and then further reception is disabled. When all activity is completed, the MAPI spooler releases the store, and control is returned to the caller immediately.
        LOGOFF_ORDERLY - The message store should not wait for information from transport providers before closing. Messages currently being processed are completed, but no new messages are processed. When all activity is completed, the MAPI spooler releases the store, and control is returned to the store provider immediately.
        LOGOFF_PURGE - The logoff should work the same as if the LOGOFF_NO_WAIT flag is set, but that either IXPLogon.FlushQueues or IMAPIStatus.FlushQueues for the appropriate transport providers should be called. The LOGOFF_PURGE flag returns control to the caller after completion.
        LOGOFF_QUIET - If any transport provider activity is taking place, the logoff should not occur.
        The following flags are valid on output:
        LOGOFF_INBOUND - Inbound messages are currently arriving.
        LOGOFF_OUTBOUND - Outbound messages are in the process of being sent.
        LOGOFF_OUTBOUND_QUEUE - Outbound messages are pending, that is, they are in the Outbox.
      *)

      FMDB.StoreLogoff(Flags);

    ShowMessage('I cannot open the "MsgStore"' + CRLF + GetMapiError(FMapiSession, hr));
    FMDB := nil;
    Exit;
  end
  (*
    If there is no error from the implementation of the code so far,
    we will get the Root folder of our Mailbox
  *)
  else
    GetFolderRoot;
end;

procedure TfrmMain.GetFolderRoot;
var
  RootFolder: IMAPIFolder;
  RowCount, ObjType: ULONG;
  Count: integer;
  HierarchyTable: IMAPITable;
  PropTagArray: PSPropTagArray;
  Rows: PSRowSet;
  ChFolder: IMAPIFolder;
  Node: TTreeNode;

begin

  RootFolder := nil;
  HierarchyTable := nil;
  PropTagArray := nil;
  Rows := nil;
  ChFolder := nil;

  try

    hr := FMDB.OpenEntry(0, // use 0 for root folder
      nil, // use NIL for root folder
      @IID_IMAPIFolder, // use NIL for interface ID
      MAPI_BEST_ACCESS or MAPI_NO_CACHE, ObjType, IUnknown(RootFolder));

    if (hr = MAPI_E_UNKNOWN_FLAGS) or (MAPI_E_FAILONEPROVIDER = hr) then
      hr := FMDB.OpenEntry(0, // use 0 for root folder
        nil, // use NIL for root folder
        @IID_IMAPIFolder, // use NIL for interface ID
        MAPI_BEST_ACCESS, ObjType, IUnknown(RootFolder));

    if Failed(hr) then
    begin
      ShowMessage(GetMapiError(FMDB, hr));
      Exit;
    end;

    (*
      We'll take a Hierarchy Table that contains information of the nested folders.
    *)
    hr := RootFolder.GetHierarchyTable(CONVENIENT_DEPTH, HierarchyTable);

    if Failed(hr) then
    begin
      ShowMessage(GetMapiError(RootFolder, hr));
      Exit;
    end;

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

    if Failed(hr) then
    begin
      ShowMessage(GetMapiError(HierarchyTable, hr));
      Exit;
    end;

    (*
      Initially we will be interested in only two of the folder properties,
      namely their name and unique identifier (PR_DISPLAY_NAME and PR_ENTRYID)
    *)

    hr := SizedSPropTagArray([PR_DISPLAY_NAME, PR_ENTRYID], PropTagArray);
    if Failed(hr) then
    begin
      ShowMessage('MAPIError');
      Exit;
    end;

    (*
      We will restrict the columns of the table to the ones we are interested in
    *)

    hr := HierarchyTable.SetColumns(PropTagArray, 0);
    if Failed(hr) then
    begin
      ShowMessage(GetMapiError(HierarchyTable, hr));
      Exit;
    end;

    hr := HierarchyTable.QueryRows(RowCount, 0, Rows);

    if Failed(hr) then
    begin
      ShowMessage(GetMapiError(HierarchyTable, hr));
      Exit;
    end;

    if Assigned(Rows) and (Rows.cRows > 0) then
      for Count := 0 to Rows.cRows - 1 do

        (*
          We'll do the following:
          We will search for our "special folder" - 'Top of Information Store' by name
          and we will use recursion
          The name 'Top of Information Store' is not changed in an Exchange Server
          environment so we are free to use it.
          In the context of PST, it is 'Top of Personal Store' so we will search by
          the first common symbols 'Top of '

          NOTE!!!
          'Top of Personal Store' is language dependent and not recommended.
          Use the GetTopFolder or HrMAPIFindIPMSubtree function !!!
        *)
        if (PSPropValueArray(Rows.aRow[Count].lpProps)[0].ulPropTag = PR_DISPLAY_NAME) and
          Assigned(PSPropValueArray(Rows.aRow[Count].lpProps)[0].Value.lpsz) then
          if AnsiContainsText(StrPas(PSPropValueArray(Rows.aRow[Count].lpProps)[0].Value.lpsz), 'Top of ') or
            AnsiContainsText(StrPas(PSPropValueArray(Rows.aRow[Count].lpProps)[0].Value.lpsz), 'IPM_SUBTREE') then
          begin
            hr := FMDB.OpenEntry(PSPropValueArray(Rows.aRow[Count].lpProps)[1].Value.bin.cb,
              PENTRYID(PSPropValueArray(Rows.aRow[Count].lpProps)[1].Value.bin.lpb), @IID_IMAPIFolder, MAPI_BEST_ACCESS or MAPI_NO_CACHE,
              ObjType, IUnknown(ChFolder));

            if (hr = MAPI_E_UNKNOWN_FLAGS) or (MAPI_E_FAILONEPROVIDER = hr) then
              hr := FMDB.OpenEntry(PSPropValueArray(Rows.aRow[Count].lpProps)[1].Value.bin.cb,
                PENTRYID(PSPropValueArray(Rows.aRow[Count].lpProps)[1].Value.bin.lpb), @IID_IMAPIFolder, MAPI_BEST_ACCESS, ObjType,
                IUnknown(ChFolder));

            if Failed(hr) then
            begin
              ShowMessage(GetMapiError(FMDB, hr));
              Exit;
            end;

            ClearTTreeBinary(MailboxTreeView);
            MailboxTreeView.Items.BeginUpdate;

            Node := MailboxTreeView.Items.AddFirst(nil, 'Mailbox');
            Node.ImageIndex := 0;

            (* our recursion function *)
            EnumFolders(ChFolder, Node);

            ChFolder := nil;
            MailboxTreeView.Items.EndUpdate;
            break;
          end;

    // Use the GetTopFolder function !!!
    if MailboxTreeView.Items.Count = 0 then
    begin
      ChFolder := GetTopFolder(FMDB, True);
      if not Assigned(ChFolder) then
        Exit;

      ClearTTreeBinary(MailboxTreeView);
      MailboxTreeView.Items.BeginUpdate;

      Node := MailboxTreeView.Items.AddFirst(nil, 'Mailbox');
      Node.ImageIndex := 0;

      (* our recursion function *)
      EnumFolders(ChFolder, Node);

      ChFolder := nil;
      MailboxTreeView.Items.EndUpdate;
    end;

  finally
    if Assigned(RootFolder) then
      RootFolder := nil;
    if Assigned(Rows) then
      FreePRows(Rows);
    if Assigned(PropTagArray) then
      MAPIFreeBuffer(PropTagArray);
    if Assigned(HierarchyTable) then
      HierarchyTable := nil;
    if Assigned(ChFolder) then
      ChFolder := nil;
  end;
end;

procedure TfrmMain.EnumFolders(ParentFolder: IMAPIFolder; ParentNode: TTreeNode);
var
  SubFolder: IMAPIFolder;
  SubNode: TTreeNode;
  HierarchyTable: IMAPITable;
  ObjType, Count, RowCount: ULONG;
  RowSet: PSRowSet;
  TagArray: TSPropTagArray;
  FolderTagArray: PSPropTagArray;
  MAPIProp: IMAPIProp;
  ValueArray: PSPropValue;
  ENTRYID: PSBinary;
begin

  HierarchyTable := nil;
  RowSet := nil;
  FolderTagArray := nil;
  MAPIProp := nil;

  try
    if Assigned(ParentFolder) then
    begin
      hr := ParentFolder.GetHierarchyTable(0, HierarchyTable);
      if Failed(hr) then
      begin
        ShowMessage(GetMapiError(ParentFolder, hr));
        Exit;
      end;

      hr := HierarchyTable.GetRowCount(0, RowCount);
      if Failed(hr) then
      begin
        ShowMessage(GetMapiError(HierarchyTable, hr));
        Exit;
      end;

      TagArray.cValues := 1;
      TagArray.aulPropTag[0] := PR_ENTRYID;

      hr := HierarchyTable.SetColumns(@TagArray, 0);
      if Failed(hr) then
      begin
        ShowMessage(GetMapiError(HierarchyTable, hr));
        Exit;
      end;

      hr := HierarchyTable.QueryRows(RowCount, 0, RowSet);
      if Failed(hr) then
      begin
        ShowMessage(GetMapiError(HierarchyTable, hr));
        Exit;
      end;

      if Assigned(RowSet) and (RowSet.cRows > 0) then
      begin
        hr := SizedSPropTagArray([PR_DISPLAY_NAME, PR_ENTRYID, PR_SUBFOLDERS], FolderTagArray);
        if Failed(hr) then
        begin
          ShowMessage('MAPI Error');
          Exit;
        end;

        for Count := 0 to RowSet.cRows - 1 do
        begin
          Application.ProcessMessages;

          hr := ParentFolder.OpenEntry(PSPropValueArray(RowSet.aRow[Count].lpProps)[0].Value.bin.cb,
            PENTRYID(PSPropValueArray(RowSet.aRow[Count].lpProps)[0].Value.bin.lpb), @IID_IMAPIProp, MAPI_BEST_ACCESS or MAPI_NO_CACHE,
            ObjType, IUnknown(MAPIProp));

          if (hr = MAPI_E_UNKNOWN_FLAGS) or (MAPI_E_FAILONEPROVIDER = hr) then
            hr := ParentFolder.OpenEntry(PSPropValueArray(RowSet.aRow[Count].lpProps)[0].Value.bin.cb,
              PENTRYID(PSPropValueArray(RowSet.aRow[Count].lpProps)[0].Value.bin.lpb), @IID_IMAPIProp, MAPI_BEST_ACCESS, ObjType,
              IUnknown(MAPIProp));

          if Failed(hr) then
          begin
            ShowMessage(GetMapiError(ParentFolder, hr));
            Exit;
          end;

          hr := MAPIProp.GetProps(FolderTagArray, 0, ObjType, ValueArray);

          if Failed(hr) then
          begin
            ShowMessage(GetMapiError(MAPIProp, hr));
            Exit;
          end;

          MakePSBinary(PSPropValueArray(ValueArray)[1].Value.bin, ENTRYID);

          SubNode := MailboxTreeView.Items.AddChildObject(ParentNode, PSPropValueArray(ValueArray)[0].Value.lpsz, ENTRYID);

          SubNode.ImageIndex := 1;
          SubNode.SelectedIndex := 1;

          if BOOL(PSPropValueArray(ValueArray)[2].Value.B) and Assigned(ENTRYID) then
          begin
            hr := ParentFolder.OpenEntry(ENTRYID.cb, PENTRYID(ENTRYID.lpb), @IID_IMAPIFolder, MAPI_BEST_ACCESS or MAPI_NO_CACHE, ObjType,
              IUnknown(SubFolder));
            if (hr = MAPI_E_UNKNOWN_FLAGS) or (MAPI_E_FAILONEPROVIDER = hr) then
              hr := ParentFolder.OpenEntry(ENTRYID.cb, PENTRYID(ENTRYID.lpb), @IID_IMAPIFolder, MAPI_BEST_ACCESS, ObjType,
                IUnknown(SubFolder));

            if Failed(hr) then
            begin
              ShowMessage(GetMapiError(ParentFolder, hr));
              Exit;
            end;

            EnumFolders(SubFolder, SubNode);
            SubFolder := nil;
          end;

          MAPIFreeBuffer(ValueArray);
          ValueArray := nil;
          MAPIProp := nil;
        end; // for iCount:=0

        MAPIFreeBuffer(FolderTagArray);
        FolderTagArray := nil;

        FreePRows(RowSet);
        RowSet := nil;
      end; // if Assigned(PRows)

      HierarchyTable := nil;
    end; // if Assigned(ParentFolder)

  finally
    if Assigned(ValueArray) then
      MAPIFreeBuffer(ValueArray);
    ValueArray := nil;

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

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

    if Assigned(MAPIProp) then
      MAPIProp := nil;
    if Assigned(HierarchyTable) then
      HierarchyTable := nil;
   end;
end;

end.