Copyright © 2024 IMIBO. Privacy Statement
Extended MAPI in DELPHI
LazyMAPI # 6
Test TMAPITable wrapper, FastFilter and FastSort
With this example, we intoduce the Delphi TMAPITable class, which is IMAPITable wrapper.
It does not cover all of the properties and functions of IMAPITable, but provides easy access „in Delphi way“.
usage:
unit uMain; { Please add ..\..\Library;..\..\Library\Helpers;..\Forms; to project search path } interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, ExtCtrls, Buttons, ComCtrls, ImgList, Menus, ExtendedMAPI, IMIEMTypes; type TfrmMain = class(TForm) plTOP: TPanel; btLogOn: TSpeedButton; btLogOff: TSpeedButton; rgProfile: TRadioGroup; MessageListIcons: TImageList; StatusBar: TStatusBar; FolderListIcons: TImageList; Splitter1: TSplitter; MessageListView: TListView; MailboxTreeView: TTreeView; btFastMdgFilter: TButton; procedure btLogOnClick(Sender: TObject); procedure btLogOffClick(Sender: TObject); procedure FormCreate(Sender: TObject); procedure FormClose(Sender: TObject; var Action: TCloseAction); procedure MailboxTreeViewExpanding(Sender: TObject; Node: TTreeNode; var AllowExpansion: Boolean); procedure MailboxTreeViewCollapsing(Sender: TObject; Node: TTreeNode; var AllowCollapse: Boolean); procedure MailboxTreeViewChange(Sender: TObject; Node: TTreeNode); procedure MessageListViewColumnClick(Sender: TObject; Column: TListColumn); procedure MessageListViewData(Sender: TObject; Item: TListItem); procedure MessageListViewDblClick(Sender: TObject); procedure btFastMdgFilterClick(Sender: TObject); private { Private declarations } hr: HRESULT; MAPISession: IMAPISession; MAPIStore: IMsgStore; DATAFolder: IMAPIFolder; procedure ClearMAPIObjects; procedure BuildFolderTree; procedure ExpandLevel(Node: TTreeNode); procedure CollapseLevel(Node: TTreeNode); procedure CheckStore(StoreID: TBytes); procedure GetMessages(P: Pointer); public { Public declarations } end; var frmMain: TfrmMain; implementation uses DateUtils, EDK, MAPIUtils, MAPIException, MAPISessionUtils, MAPIFldUtils, MAPIPropUtils, MAPITable, MessageFrm; {$R *.dfm} var SpecialFoldersList: TSpecialFoldersList = nil; MessagesTable: TMAPITable = nil; ColumnIndex: Integer = -1; SortAscending: Boolean = True; ColumnTag: Cardinal = 0; SortAscendingOld: Boolean = True; ColumnTagOld: Cardinal = 0; FolderID: TBytes = nil; procedure ClearSpecialFoldersList; var iCount: Integer; begin for iCount := 0 to Length(SpecialFoldersList) - 1 do SpecialFoldersList[iCount].EntryID := nil; SpecialFoldersList := nil; end; function GetFolderType(FolderClass: string; ID: TBytes): TMAPIFldType; var iCount: Integer; begin Result := oFolderUndefined; for iCount := 0 to Length(SpecialFoldersList) - 1 do if IsSameTBytes(ID, SpecialFoldersList[iCount].EntryID) then begin Result := SpecialFoldersList[iCount].FolderType; Exit; end; if Result = oFolderUndefined then Result := GetMAPIFolderKnowType(FolderClass); end; procedure ClearHead(Node: TTreeNode); var pDataS: PStoreHead; pDataF: PFolderHead; begin if Assigned(Node.Data) then begin if Node.Level = 0 then begin pDataS := PStoreHead(Node.Data); pDataS.ID := nil; end else begin pDataF := PFolderHead(Node.Data); pDataF.ID := nil; pDataF.ParentID := nil; pDataF.StoreID := nil; end; Dispose(Node.Data); end; Node.Data := nil; end; function CopyStoreHead(TreeView: TTreeView; Row: TMAPITableFields): TTreeNode; var StoreHead: PStoreHead; len: Integer; begin (* Default columns are: PR_ENTRYID, PR_DISPLAY_NAME, PR_PROVIDER_DISPLAY, PR_DEFAULT_STORE, PR_MDB_PROVIDER *) New(StoreHead); len := Length(Row.ItemOf[PR_ENTRYID].AsBytes); SetLength(StoreHead.ID, len); Move(Row.ItemOf[PR_ENTRYID].AsBytes[0], StoreHead.ID[0], len); StoreHead.DisplayName := Row.ItemOf[PR_DISPLAY_NAME].AsString; StoreHead.ProviderDisplayName := Row.ItemOf[PR_PROVIDER_DISPLAY].AsString; StoreHead.IsDefault := Row.ItemOf[PR_DEFAULT_STORE].AsBoolean; StoreHead.StoreType := GetMsgStoreType(Row.ItemOf[PR_MDB_PROVIDER].AsBytes); if StoreHead^.IsDefault then Result := TreeView.Items.AddObjectFirst(nil, StoreHead.DisplayName, StoreHead) else Result := TreeView.Items.AddObject(nil, StoreHead.DisplayName, StoreHead); // Image Index if StoreHead^.IsDefault then Result.ImageIndex := 0 else Result.ImageIndex := 1; Result.SelectedIndex := Result.ImageIndex; Result.Expanded := False; // Add Dummy Node for [+] Icon TreeView.Items.AddChildObjectFirst(Result, '', nil); end; function CopyFolderHead(ParentNode: TTreeNode; Row: TMAPITableFields): TTreeNode; var FolderHead: PFolderHead; len: Integer; TreeView: TTreeView; begin Result := nil; (* Default columns here are: PR_ENTRYID, PR_LONGTERM_ENTRYID_FROM_TABLE, PR_DISPLAY_NAME, PR_CONTAINER_CLASS, PR_CONTENT_COUNT, PR_CONTENT_UNREAD, PR_SUBFOLDERS, PR_PARENT_ENTRYID, PR_STORE_ENTRYID, PR_MDB_PROVIDER, PR_ATTR_HIDDEN *) // We are not interested in hidden folders if Row.PropExistsEx(PR_ATTR_HIDDEN) and Row.ItemOf[PR_ATTR_HIDDEN].AsBoolean then Exit; New(FolderHead); if Row.PropExistsEx(PR_LONGTERM_ENTRYID_FROM_TABLE) then begin len := Length(Row.ItemOf[PR_LONGTERM_ENTRYID_FROM_TABLE].AsBytes); SetLength(FolderHead.ID, len); Move(Row.ItemOf[PR_LONGTERM_ENTRYID_FROM_TABLE].AsBytes[0], FolderHead.ID[0], len); end else begin len := Length(Row.ItemOf[PR_ENTRYID].AsBytes); SetLength(FolderHead.ID, len); Move(Row.ItemOf[PR_ENTRYID].AsBytes[0], FolderHead.ID[0], len); end; if not Row.ItemOf[PR_DISPLAY_NAME].IsError then FolderHead.DisplayName := Row.ItemOf[PR_DISPLAY_NAME].AsString; if not Row.ItemOf[PR_CONTAINER_CLASS].IsError then FolderHead.FolderClass := Row.ItemOf[PR_CONTAINER_CLASS].AsString; FolderHead.FolderType := GetFolderType(FolderHead.FolderClass, FolderHead.ID); if not Row.ItemOf[PR_CONTENT_COUNT].IsError then FolderHead.MsgCount := Row.ItemOf[PR_CONTENT_COUNT].AsInteger; if not Row.ItemOf[PR_CONTENT_UNREAD].IsError then FolderHead.UnReadMsgCount := Row.ItemOf[PR_CONTENT_UNREAD].AsInteger; if not Row.ItemOf[PR_SUBFOLDERS].IsError then FolderHead.HasSubFolders := Row.ItemOf[PR_SUBFOLDERS].AsBoolean; if not Row.ItemOf[PR_PARENT_ENTRYID].IsError then begin len := Length(Row.ItemOf[PR_PARENT_ENTRYID].AsBytes); SetLength(FolderHead.ParentID, len); Move(Row.ItemOf[PR_PARENT_ENTRYID].AsBytes[0], FolderHead.ParentID[0], len); end; if not Row.ItemOf[PR_STORE_ENTRYID].IsError then begin len := Length(Row.ItemOf[PR_STORE_ENTRYID].AsBytes); SetLength(FolderHead.StoreID, len); Move(Row.ItemOf[PR_STORE_ENTRYID].AsBytes[0], FolderHead.StoreID[0], len); end; FolderHead.StoreType := GetMsgStoreType(Row.ItemOf[PR_MDB_PROVIDER].AsBytes); TreeView := TTreeView(ParentNode.TreeView); Result := TreeView.Items.AddChildObject(ParentNode, FolderHead^.DisplayName, FolderHead); Result.ImageIndex := GetFldIconIndex(FolderHead.FolderType); Result.SelectedIndex := Result.ImageIndex; // Add Dummy Node for [+] Icon if FolderHead.HasSubFolders then TreeView.Items.AddChildObject(Result, '', nil); end; procedure DeleteChild(Node: TTreeNode); var TreeNode: TTreeNode; begin TreeNode := Node.getFirstChild; while Assigned(TreeNode) do begin // Set Children MAPI Object to Not Active State if Assigned(TreeNode.Data) then begin ClearHead(TreeNode); TreeNode.Data := nil; end; if TreeNode.HasChildren then DeleteChild(TreeNode); TreeNode.DeleteChildren; TreeNode := Node.GetNextChild(TreeNode); end; Node.DeleteChildren; end; procedure TfrmMain.ClearMAPIObjects; begin if Assigned(MessagesTable) then FreeAndNil(MessagesTable); DATAFolder := nil; ClearSpecialFoldersList; if Assigned(MAPIStore) then ReleaseMsgStore(MAPIStore); MAPIStore := nil; if Assigned(MAPISession) then ReleaseMapiSession(MAPISession); MAPISession := nil; end; procedure TfrmMain.btFastMdgFilterClick(Sender: TObject); var DefSubText: string; PropTag: ULONG; begin if not Assigned(MessagesTable) or (MessagesTable.Count < 1) then Exit; PropTag := 0; if Assigned(MessageListView.Selected) then DefSubText := MessageListView.Selected.SubItems[2] else DefSubText := ''; if not InputQuery('Fast Msg Filter', 'Show only Messages where Subject Like', DefSubText) then Exit; if (DefSubText <> '') then begin PropTag := PR_SUBJECT; end; MessageListView.Items.BeginUpdate; try MessagesTable.FastFilter(PropTag, rLike, DefSubText); finally MessageListView.Items.Count := MessagesTable.Count; StatusBar.Panels[0].Text := IntToStr(MessageListView.Items.Count) + ' Items'; if MessagesTable.IsFiltered then StatusBar.Panels[0].Text := StatusBar.Panels[0].Text + ' - Filter is applied!'; MessageListView.Items.EndUpdate; MessageListView.ItemIndex := -1; MessageListView.Refresh; end; end; procedure TfrmMain.btLogOffClick(Sender: TObject); begin // Release all MAPI Interfaces and Delphi objects ClearMAPIObjects; btLogOn.Enabled := True; btLogOff.Enabled := False; end; procedure TfrmMain.btLogOnClick(Sender: TObject); begin // Get MAPI Session case rgProfile.ItemIndex of 0: MAPISession := GetMAPISession(Self.Handle); 1: MAPISession := GetMAPISession(Self.Handle, '', MAPI_LOGON_UI); end; if Assigned(MAPISession) then begin btLogOn.Enabled := False; btLogOff.Enabled := True; BuildFolderTree; end; end; procedure TfrmMain.BuildFolderTree; var MAPITable: IMAPITable; iCount: Integer; begin if not Assigned(MAPISession) then Exit; MAPITable := GetMAPIStoresTable(MAPISession); { GetMAPIStoresTable returns message store table that contains information about all the message stores in the session profile Default columns are: PR_ENTRYID, PR_DISPLAY_NAME, PR_PROVIDER_DISPLAY, PR_DEFAULT_STORE, PR_MDB_PROVIDER } with TMAPITable.Create(MAPITable) do begin for iCount := 0 to Count - 1 do CopyStoreHead(MailboxTreeView, Row[iCount]); Free; end; end; procedure TfrmMain.FormClose(Sender: TObject; var Action: TCloseAction); begin // Release all MAPI Interfaces and Delphi objects ClearMAPIObjects; // UnInitialize MAPI Subsystem MapiUnInitialize; end; procedure TfrmMain.FormCreate(Sender: TObject); begin {$IF DEFINED (WIN64)} Self.Caption := Self.Caption + ' - WIN64'; {$ELSE} Self.Caption := Self.Caption + ' - WIN32'; {$IFEND} DATAFolder := nil; MAPIStore := nil; MAPISession := nil; hr := MapiInitialize(nil); if failed(hr) then raise EMAPIError.CreateMAPI(nil, hr); MessageListView.Items.Count := 0; // set Property_Tag for Columns sort MessageListView.Columns.Items[0].Tag := PR_ICON_INDEX; MessageListView.Columns.Items[1].Tag := PR_HASATTACH; MessageListView.Columns.Items[2].Tag := PR_SENDER_NAME; MessageListView.Columns.Items[3].Tag := PR_NORMALIZED_SUBJECT; MessageListView.Columns.Items[4].Tag := PR_CLIENT_SUBMIT_TIME; MessageListView.Columns.Items[5].Tag := PR_MESSAGE_SIZE; end; procedure TfrmMain.MailboxTreeViewChange(Sender: TObject; Node: TTreeNode); var Cursor: TCursor; begin Cursor := Screen.Cursor; Screen.Cursor := crHourGlass; try if Node.Level > 0 then begin CheckStore(PFolderHead(Node.Data)^.StoreID); GetMessages(Node.Data); end else begin btFastMdgFilter.Enabled := False; MessageListView.Items.Count := 0; MessageListView.Refresh; CheckStore(PStoreHead(Node.Data)^.ID); end; finally Screen.Cursor := Cursor; end; if Node.Level = 0 then StatusBar.Panels[0].Text := PStoreHead(Node.Data).DisplayName; end; procedure TfrmMain.MailboxTreeViewCollapsing(Sender: TObject; Node: TTreeNode; var AllowCollapse: Boolean); begin CollapseLevel(Node); end; procedure TfrmMain.MailboxTreeViewExpanding(Sender: TObject; Node: TTreeNode; var AllowExpansion: Boolean); var FirstChild: TTreeNode; begin FirstChild := Node.getFirstChild; if Assigned(FirstChild) and (FirstChild.Data = nil) then begin Node.DeleteChildren; ExpandLevel(Node); end; end; procedure TfrmMain.MessageListViewColumnClick(Sender: TObject; Column: TListColumn); var iCount: Integer; begin if not Assigned(MessagesTable) then Exit; if (MessageListView.Items.Count = 0) or not Assigned(MailboxTreeView.Selected) or not Assigned(MailboxTreeView.Selected.Data) or (MailboxTreeView.Selected.Level = 0) then Exit; if ColumnIndex = Column.Index then SortAscending := not SortAscending else begin ColumnIndex := Column.Index; SortAscending := True; for iCount := 2 to MessageListView.Columns.Count - 1 do MessageListView.Columns.Items[iCount].ImageIndex := -1; end; if Column.Index > 1 then case SortAscending of True: Column.ImageIndex := 183; False: Column.ImageIndex := 184; end; ColumnTag := Column.Tag; MessagesTable.FastSort(ColumnTag, SortAscending); MessageListView.Refresh; SortAscendingOld := SortAscending; ColumnTagOld := ColumnTag; end; procedure TfrmMain.MessageListViewData(Sender: TObject; Item: TListItem); var ItemIndex: Integer; IconIndex: Integer; MessageClass: string; MessageFlags: Integer; begin ItemIndex := Item.Index; if ItemIndex > MessagesTable.Count - 1 then Exit; (* Default columns are: PR_ENTRYID, PR_LONGTERM_ENTRYID_FROM_TABLE, PR_MESSAGE_CLASS, PR_HASATTACH, PR_SUBJECT, PR_SENDER_NAME, PR_SENDER_EMAIL_ADDRESS, PR_CLIENT_SUBMIT_TIME, PR_MESSAGE_SIZE, PR_MESSAGE_FLAGS, PR_ICON_INDEX *) IconIndex := -1; MessageClass := ''; MessageFlags := 0; if MessagesTable.Row[ItemIndex].PropExistsEx(PR_ICON_INDEX) then IconIndex := MessagesTable.Row[ItemIndex].ItemOf[PR_ICON_INDEX].AsInteger; if MessagesTable.Row[ItemIndex].PropExistsEx(PR_MESSAGE_CLASS) then MessageClass := MessagesTable.Row[ItemIndex].ItemOf[PR_MESSAGE_CLASS].AsString; if MessagesTable.Row[ItemIndex].PropExistsEx(PR_MESSAGE_FLAGS) then MessageFlags := MessagesTable.Row[ItemIndex].ItemOf[PR_MESSAGE_FLAGS].AsInteger; Item.ImageIndex := CalculateMsgIconIndex(IconIndex, MessageClass, MessageFlags); Item.SubItems.Add(''); if MessagesTable.Row[ItemIndex].ItemOf[PR_HASATTACH].AsBoolean then Item.SubItemImages[0] := 187 else Item.SubItemImages[0] := -1; if MessagesTable.Row[ItemIndex].PropExistsEx(PR_SENDER_NAME) then Item.SubItems.Add(MessagesTable.Row[ItemIndex].ItemOf[PR_SENDER_NAME].AsString) else Item.SubItems.Add(''); Item.SubItems.Add(MessagesTable.Row[ItemIndex].ItemOf[PR_SUBJECT].AsString); if MessagesTable.Row[ItemIndex].PropExistsEx(PR_CLIENT_SUBMIT_TIME) then Item.SubItems.Add(DateTimeToStr(MessagesTable.Row[ItemIndex].ItemOf[PR_CLIENT_SUBMIT_TIME].AsDateTime)) else Item.SubItems.Add(''); Item.SubItems.Add(ShowCustomSize(MessagesTable.Row[ItemIndex].ItemOf[PR_MESSAGE_SIZE].AsInteger)); end; procedure TfrmMain.MessageListViewDblClick(Sender: TObject); var ItemIndex: Integer; MAPIMessage: IMessage; ID: TBytes; begin ID := nil; if (MessageListView.Items.Count < 1) or not Assigned(MessagesTable) then Exit; ItemIndex := MessageListView.Selected.Index; if MessagesTable.Row[ItemIndex].PropExistsEx(PR_LONGTERM_ENTRYID_FROM_TABLE) then ID := MessagesTable.Row[ItemIndex].ItemOf[PR_LONGTERM_ENTRYID_FROM_TABLE].AsBytes else ID := MessagesTable.Row[ItemIndex].ItemOf[PR_ENTRYID].AsBytes; MAPIMessage := GetMapiMessage(MAPIStore, ID); with TfrmMessage.Create(Self) do begin SetMessage(MAPIMessage); ShowModal; end; end; procedure TfrmMain.ExpandLevel(Node: TTreeNode); var iCount: Integer; isStore: Boolean; MAPITable: IMAPITable; MAPIFolder: IMAPIFolder; begin isStore := (Node.Level = 0); if isStore then CheckStore(PStoreHead(Node.Data)^.ID); if not isStore then if Assigned(MAPIStore) and not IsSameMAPIObject(MAPISession, MAPIStore, PFolderHead(Node.Data)^.StoreID) then begin ReleaseMsgStore(MAPIStore); MAPIStore := GetMAPIStore(MAPISession, PFolderHead(Node.Data)^.StoreID); end; if isStore then MAPITable := GetMAPIFoldersTable(MAPIStore) else begin MAPIFolder := GetMAPIFolder(MAPIStore, PFolderHead(Node.Data)^.ID); MAPITable := GetMAPIFoldersTable(MAPIFolder); end; with TMAPITable.Create(MAPITable) do begin for iCount := 0 to Count - 1 do CopyFolderHead(Node, Row[iCount]); Free; end; end; procedure TfrmMain.CollapseLevel(Node: TTreeNode); var TreeNode: TTreeNode; SelectedNode: TTreeNode; isStore: Boolean; begin SelectedNode := MailboxTreeView.Selected; isStore := (Node.Level = 0); // Delete All Children if Node.HasChildren then begin TreeNode := Node.getFirstChild; while Assigned(TreeNode) do begin // Set Children MAPI Object to Not Active State if Assigned(TreeNode.Data) then begin ClearHead(TreeNode); TreeNode.Data := nil; end; if TreeNode.HasChildren then DeleteChild(TreeNode); TreeNode.DeleteChildren; TreeNode := Node.GetNextChild(TreeNode); end; Node.DeleteChildren; end; if Node.Selected and (Node <> SelectedNode) and (Node.Level > 0) then begin GetMessages(Node.Data) end; // Add Dummy Node for [+] Icon if isStore or PFolderHead(Node.Data)^.HasSubFolders then MailboxTreeView.Items.AddChildObjectFirst(Node, '', nil); end; procedure TfrmMain.CheckStore(StoreID: TBytes); begin if Assigned(MAPIStore) and not IsSameMAPIObject(MAPISession, MAPIStore, StoreID) then begin ReleaseMsgStore(MAPIStore); MAPIStore := nil; end; if not Assigned(MAPIStore) then begin MAPIStore := GetMAPIStore(MAPISession, StoreID); ClearSpecialFoldersList; SpecialFoldersList := GetMAPISpecialFoldersIDList(MAPIStore); end; end; procedure TfrmMain.GetMessages(P: Pointer); var FolderHead: PFolderHead; MAPITable: IMAPITable; begin btFastMdgFilter.Enabled := False; if not Assigned(P) then Exit; FolderHead := PFolderHead(P); if not IsSameTBytes(FolderHead^.ID, FolderID) then begin if Assigned(MessagesTable) then FreeAndNil(MessagesTable); CheckStore(FolderHead^.StoreID); DATAFolder := GetMAPIFolder(MAPIStore, FolderHead^.ID); MAPITable := GetMsgTable(DATAFolder, ColumnTag, SortAscending); SetLength(FolderID, Length(FolderHead^.ID)); Move(FolderHead^.ID[0], FolderID[0], Length(FolderHead^.ID)); MessagesTable := TMAPITable.Create(MAPITable); end; // Force virtual ListView to render items if MessagesTable.Count <> MessageListView.Items.Count then begin MessageListView.Items.Count := MessagesTable.Count; MessageListView.Refresh; end; StatusBar.Panels[0].Text := 'Message Count: ' + IntToStr(MessagesTable.Count) + ' in ' + FolderHead^.DisplayName; Application.ProcessMessages; btFastMdgFilter.Enabled := MessagesTable.Count > 0; end; end.