Copyright © 2024 IMIBO. Privacy Statement
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.