Development

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.
Download LazyMAPI #4 as Compiled Application
Download Project (DELPHI 10.4) ZIP file
Source Code: In package