unit unMain;

interface

{$I IMI.INC}

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

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
  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 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 + Profiles.Strings[iCount] + ' - ' + 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 := GetFoldersRoot(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.Clear;
    finally
      MessageListView.Items.EndUpdate;
    end;

    MailboxTreeView.Items.BeginUpdate;
    MessageListView.Items.BeginUpdate;
    try
      Node := MailboxTreeView.Items.GetFirstNode;
      while Assigned(Node) do
      begin
        if Node.Expanded then
          Node.Collapse(True);
        Node.DeleteChildren;
        Node := Node.GetNext;
      end;
      MailboxTreeView.Items.Clear;
    finally
      MessageListView.Items.EndUpdate;
      MailboxTreeView.Items.EndUpdate;
    end;

    StoreList := nil;
    if Assigned(MAPIStore) then
      ReleaseMsgStore(MAPIStore);
    MAPIStore := nil;
  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 IsSameTBytes(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;

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

    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 IsSameTBytes(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 IsSameTBytes(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 IsSameTBytes(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.