Copyright © 2025 IMIBO. Privacy Statement
Extended MAPI in DELPHI
LazyMAPI # 4
Test Message Smart Filter
The TFrmSmartFilterDialog form and developed TSmartFilter object will allows you to restrict messages inside content table to these where:
- Message Subject contains any substring
- Sender Display Name or Sender E-mail Address contains any substring
- Recipient Display Name or Sender E-mail Address contains any substring
- Is received Before/After/Between any Date
- Size is Greater than XXXXX bytes
- Body contains any substring
- Read/UnRead
Code snip:
var frmMain: TfrmMain; implementation {$R *.dfm} uses MAPIUtils, MAPIException, MAPISessionUtils, MAPIFldUtils, MAPISmartFilter, SmartFilterDlgFrm; var StoreList: TStoresHeadList = nil; MsgHeadList: TMsgHeadList = nil; MsgHeadListCount: Integer = 0; ColumnIndex: Integer = -1; SortAscending: Boolean = True; ColumnTag: Cardinal = 0; SortAscendingOld: Boolean = True; ColumnTagOld: Cardinal = 0; MinIndx: Integer = 0; MaxIndx: Integer = 50; FolderID: TBytes; const strLogOff: array [Boolean] of string = ('Log On', 'Log Off'); procedure ClearStoreList; var iCount: Integer; begin for iCount := 0 to Length(StoreList) - 1 do begin StoreList[iCount].ID := nil; StoreList[iCount].InstanceKey := nil; end; StoreList := nil; end; procedure ClearMsgHeadList; var iCount: Integer; begin for iCount := 0 to Length(MsgHeadList) - 1 do MsgHeadList[iCount].ID := nil; MsgHeadList := nil; end; procedure CopyFolderHead(const Source: PFolderHead; var Destination: PFolderHead); begin SetLength(Destination^.ID, Length(Source^.ID)); Move(Source.ID[0], Destination^.ID[0], Length(Source^.ID)); Destination^.DisplayName := Source^.DisplayName; Destination^.FolderClass := Source^.FolderClass; Destination^.FolderType := Source^.FolderType; Destination^.MsgCount := Source^.MsgCount; Destination^.UnReadMsgCount := Source^.UnReadMsgCount; Destination^.HasSubFolders := Source^.HasSubFolders; SetLength(Destination^.ParentID, Length(Source^.ParentID)); Move(Source.ParentID[0], Destination^.ParentID[0], Length(Source^.ParentID)); SetLength(Destination^.StoreID, Length(Source^.StoreID)); Move(Source.StoreID[0], Destination^.StoreID[0], Length(Source^.StoreID)); Destination^.StoreType := Source^.StoreType; end; procedure ClearFolderHead(Value: Pointer); begin if not Assigned(Value) then Exit; PFolderHead(Value).ID := nil; PFolderHead(Value).ParentID := nil; PFolderHead(Value).StoreID := nil; Dispose(PFolderHead(Value)); 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 ClearFolderHead(TreeNode.Data); TreeNode.Data := nil; end; if TreeNode.HasChildren then DeleteChild(TreeNode); TreeNode.DeleteChildren; TreeNode := Node.GetNextChild(TreeNode); end; Node.DeleteChildren; end; function ShellItem(Index: Integer): PMsgHead; function GetID: Integer; var iCount: Integer; LenA: Integer; begin Result := -1; LenA := Length(MsgHeadList); for iCount := 0 to LenA - 1 do if MsgHeadList[iCount].ItemIndex = Index then begin Result := iCount; Exit; end; end; var ItemIndex: Integer; begin Result := nil; ItemIndex := GetID; if ItemIndex < 0 then begin {$IFDEF DEBUG} Beep; {$ENDIF} Exit; end; Result := @MsgHeadList[ItemIndex]; end; procedure TfrmMain.btLogOffClick(Sender: TObject); begin if btLogOff.Tag = 0 then // Log On begin // Get MAPI Session MAPISession := GetMAPISession(Self.Handle, '', MAPI_LOGON_UI); if Assigned(MAPISession) then StoreList := GetMAPIStores(MAPISession); AddStores; end else // Log Off begin ReleaseAll; // Close and clear MAPI Session ReleaseMapiSession(MAPISession, 0); end; btLogOff.Tag := Integer(Assigned(MAPISession)); btLogOff.Caption := strLogOff[Bool(btLogOff.Tag)]; end; procedure TfrmMain.btMsgFilterClick(Sender: TObject); var SmartFilter: TSmartFilter; mr: Integer; begin if not Assigned(MailboxTreeView.Selected) or not Assigned(MailboxTreeView.Selected.Data) or (MailboxTreeView.Selected.Level = 0) then Exit; if not Assigned(MAPITable) then Exit; SmartFilter := TSmartFilter.Create(MAPITable); try with TFrmSmartFilterDialog.Create(Self) do try mr := ShowModal; if mr = mrOK then begin SmartFilter.Subject := Subject; SmartFilter.Size := MessageSize; SmartFilter.TimeAfter := TimeAfter; SmartFilter.TimeBefore := TimeBefore; SmartFilter.Sender := Sender; SmartFilter.Recipient := Recipient; SmartFilter.Unread := Unread; SmartFilter.BodyText := BodyText; SmartFilter.IsOrRelation := IsOrRelation; SmartFilter.SetFilter; end else if mr = mrAbort then SmartFilter.SetFilter(True); if Assigned(FRestriction) then MapiFreeBuffer(FRestriction); FRestriction := nil; if Assigned(SmartFilter.Filter) then MAPICopyRestriction(SmartFilter.Filter, nil, FRestriction); finally Free; end; finally FreeAndNil(SmartFilter); end; if not cbVirtualMsgList.Checked then begin GetMessages(MailboxTreeView.Selected.Data, True); end else begin GetVirtualMessages(MailboxTreeView.Selected.Data, True); MessageListView.Refresh; end; if mr = mrOK then StatusBar.Panels[0].Text := StatusBar.Panels[0].Text + ' || Filtered'; end; procedure TfrmMain.cbVirtualMsgListClick(Sender: TObject); begin if not Assigned(MailboxTreeView.Selected) then Exit; if MailboxTreeView.Selected.Level < 1 then Exit; if not cbVirtualMsgList.Checked then GetMessages(MailboxTreeView.Selected.Data) else GetVirtualMessages(MailboxTreeView.Selected.Data); MessageListView.Refresh; end; procedure TfrmMain.AddStores; var iCount: Integer; LenA: Integer; TreeNode: TTreeNode; begin LenA := Length(StoreList); if LenA < 1 then Exit; for iCount := 0 to LenA - 1 do begin if StoreList[iCount].IsDefault then TreeNode := MailboxTreeView.Items.AddObjectFirst(nil, StoreList[iCount].DisplayName, @StoreList[iCount]) else TreeNode := MailboxTreeView.Items.AddObject(nil, StoreList[iCount].DisplayName, @StoreList[iCount]); // Image Index if StoreList[iCount].IsDefault then TreeNode.ImageIndex := 0 else TreeNode.ImageIndex := 1; TreeNode.SelectedIndex := TreeNode.ImageIndex; TreeNode.Expanded := False; // Add Dummy Node for [+] Icon MailboxTreeView.Items.AddChildObjectFirst(TreeNode, '', nil); end; 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 MAPIStore := GetMAPIStore(MAPISession, StoreID); end; procedure TfrmMain.FormClose(Sender: TObject; var Action: TCloseAction); begin // Clear all MAPI Interfaces ReleaseAll; // Close and clear MAPI Session ReleaseMapiSession(MAPISession); end; procedure TfrmMain.FormCreate(Sender: TObject); begin {$IF DEFINED (WIN64)} Self.Caption := Self.Caption + ' - WIN64'; {$ELSE} Self.Caption := Self.Caption + ' - WIN32'; {$IFEND} MessageListView.Items.Count := 0; FRestriction := nil; MAPITable := nil; MAPIStore := nil; MAPISession := nil; FolderID := nil; // 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_MESSAGE_DELIVERY_TIME; MessageListView.Columns.Items[5].Tag := PR_MESSAGE_SIZE; end; procedure TfrmMain.MailboxTreeViewChange(Sender: TObject; Node: TTreeNode); var iCount: Integer; begin MessageListView.Selected := nil; for iCount := 2 to MessageListView.Columns.Count - 1 do MessageListView.Columns.Items[iCount].ImageIndex := -1; if Assigned(FRestriction) then MapiFreeBuffer(FRestriction); FRestriction := nil; if Node.Level > 0 then begin if not cbVirtualMsgList.Checked then GetMessages(Node.Data) else begin GetVirtualMessages(Node.Data); MessageListView.Refresh; end; end else begin MessageListView.Items.Count := 0; MessageListView.Refresh; 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 (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; if not cbVirtualMsgList.Checked then GetMessages(MailboxTreeView.Selected.Data) else begin GetVirtualMessages(MailboxTreeView.Selected.Data); MessageListView.Refresh; end; SortAscendingOld := SortAscending; ColumnTagOld := ColumnTag; end; procedure TfrmMain.MessageListViewData(Sender: TObject; Item: TListItem); var MsgHead: PMsgHead; begin if not cbVirtualMsgList.Checked then begin if Item.Index > MsgHeadListCount - 1 then Exit; Item.ImageIndex := GetMsgIconIndex(MsgHeadList[Item.Index]); Item.SubItems.Add(''); if MsgHeadList[Item.Index].HasAttachment then Item.SubItemImages[0] := 187 else Item.SubItemImages[0] := -1; Item.SubItems.Add(MsgHeadList[Item.Index].Sender); Item.SubItems.Add(MsgHeadList[Item.Index].Subject); Item.SubItems.Add(DateTimeToStr(MsgHeadList[Item.Index].SentTime)); Item.SubItems.Add(ShowCustomSize(MsgHeadList[Item.Index].Size)); end else begin MsgHead := ShellItem(Item.Index); if not Assigned(MsgHead) then begin MinIndx := Item.Index; MaxIndx := Item.Index + 50; GetVirtualMessages(MailboxTreeView.Selected.Data); MsgHead := ShellItem(Item.Index); end; if not Assigned(MsgHead) then Exit; Item.ImageIndex := GetMsgIconIndex(MsgHead^); Item.SubItems.Add(''); if MsgHead^.HasAttachment then Item.SubItemImages[0] := 187 else Item.SubItemImages[0] := -1; Item.SubItems.Add(MsgHead^.Sender); Item.SubItems.Add(MsgHead^.Subject); Item.SubItems.Add(DateTimeToStr(MsgHead^.SentTime)); Item.SubItems.Add(ShowCustomSize(MsgHead^.Size)); end; end; procedure TfrmMain.MessageListViewDataHint(Sender: TObject; StartIndex, EndIndex: Integer); begin if not cbVirtualMsgList.Checked then Exit; if (StartIndex < MinIndx) or (EndIndex > MaxIndx) then begin MinIndx := StartIndex; MaxIndx := EndIndex; GetVirtualMessages(MailboxTreeView.Selected.Data); end; end; procedure TfrmMain.ReleaseAll; var Node: TTreeNode; Cursor: TCursor; begin if Assigned(FRestriction) then MapiFreeBuffer(FRestriction); FRestriction := nil; Cursor := Screen.Cursor; Screen.Cursor := crHourGlass; try MessageListView.Items.BeginUpdate; try MessageListView.Items.Count := 0; MessageListView.Clear; ClearMsgHeadList; finally MessageListView.Items.EndUpdate; end; MailboxTreeView.Items.BeginUpdate; MessageListView.Items.BeginUpdate; try Node := MailboxTreeView.Items.GetFirstNode; while Assigned(Node) do begin DeleteChild(Node); Node.Delete; Node := MailboxTreeView.Items.GetFirstNode; end; MailboxTreeView.Items.Clear; finally MessageListView.Items.EndUpdate; MailboxTreeView.Items.EndUpdate; end; ClearStoreList; MAPITable := nil; if Assigned(MAPIStore) then ReleaseMsgStore(MAPIStore); MAPIStore := nil; StatusBar.Panels[0].Text:=''; finally Screen.Cursor := Cursor; end; end; procedure TfrmMain.ExpandLevel(Node: TTreeNode); var iCount: Integer; isStore: Boolean; MAPIFolder: IMAPIFolder; FolderList: TFoldersHeadList; FolderHead: PFolderHead; TreeNode: TTreeNode; 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 FolderList := GetMAPIFolderList(MAPIStore) else begin MAPIFolder := GetMAPIFolder(MAPIStore, PFolderHead(Node.Data)^.ID); FolderList := GetMAPIFolderList(MAPIFolder); end; for iCount := 0 to Length(FolderList) - 1 do begin New(FolderHead); CopyFolderHead(@FolderList[iCount], FolderHead); TreeNode := MailboxTreeView.Items.AddChildObject(Node, FolderHead^.DisplayName, FolderHead); TreeNode.ImageIndex := GetFldIconIndex(FolderHead.FolderType); TreeNode.SelectedIndex := TreeNode.ImageIndex; // Add Dummy Node for [+] Icon if FolderHead.HasSubFolders then MailboxTreeView.Items.AddChildObject(TreeNode, '', nil); 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 ClearFolderHead(TreeNode.Data); 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 if not cbVirtualMsgList.Checked then GetMessages(Node.Data) else GetVirtualMessages(Node.Data); end; // Add Dummy Node for [+] Icon if isStore or PFolderHead(Node.Data)^.HasSubFolders then MailboxTreeView.Items.AddChildObjectFirst(Node, '', nil); end; procedure TfrmMain.GetMessages(P: Pointer; const FromFilter: Boolean = False); var FolderHead: PFolderHead; MAPIFolder: IMAPIFolder; ProgresBar: TProgressBar; begin ClearMsgHeadList; MsgHeadListCount := 0; MessageListView.Items.Count := 0; MessageListView.Refresh; if not Assigned(P) then Exit; FolderHead := PFolderHead(P); if not IsSameBytes(FolderHead^.ID, FolderID) or ((SortAscendingOld <> SortAscending) or (ColumnTagOld <> ColumnTag)) then begin CheckStore(FolderHead^.StoreID); MAPIFolder := GetMAPIFolder(MAPIStore, FolderHead^.ID); MAPITable := GetMsgTable(MAPIFolder, ColumnTag, SortAscending); SetLength(FolderID, Length(FolderHead^.ID)); Move(FolderHead^.ID[0], FolderID[0], Length(FolderHead^.ID)); end; if not FromFilter and Assigned(FRestriction) then begin hr := MAPITable.Restrict(FRestriction, TBL_BATCH); if failed(hr) then raise EMAPIError.CreateMAPI(MAPITable, hr); end; ProgresBar := TProgressBar.Create(Self); try ProgresBar.Max := FolderHead^.MsgCount; ProgresBar.Step := 1; ProgresBar.Parent := StatusBar; ProgresBar.Left := StatusBar.Panels[0].Width + 3; ProgresBar.Top := 3; ProgresBar.Height := StatusBar.Height - 4; ProgresBar.Width := 300; MsgHeadList := GetMessageList(MAPITable, ProgresBar, ColumnTag, SortAscending); MsgHeadListCount := Length(MsgHeadList); finally // Force virtual ListView to render items if MsgHeadListCount <> MessageListView.Items.Count then begin MessageListView.Items.Count := MsgHeadListCount; MessageListView.Refresh; end; if Assigned(ProgresBar) then FreeAndNil(ProgresBar); end; StatusBar.Panels[0].Text := 'Message Count: ' + IntToStr(GetTableRowCount(MAPITable)) + ' in ' + FolderHead^.DisplayName; if not FromFilter and Assigned(FRestriction) then StatusBar.Panels[0].Text := StatusBar.Panels[0].Text + ' || Filtered'; Application.ProcessMessages; end; procedure TfrmMain.GetVirtualMessages(P: Pointer; const FromFilter: Boolean = False); var FolderHead: PFolderHead; MAPIFolder: IMAPIFolder; ProgresBar: TProgressBar; begin ClearMsgHeadList; MsgHeadListCount := 0; if not Assigned(P) then Exit; FolderHead := PFolderHead(P); if not IsSameBytes(FolderHead^.ID, FolderID) or ((SortAscendingOld <> SortAscending) or (ColumnTagOld <> ColumnTag)) then begin CheckStore(FolderHead^.StoreID); MAPIFolder := GetMAPIFolder(MAPIStore, FolderHead^.ID); MAPITable := GetMsgTable(MAPIFolder, ColumnTag, SortAscending); SetLength(FolderID, Length(FolderHead^.ID)); Move(FolderHead^.ID[0], FolderID[0], Length(FolderHead^.ID)); end; if not FromFilter and Assigned(FRestriction) then begin hr := MAPITable.Restrict(FRestriction, TBL_BATCH); if failed(hr) then raise EMAPIError.CreateMAPI(MAPITable, hr); end; ProgresBar := TProgressBar.Create(Self); try ProgresBar.Max := FolderHead^.MsgCount; ProgresBar.Step := 1; ProgresBar.Parent := StatusBar; ProgresBar.Left := StatusBar.Panels[0].Width + 3; ProgresBar.Top := 3; ProgresBar.Height := StatusBar.Height - 4; ProgresBar.Width := 300; MsgHeadList := GetMessageList(MAPITable, MinIndx, MaxIndx, ProgresBar); if Assigned(FRestriction) then MsgHeadListCount := GetTableRowCount(MAPITable) else MsgHeadListCount := FolderHead^.MsgCount; finally if MsgHeadListCount <> MessageListView.Items.Count then begin MessageListView.Items.Count := MsgHeadListCount; StatusBar.Panels[0].Text := 'Message Count: ' + IntToStr(MsgHeadListCount) + ' in ' + FolderHead^.DisplayName; if not FromFilter and Assigned(FRestriction) then StatusBar.Panels[0].Text := StatusBar.Panels[0].Text + ' || Filtered'; end; if Assigned(ProgresBar) then FreeAndNil(ProgresBar); end; end; end.