Development

Extended MAPI in DELPHI

LazyMAPI # 2

Test Session/Store/Folder Functions

This “test” application show how developer can uses functions
GetProfiles, GetMAPISession, ReleaseMapiSession, GetMAPIStores, ReleaseMsgStore, GetFoldersRoot, GetMAPIFolder, GetMAPIFolderKnowType, IsSpecialFolder, CreateMapiSubFolder, DeleteMapiSubFolder, CopyOrMoveMapiSubFolder, EmptyMapiFolder, GetMsgTable, GetTableRowCount, DeleteMapiMessages, CopyOrMoveMapiMessages
and
TStoreHead, TStoresHeadList, TFolderHead, TFoldersHeadList, TMsgHead, TMsgHeadList
uses “shared” forms:
TFrmNewFolder, TFrmFolderCopyMove
unit unMain;

interface

{$I IMI.INC}

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls, ExtendedMAPI, IMIEMTypes, ComCtrls, ImgList,
  Menus, System.ImageList;

type
  TfrmMain = class(TForm)
    Panel1: TPanel;
    btLogOff: TButton;
    MailboxTreeView: TTreeView;
    Splitter1: TSplitter;
    StatusBar: TStatusBar;
    FolderListIcons: TImageList;
    MessageListView: TListView;
    MessageListIcons: TImageList;
    cbVirtualMsgList: TCheckBox;
    FolderPopupMenu: TPopupMenu;
    CreateSubFolderMenu: TMenuItem;
    DeleteFolderMenu: TMenuItem;
    N1: TMenuItem;
    EmptyFolderMenu: TMenuItem;
    N2: TMenuItem;
    CopyFolderMenu: TMenuItem;
    MoveFolderMenu: TMenuItem;
    MessagesPopMenu: TPopupMenu;
    CopyMessagesToMenu: TMenuItem;
    MoveMessagesToMenu: TMenuItem;
    N3: TMenuItem;
    DeleteMessagesMenu: TMenuItem;
    N4: TMenuItem;
    SelectAllMessagesMenu: TMenuItem;
    btProfiles: TButton;
    procedure btLogOffClick(Sender: TObject);
    procedure MailboxTreeViewExpanding(Sender: TObject; Node: TTreeNode; var AllowExpansion: Boolean);
    procedure FormCreate(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure MailboxTreeViewCollapsing(Sender: TObject; Node: TTreeNode; var AllowCollapse: Boolean);
    procedure MailboxTreeViewChange(Sender: TObject; Node: TTreeNode);
    procedure MessageListViewData(Sender: TObject; Item: TListItem);
    procedure MessageListViewColumnClick(Sender: TObject; Column: TListColumn);
    procedure cbVirtualMsgListClick(Sender: TObject);
    procedure MessageListViewDataHint(Sender: TObject; StartIndex, EndIndex: Integer);
    procedure CreateSubFolderMenuClick(Sender: TObject);
    procedure DeleteFolderMenuClick(Sender: TObject);
    procedure EmptyFolderMenuClick(Sender: TObject);
    procedure CopyFolderMenuClick(Sender: TObject);
    procedure MoveFolderMenuClick(Sender: TObject);
    procedure SelectAllMessagesMenuClick(Sender: TObject);
    procedure DeleteMessagesMenuClick(Sender: TObject);
    procedure CopyMessagesToMenuClick(Sender: TObject);
    procedure MessageListViewMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
    procedure MoveMessagesToMenuClick(Sender: TObject);
    procedure btProfilesClick(Sender: TObject);
  private
    { Private declarations }
    MAPISession: IMAPISession;
    MAPIStore: IMsgStore;
    FisExit: Boolean;
    procedure AddStores;
    procedure CheckStore(StoreID: TBytes);
    procedure ReleaseAll;
    procedure ExpandLevel(Node: TTreeNode);
    procedure CollapseLevel(Node: TTreeNode);
    procedure GetMessages(P: Pointer);
    procedure GetVirtualMessages(P: Pointer);
    procedure CopyOrMoveFolder(const ActionMove: Boolean);
    procedure CopyOrMoveMessages(const ActionMove: Boolean);
    procedure RefreshNode(DestinationStoreID, DestinationFolderEntryID: TBytes); overload;
    procedure RefreshNode(const Node: TTreeNode); overload;
    procedure RefreshNodeEx(const Node: TTreeNode);
    procedure DeleteMessages;
    procedure RefreshMessageList(const Node: TTreeNode);
  public
    { Public declarations }
  end;

var
  frmMain: TfrmMain;

implementation

uses
{$IFDEF DELPHI2011XE2} UITypes, {$ENDIF} DateUtils, MAPIUtils, MAPISessionUtils, MAPIFldUtils, MAPIProgress,
  NewFolderFrm, FolderCopyOrMoveFrm;
{$R *.dfm}

var
  StoreList: TStoresHeadList = nil;
  MsgHeadList: TMsgHeadList = nil;
  MsgHeadListCount: Integer = 0;

  ColumnIndex: Integer = -1;
  SortAscending: Boolean = True;
  ColumnTag: Cardinal = 0;

  MinIndx: Integer = 0;
  MaxIndx: Integer = 50;

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;
    FolderPopupMenu.AutoPopup := True;
    FisExit := False;
  end
  else
  // Log Off
  begin
    FisExit := True;
    FolderPopupMenu.AutoPopup := False;
    ReleaseAll;
    // Close and clear MAPI Session
    ReleaseMapiSession(MAPISession);
  end;
  btLogOff.Tag := Integer(Assigned(MAPISession));
  btLogOff.Caption := strLogOff[Bool(btLogOff.Tag)];
end;

procedure TfrmMain.btProfilesClick(Sender: TObject);
var
  Profiles: TStrings;
  iCount: Integer;
  TempString: string;
begin
  Profiles := GetProfiles;
  if not Assigned(Profiles) then
    Exit;

  TempString := 'Profiles:' + CRLF + CRLF;
  for iCount := 0 to Profiles.Count - 1 do
  begin
    TempString := TempString + 'Profile : ' + Profiles.Strings[iCount] + ' | is Default: ' + BoolToStr(Boolean(Integer(Profiles.Objects[iCount])), True) + CRLF;
  end;
  ShowMessage(TempString);
  FreeAndNil(Profiles);
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.CreateSubFolderMenuClick(Sender: TObject);
var
  Node: TTreeNode;
  Folder, NewFolder: IMAPIFolder;
  FldName, FldComment, FldStrType: string;
  FldType: TMAPIFldType;
begin

  if not Assigned(MailboxTreeView.Selected) then
    Exit;
  Node := MailboxTreeView.Selected;
  if Node.Level = 0 then
    Folder := GetTopFolder(MAPIStore)  // GetRootFolder(MAPIStore)
  else
    Folder := GetMAPIFolder(MAPIStore, PFolderHead(Node.Data)^.ID);

  FldName := '';
  FldComment := '';
  FldStrType := '';

  with TFrmNewFolder.Create(Self) do
  begin
    if ShowModal = mrOk then
    begin
      FldName := FolderName;
      FldComment := FolderComment;
      FldStrType := FolderType;
    end;
    Free;
  end;

  NewFolder := nil;

  if (FldName <> '') then
  begin
    FldType := GetMAPIFolderKnowType(FldStrType);
    NewFolder := CreateMapiSubFolder(Folder, FldType, FldName, FldComment);
    RefreshNodeEx(Node);
  end;
end;

procedure TfrmMain.DeleteFolderMenuClick(Sender: TObject);
var
  Node: TTreeNode;
  ParentFolder: IMAPIFolder;
  MAPIProgrs: IMAPIProgress;
begin
  if not Assigned(MailboxTreeView.Selected) or
    (MailboxTreeView.Selected.Level = 0) // Store !
    or ((MessageDlg('Warning!!!'#13#10#13#10'All messages and SubFolders will be deleted with no option for recovery!'#13#10#13#10'Continue? ',
    mtConfirmation, [mbNo, mbYES], 0) <> mrYES)) then
    Exit;

  Node := MailboxTreeView.Selected;

  if IsSpecialFolder(MAPIStore, PFolderHead(Node.Data)^.ID) then
  begin
    MessageDlg('Warning!!! '#13#10#13#10'You cannot delete a system folder!',
      mtError, [mbOK], 0);
    Exit;
  end;

  ParentFolder := GetMAPIFolder(MAPIStore, PFolderHead(Node.Data)^.ParentID);

  MAPIProgrs := TMAPIProgress.Create(Self, ' Deleting... ');
  DeleteMapiSubFolder(ParentFolder, PFolderHead(Node.Data)^.ID, MAPIProgrs, Self.Handle);

  Node := MailboxTreeView.Selected.Parent;
  RefreshNodeEx(Node);
end;

procedure TfrmMain.DeleteMessagesMenuClick(Sender: TObject);
begin
  if (MessageDlg
    ('Warning!!!'#13#10#13#10'All messages will be erased with no option for recovery!'#13#10#13#10'Continue?',
    mtConfirmation, [mbOK, mbAbort], 0) <> mrOk) then
    Exit;

  DeleteMessages;
end;

procedure TfrmMain.ReleaseAll;
var
  Node: TTreeNode;
  Cursor: TCursor;
begin
  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;
    if Assigned(MAPIStore) then
      ReleaseMsgStore(MAPIStore);
    MAPIStore := nil;
   StatusBar.Panels[0].Text:='';
  finally
    Screen.Cursor := Cursor;
  end;
end;

procedure TfrmMain.SelectAllMessagesMenuClick(Sender: TObject);
begin
  MessageListView.SelectAll;
end;

procedure TfrmMain.MailboxTreeViewChange(Sender: TObject; Node: TTreeNode);
var
  iCount: Integer;
begin
  if FisExit then
    Exit;

  MessageListView.Selected := nil;

  for iCount := 2 to MessageListView.Columns.Count - 1 do
    MessageListView.Columns.Items[iCount].ImageIndex := -1;

  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
  begin
    for iCount := 0 to FolderPopupMenu.Items.Count - 1 do
      FolderPopupMenu.Items[iCount].Enabled := True;
    DeleteFolderMenu.Enabled := not IsSpecialFolder(MAPIStore,
      PFolderHead(Node.Data).ID);
    MoveFolderMenu.Enabled := DeleteFolderMenu.Enabled;
  end
  else
  begin
    for iCount := 0 to FolderPopupMenu.Items.Count - 1 do
      FolderPopupMenu.Items[iCount].Enabled := False;
    CreateSubFolderMenu.Enabled := True;
    StatusBar.Panels[0].Text := PStoreHead(Node.Data).DisplayName;
  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.CopyOrMoveFolder(const ActionMove: Boolean);
var
  MAPIProgrs: IMAPIProgress;
  Node: TTreeNode;
  mr: Integer;
  SourceParentFolder, DestFolder: IMAPIFolder;
  DestinationEntryID, DestinationStoreID: TBytes;
  DestStore: IMsgStore;
begin
  Node := MailboxTreeView.Selected;
  if not Assigned(Node) or (Node.Level < 1) then
    Exit;

  SourceParentFolder := nil;
  DestFolder := nil;
  DestStore := nil;
  MAPIProgrs := nil;

  with TFrmFolderCopyMove.Create(Self) do
  begin
    try
      SetSession(MAPISession);
      Caption := ' Copy folder';
      lbAction.Caption := 'Copy to folder:';

      mr := ShowModal;
      if (mr = mrOk) and (Length(TargetEntryID) > 0) then
      begin
        SetLength(DestinationEntryID, Length(TargetEntryID));
        Move(TargetEntryID[0], DestinationEntryID[0], Length(TargetEntryID));

        SetLength(DestinationStoreID, Length(TargetStoreID));
        Move(TargetStoreID[0], DestinationStoreID[0], Length(TargetStoreID));
      end
      else
        mr := mrCancel;
    finally
      Free;
    end;
  end;

  if mr <> mrOk then
    Exit;

  // We need a parent folder
  SourceParentFolder := GetMAPIFolder(MAPIStore, PFolderHead(Node.Data)^.ParentID);

  if IsSameBytes(DestinationStoreID, PFolderHead(Node.Data)^.StoreID) then
  begin
    DestFolder := GetMAPIFolder(MAPIStore, DestinationEntryID);
  end
  else
  begin
    DestStore := GetMAPIStore(MAPISession, DestinationStoreID);
    DestFolder := GetMAPIFolder(DestStore, DestinationEntryID);
  end;

  MAPIProgrs := TMAPIProgress.Create(Self, ' Copying folder ' + Node.Text);
  Try
    CopyOrMoveMapiSubFolder(SourceParentFolder, PFolderHead(Node.Data)^.ID,
      DestFolder, ActionMove, '', True, MAPIProgrs, Self.Handle);
  Finally
    MAPIProgrs := nil;
    if Assigned(DestStore) then
      ReleaseMsgStore(DestStore);
  End;

  RefreshNode(DestinationStoreID, DestinationEntryID);
end;

procedure TfrmMain.CopyFolderMenuClick(Sender: TObject);
begin
  CopyOrMoveFolder(False);
end;

procedure TfrmMain.CopyMessagesToMenuClick(Sender: TObject);
begin
  CopyOrMoveMessages(False);
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;
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.MessageListViewMouseDown(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  MessagesPopMenu.AutoPopup := Assigned(MessageListView.Selected);
end;

procedure TfrmMain.MoveFolderMenuClick(Sender: TObject);
begin
  CopyOrMoveFolder(True);
end;

procedure TfrmMain.MoveMessagesToMenuClick(Sender: TObject);
begin
  CopyOrMoveMessages(True);
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.EmptyFolderMenuClick(Sender: TObject);
var
  Node: TTreeNode;
  MAPIFolder: IMAPIFolder;
  MAPIProgrs: IMAPIProgress;
begin
  Node := MailboxTreeView.Selected;

  if (not Assigned(Node) or (Node.Level = 0)) // Store !
    or (MessageDlg('Warning!!! ' + #13#10 +
    'All messages and subfolders will be deleted with no option for recovery!' +
    #13#10 + 'Continue?', mtConfirmation, [mbOK, mbAbort], 0) <> mrOk) then
    Exit;

  MAPIProgrs := TMAPIProgress.Create(Self, ' Deleting... ');

  MAPIFolder := GetMAPIFolder(MAPIStore, PFolderHead(Node.Data)^.ID);
  EmptyMapiFolder(MAPIFolder, MAPIProgrs, Self.Handle);

  RefreshNodeEx(Node);

  RefreshNode(Node);
  RefreshMessageList(Node);

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)
  else
    CheckStore(PFolderHead(Node.Data)^.StoreID);

  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.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  FisExit := True;
  // 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;

  MAPIStore := nil;
  MAPISession := 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;

  FolderPopupMenu.AutoPopup := False;

end;

procedure TfrmMain.GetVirtualMessages(P: Pointer);
var
  FolderHead: PFolderHead;
  MAPIFolder: IMAPIFolder;
  ProgresBar: TProgressBar;
  StartTime: TDateTime;
begin
  StatusBar.Panels[0].Text := '';
  if not Assigned(P) then
    Exit;
  StartTime := Now;

  FolderHead := PFolderHead(P);

  CheckStore(FolderHead^.StoreID);

  MAPIFolder := GetMAPIFolder(MAPIStore, FolderHead^.ID);

  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;

    ClearMsgHeadList;

    MsgHeadList := GetMessageList(MAPIFolder, MinIndx, MaxIndx, ProgresBar,
      ColumnTag, SortAscending);
    MsgHeadListCount := FolderHead^.MsgCount;
  finally
    if MsgHeadListCount <> MessageListView.Items.Count then
    begin
      MessageListView.Items.Count := MsgHeadListCount;
    end;
    StatusBar.Panels[0].Text := 'Message Count: ' + IntToStr(MsgHeadListCount) +
      ' in ' + FolderHead^.DisplayName;
    if Assigned(ProgresBar) then
      FreeAndNil(ProgresBar);
    StatusBar.Panels[0].Text := StatusBar.Panels[0].Text + ' | ' +
      IntToStr(MilliSecondsBetween(StartTime, Now)) + ' MilliSeconds';
  end;

end;

procedure TfrmMain.GetMessages(P: Pointer);
var
  FolderHead: PFolderHead;
  MAPIFolder: IMAPIFolder;
  ProgresBar: TProgressBar;
  StartTime: TDateTime;
begin
  StartTime := Now;
  ClearMsgHeadList;
  MsgHeadListCount := 0;
  MessageListView.Items.Count := 0;
  MessageListView.Refresh;

  if not Assigned(P) then
    Exit;
  FolderHead := PFolderHead(P);

  CheckStore(FolderHead^.StoreID);

  MAPIFolder := GetMAPIFolder(MAPIStore, FolderHead^.ID);
  StatusBar.Panels[0].Text := 'Message Count: ' + IntToStr(FolderHead^.MsgCount)
    + ' in ' + FolderHead^.DisplayName;
  Application.ProcessMessages;

  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;

    ClearMsgHeadList;
    MsgHeadList := GetMessageList(MAPIFolder, 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);
    StatusBar.Panels[0].Text := StatusBar.Panels[0].Text + ' | ' +
      IntToStr(MilliSecondsBetween(StartTime, Now)) + ' MilliSeconds';
  end;
end;

procedure TfrmMain.DeleteMessages;
var
  Count: Integer;
  Item: TListItem;
  MAPIProgrs: IMAPIProgress;
  EntryIDList: array of TBytes;
  Indx: Integer;
  MsgHead: PMsgHead;
  MsgHeadV: TMsgHead;
  ItemIndex: Integer;
  MAPIFolder: IMAPIFolder;
  MAPITable: IMAPITable;
begin
  if not Assigned(MailboxTreeView.Selected) or
    not Assigned(MailboxTreeView.Selected.Parent) or
    (MessageListView.Selected = nil) then
    Exit;
  MAPIProgrs := nil;
  Count := MessageListView.SelCount;
  if Count = 0 then
    Exit;

  SetLength(EntryIDList, Count);

  Item := MessageListView.Selected;
  Count := 0;
  Indx := 0;

  MAPIFolder := GetMAPIFolder(MAPIStore,
    PFolderHead(MailboxTreeView.Selected.Data)^.ID);

  // is Virtual List
  if cbVirtualMsgList.Checked then
  begin
    MAPITable := GetMsgTable(MAPIFolder, ColumnTag, SortAscending);
    Count := GetTableRowCount(MAPITable);
  end;

  while Item <> nil do
  begin
    ItemIndex := Item.Index;
    MsgHead := ShellItem(ItemIndex);
    if not Assigned(MsgHead) and cbVirtualMsgList.Checked then
    begin
      MsgHeadV := GetMsgHead(MAPITable, ItemIndex, Count);
      if ItemIndex = MsgHeadV.ItemIndex then
      begin
        SetLength(EntryIDList[Indx], Length(MsgHeadV.ID));
        Move(MsgHeadV.ID[0], EntryIDList[Indx][0], Length(MsgHeadV.ID));
      end;
    end
    else
    begin
      SetLength(EntryIDList[Indx], Length(MsgHead^.ID));
      Move(MsgHead^.ID[0], EntryIDList[Indx][0], Length(MsgHead^.ID));
    end;

    Item := MessageListView.GetNextItem(Item, sdAll, [isSelected]);
    Inc(Indx);
  end;

  Assert(Indx = Length(EntryIDList));

  MAPIProgrs := TMAPIProgress.Create(Self, ' Deleting messages ');
  Try
    DeleteMapiMessages(MAPIFolder, EntryIDList, nil, MAPIProgrs, Self.Handle);
  Finally
    MAPIProgrs := nil;
  End;
  RefreshNode(PFolderHead(MailboxTreeView.Selected.Data)^.StoreID,
    PFolderHead(MailboxTreeView.Selected.Data)^.ID);

end;

procedure TfrmMain.RefreshNode(const Node: TTreeNode);
var
  UpdatedFolderHead: TFolderHead;
  FolderHead: PFolderHead;
begin
  UpdatedFolderHead := GetMAPIFolderHead(MAPISession,
    PFolderHead(Node.Data)^.ID);
  ClearFolderHead(Node.Data);
  New(FolderHead);
  CopyFolderHead(@UpdatedFolderHead, FolderHead);
  Node.Data := FolderHead;
end;

procedure TfrmMain.RefreshNode(DestinationStoreID,
  DestinationFolderEntryID: TBytes);
var
  iCount: Integer;
  Node: TTreeNode;
begin
  Node := nil;
  for iCount := 0 to MailboxTreeView.Items.Count - 1 do
  begin
    if not Assigned(MailboxTreeView.Items[iCount].Data) then
      Continue;
    Node := MailboxTreeView.Items[iCount];
    if IsSameBytes(DestinationFolderEntryID, PFolderHead(Node.Data)^.ID) then
      break;
    Node := nil;
  end;

  if not Assigned(Node) then
  begin
    for iCount := 0 to MailboxTreeView.Items.Count - 1 do
    begin
      if (MailboxTreeView.Items[iCount].Level > 0) or
        (not Assigned(MailboxTreeView.Items[iCount].Data)) then
        Continue;
      Node := MailboxTreeView.Items[iCount];
      if IsSameBytes(DestinationStoreID, PFolderHead(Node.Data)^.ID) then
        break;
      Node := nil;
    end;
  end;

  if Assigned(Node) then
  begin
    if Node.Level > 0 then
      RefreshNode(Node);
    RefreshNodeEx(Node);
  end;

end;

procedure TfrmMain.RefreshNodeEx(const Node: TTreeNode);
var
  AllowColapse: Boolean;
begin
  MailboxTreeViewCollapsing(nil, Node, AllowColapse);
  Node.Collapse(True);
  MailboxTreeViewExpanding(nil, Node, AllowColapse);
  Node.Expand(False);
  StatusBar.Panels[0].Text := '';
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.CopyOrMoveMessages(const ActionMove: Boolean);
var
  Count: Integer;
  Item: TListItem;
  MAPIFolder: IMAPIFolder;
  MAPITable: IMAPITable;
  EntryIDList: array of TBytes;
  Indx: Integer;
  MsgHead: PMsgHead;
  MsgHeadV: TMsgHead;
  ItemIndex: Integer;
  mr: Integer;
  DestinationEntryID, DestinationStoreID: TBytes;
  SourceFolder: IMAPIFolder;
  TargetFolder: IMAPIFolder;
  TargetStore: IMsgStore;
  MAPIProgrs: IMAPIProgress;
begin
  if not Assigned(MailboxTreeView.Selected) or
    not Assigned(MailboxTreeView.Selected.Parent) or
    (MessageListView.Selected = nil) then
    Exit;
  MAPIProgrs := nil;
  Count := MessageListView.SelCount;
  if Count = 0 then
    Exit;

  with TFrmFolderCopyMove.Create(Self) do
  begin
    SetSession(MAPISession, False);
    Caption := ' Copy messages';
    lbAction.Caption := 'Copy to folder:';

    mr := ShowModal;
    if (mr = mrOk) and (Length(TargetEntryID) > 0) then
    begin
      SetLength(DestinationEntryID, Length(TargetEntryID));
      Move(TargetEntryID[0], DestinationEntryID[0], Length(TargetEntryID));

      SetLength(DestinationStoreID, Length(TargetStoreID));
      Move(TargetStoreID[0], DestinationStoreID[0], Length(TargetStoreID));
    end
    else
      mr := mrCancel;
    Free;
  end;

  if mr <> mrOk then
    Exit;

  SetLength(EntryIDList, Count);

  Item := MessageListView.Selected;
  Count := 0;
  Indx := 0;
  TargetStore := nil;

  CheckStore(PFolderHead(MailboxTreeView.Selected.Data)^.StoreID);

  // is Virtual List
  if cbVirtualMsgList.Checked then
  begin
    MAPIFolder := GetMAPIFolder(MAPIStore,
      PFolderHead(MailboxTreeView.Selected.Data)^.ID);
    MAPITable := GetMsgTable(MAPIFolder, ColumnTag, SortAscending);
    Count := GetTableRowCount(MAPITable);
  end;

  while Item <> nil do
  begin
    ItemIndex := Item.Index;
    MsgHead := ShellItem(ItemIndex);
    if not Assigned(MsgHead) and cbVirtualMsgList.Checked then
    begin
      MsgHeadV := GetMsgHead(MAPITable, ItemIndex, Count);
      if ItemIndex = MsgHeadV.ItemIndex then
      begin
        SetLength(EntryIDList[Indx], Length(MsgHeadV.ID));
        Move(MsgHeadV.ID[0], EntryIDList[Indx][0], Length(MsgHeadV.ID));
      end;
    end
    else
    begin
      SetLength(EntryIDList[Indx], Length(MsgHead^.ID));
      Move(MsgHead^.ID[0], EntryIDList[Indx][0], Length(MsgHead^.ID));
    end;

    Item := MessageListView.GetNextItem(Item, sdAll, [isSelected]);
    Inc(Indx);
  end;

  Assert(Indx = Length(EntryIDList));

  // We need a parent folder
  SourceFolder := GetMAPIFolder(MAPIStore,
    PFolderHead(MailboxTreeView.Selected.Data)^.ID);

  if IsSameBytes(DestinationStoreID, PFolderHead(MailboxTreeView.Selected.Data)
    ^.StoreID) then
  begin
    TargetFolder := GetMAPIFolder(MAPIStore, DestinationEntryID);
  end
  else
  begin
    TargetStore := GetMAPIStore(MAPISession, DestinationStoreID);
    TargetFolder := GetMAPIFolder(TargetStore, DestinationEntryID);
  end;

  MAPIProgrs := TMAPIProgress.Create(Self, ' Copying messages ');
  Try
    CopyOrMoveMapiMessages(SourceFolder, TargetFolder, EntryIDList, ActionMove,
      MAPIProgrs, Self.Handle);
  Finally
    MAPIProgrs := nil;
    if Assigned(TargetStore) then
      ReleaseMsgStore(TargetStore);
  End;
  RefreshNode(DestinationStoreID, DestinationEntryID);
end;

procedure TfrmMain.RefreshMessageList(const Node: TTreeNode);
begin
  if not Assigned(Node) then
    Exit;

  if not cbVirtualMsgList.Checked then
    GetMessages(Node.Data)
  else
    GetVirtualMessages(Node.Data);

  MessageListView.Refresh;

  StatusBar.Panels[0].Text := 'Message Count: ' +
    IntToStr(PFolderHead(Node.Data)^.MsgCount) + ' in ' + PFolderHead(Node.Data)^.DisplayName;

end;

end.
Download LazyMAPI #2 as Compiled Application
Download Project (DELPHI 10.4) ZIP file
Source Code: In package