unit uMain;
{
Please add
..\..\Library;..\..\Library\Helpers;..\Forms;
to project search path
}
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ExtCtrls, Buttons, ComCtrls, ImgList, Menus, ExtendedMAPI, IMIEMTypes;
type
TfrmMain = class(TForm)
plTOP: TPanel;
btLogOn: TSpeedButton;
btLogOff: TSpeedButton;
rgProfile: TRadioGroup;
MessageListIcons: TImageList;
StatusBar: TStatusBar;
FolderListIcons: TImageList;
Splitter1: TSplitter;
MessageListView: TListView;
MailboxTreeView: TTreeView;
btFastMdgFilter: TButton;
procedure btLogOnClick(Sender: TObject);
procedure btLogOffClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure MailboxTreeViewExpanding(Sender: TObject; Node: TTreeNode; var AllowExpansion: Boolean);
procedure MailboxTreeViewCollapsing(Sender: TObject; Node: TTreeNode; var AllowCollapse: Boolean);
procedure MailboxTreeViewChange(Sender: TObject; Node: TTreeNode);
procedure MessageListViewColumnClick(Sender: TObject; Column: TListColumn);
procedure MessageListViewData(Sender: TObject; Item: TListItem);
procedure MessageListViewDblClick(Sender: TObject);
procedure btFastMdgFilterClick(Sender: TObject);
private
{ Private declarations }
hr: HRESULT;
MAPISession: IMAPISession;
MAPIStore: IMsgStore;
DATAFolder: IMAPIFolder;
procedure ClearMAPIObjects;
procedure BuildFolderTree;
procedure ExpandLevel(Node: TTreeNode);
procedure CollapseLevel(Node: TTreeNode);
procedure CheckStore(StoreID: TBytes);
procedure GetMessages(P: Pointer);
public
{ Public declarations }
end;
var
frmMain: TfrmMain;
implementation
uses DateUtils, EDK, MAPIUtils, MAPIException, MAPISessionUtils, MAPIFldUtils, MAPIPropUtils,
MAPITable, MessageFrm;
{$R *.dfm}
var
SpecialFoldersList: TSpecialFoldersList = nil;
MessagesTable: TMAPITable = nil;
ColumnIndex: Integer = -1;
SortAscending: Boolean = True;
ColumnTag: Cardinal = 0;
SortAscendingOld: Boolean = True;
ColumnTagOld: Cardinal = 0;
FolderID: TBytes = nil;
procedure ClearSpecialFoldersList;
var
iCount: Integer;
begin
for iCount := 0 to Length(SpecialFoldersList) - 1 do
SpecialFoldersList[iCount].EntryID := nil;
SpecialFoldersList := nil;
end;
function GetFolderType(FolderClass: string; ID: TBytes): TMAPIFldType;
var
iCount: Integer;
begin
Result := oFolderUndefined;
for iCount := 0 to Length(SpecialFoldersList) - 1 do
if IsSameTBytes(ID, SpecialFoldersList[iCount].EntryID) then
begin
Result := SpecialFoldersList[iCount].FolderType;
Exit;
end;
if Result = oFolderUndefined then
Result := GetMAPIFolderKnowType(FolderClass);
end;
procedure ClearHead(Node: TTreeNode);
var
pDataS: PStoreHead;
pDataF: PFolderHead;
begin
if Assigned(Node.Data) then
begin
if Node.Level = 0 then
begin
pDataS := PStoreHead(Node.Data);
pDataS.ID := nil;
end
else
begin
pDataF := PFolderHead(Node.Data);
pDataF.ID := nil;
pDataF.ParentID := nil;
pDataF.StoreID := nil;
end;
Dispose(Node.Data);
end;
Node.Data := nil;
end;
function CopyStoreHead(TreeView: TTreeView; Row: TMAPITableFields): TTreeNode;
var
StoreHead: PStoreHead;
len: Integer;
begin
(*
Default columns are:
PR_ENTRYID, PR_DISPLAY_NAME, PR_PROVIDER_DISPLAY, PR_DEFAULT_STORE, PR_MDB_PROVIDER
*)
New(StoreHead);
len := Length(Row.ItemOf[PR_ENTRYID].AsBytes);
SetLength(StoreHead.ID, len);
Move(Row.ItemOf[PR_ENTRYID].AsBytes[0], StoreHead.ID[0], len);
StoreHead.DisplayName := Row.ItemOf[PR_DISPLAY_NAME].AsString;
StoreHead.ProviderDisplayName := Row.ItemOf[PR_PROVIDER_DISPLAY].AsString;
StoreHead.IsDefault := Row.ItemOf[PR_DEFAULT_STORE].AsBoolean;
StoreHead.StoreType := GetMsgStoreType(Row.ItemOf[PR_MDB_PROVIDER].AsBytes);
if StoreHead^.IsDefault then
Result := TreeView.Items.AddObjectFirst(nil, StoreHead.DisplayName, StoreHead)
else
Result := TreeView.Items.AddObject(nil, StoreHead.DisplayName, StoreHead);
// Image Index
if StoreHead^.IsDefault then
Result.ImageIndex := 0
else
Result.ImageIndex := 1;
Result.SelectedIndex := Result.ImageIndex;
Result.Expanded := False;
// Add Dummy Node for [+] Icon
TreeView.Items.AddChildObjectFirst(Result, '', nil);
end;
function CopyFolderHead(ParentNode: TTreeNode; Row: TMAPITableFields): TTreeNode;
var
FolderHead: PFolderHead;
len: Integer;
TreeView: TTreeView;
begin
Result := nil;
(* Default columns here are:
PR_ENTRYID, PR_LONGTERM_ENTRYID_FROM_TABLE, PR_DISPLAY_NAME, PR_CONTAINER_CLASS, PR_CONTENT_COUNT, PR_CONTENT_UNREAD,
PR_SUBFOLDERS, PR_PARENT_ENTRYID, PR_STORE_ENTRYID, PR_MDB_PROVIDER, PR_ATTR_HIDDEN
*)
// We are not interested in hidden folders
if Row.PropExistsEx(PR_ATTR_HIDDEN) and Row.ItemOf[PR_ATTR_HIDDEN].AsBoolean then
Exit;
New(FolderHead);
if Row.PropExistsEx(PR_LONGTERM_ENTRYID_FROM_TABLE) then
begin
len := Length(Row.ItemOf[PR_LONGTERM_ENTRYID_FROM_TABLE].AsBytes);
SetLength(FolderHead.ID, len);
Move(Row.ItemOf[PR_LONGTERM_ENTRYID_FROM_TABLE].AsBytes[0], FolderHead.ID[0], len);
end
else
begin
len := Length(Row.ItemOf[PR_ENTRYID].AsBytes);
SetLength(FolderHead.ID, len);
Move(Row.ItemOf[PR_ENTRYID].AsBytes[0], FolderHead.ID[0], len);
end;
if not Row.ItemOf[PR_DISPLAY_NAME].IsError then
FolderHead.DisplayName := Row.ItemOf[PR_DISPLAY_NAME].AsString;
if not Row.ItemOf[PR_CONTAINER_CLASS].IsError then
FolderHead.FolderClass := Row.ItemOf[PR_CONTAINER_CLASS].AsString;
FolderHead.FolderType := GetFolderType(FolderHead.FolderClass, FolderHead.ID);
if not Row.ItemOf[PR_CONTENT_COUNT].IsError then
FolderHead.MsgCount := Row.ItemOf[PR_CONTENT_COUNT].AsInteger;
if not Row.ItemOf[PR_CONTENT_UNREAD].IsError then
FolderHead.UnReadMsgCount := Row.ItemOf[PR_CONTENT_UNREAD].AsInteger;
if not Row.ItemOf[PR_SUBFOLDERS].IsError then
FolderHead.HasSubFolders := Row.ItemOf[PR_SUBFOLDERS].AsBoolean;
if not Row.ItemOf[PR_PARENT_ENTRYID].IsError then
begin
len := Length(Row.ItemOf[PR_PARENT_ENTRYID].AsBytes);
SetLength(FolderHead.ParentID, len);
Move(Row.ItemOf[PR_PARENT_ENTRYID].AsBytes[0], FolderHead.ParentID[0], len);
end;
if not Row.ItemOf[PR_STORE_ENTRYID].IsError then
begin
len := Length(Row.ItemOf[PR_STORE_ENTRYID].AsBytes);
SetLength(FolderHead.StoreID, len);
Move(Row.ItemOf[PR_STORE_ENTRYID].AsBytes[0], FolderHead.StoreID[0], len);
end;
FolderHead.StoreType := GetMsgStoreType(Row.ItemOf[PR_MDB_PROVIDER].AsBytes);
TreeView := TTreeView(ParentNode.TreeView);
Result := TreeView.Items.AddChildObject(ParentNode, FolderHead^.DisplayName, FolderHead);
Result.ImageIndex := GetFldIconIndex(FolderHead.FolderType);
Result.SelectedIndex := Result.ImageIndex;
// Add Dummy Node for [+] Icon
if FolderHead.HasSubFolders then
TreeView.Items.AddChildObject(Result, '', nil);
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
ClearHead(TreeNode);
TreeNode.Data := nil;
end;
if TreeNode.HasChildren then
DeleteChild(TreeNode);
TreeNode.DeleteChildren;
TreeNode := Node.GetNextChild(TreeNode);
end;
Node.DeleteChildren;
end;
procedure TfrmMain.ClearMAPIObjects;
begin
if Assigned(MessagesTable) then
FreeAndNil(MessagesTable);
DATAFolder := nil;
ClearSpecialFoldersList;
if Assigned(MAPIStore) then
ReleaseMsgStore(MAPIStore);
MAPIStore := nil;
if Assigned(MAPISession) then
ReleaseMapiSession(MAPISession);
MAPISession := nil;
end;
procedure TfrmMain.btFastMdgFilterClick(Sender: TObject);
var
DefSubText: string;
PropTag: ULONG;
begin
if not Assigned(MessagesTable) or (MessagesTable.Count < 1) then
Exit;
PropTag := 0;
if Assigned(MessageListView.Selected) then
DefSubText := MessageListView.Selected.SubItems[2]
else
DefSubText := '';
if not InputQuery('Fast Msg Filter', 'Show only Messages where Subject Like', DefSubText) then
Exit;
if (DefSubText <> '') then
begin
PropTag := PR_SUBJECT;
end;
MessageListView.Items.BeginUpdate;
try
MessagesTable.FastFilter(PropTag, rLike, DefSubText);
finally
MessageListView.Items.Count := MessagesTable.Count;
StatusBar.Panels[0].Text := IntToStr(MessageListView.Items.Count) + ' Items';
if MessagesTable.IsFiltered then
StatusBar.Panels[0].Text := StatusBar.Panels[0].Text + ' - Filter is applied!';
MessageListView.Items.EndUpdate;
MessageListView.ItemIndex := -1;
MessageListView.Refresh;
end;
end;
procedure TfrmMain.btLogOffClick(Sender: TObject);
begin
// Release all MAPI Interfaces and Delphi objects
ClearMAPIObjects;
btLogOn.Enabled := True;
btLogOff.Enabled := False;
end;
procedure TfrmMain.btLogOnClick(Sender: TObject);
begin
// Get MAPI Session
case rgProfile.ItemIndex of
0:
MAPISession := GetMAPISession(Self.Handle);
1:
MAPISession := GetMAPISession(Self.Handle, '', MAPI_LOGON_UI);
end;
if Assigned(MAPISession) then
begin
btLogOn.Enabled := False;
btLogOff.Enabled := True;
BuildFolderTree;
end;
end;
procedure TfrmMain.BuildFolderTree;
var
MAPITable: IMAPITable;
iCount: Integer;
begin
if not Assigned(MAPISession) then
Exit;
MAPITable := GetMAPIStoresTable(MAPISession);
{
GetMAPIStoresTable returns message store table that contains information about all the message stores in the session profile
Default columns are:
PR_ENTRYID, PR_DISPLAY_NAME, PR_PROVIDER_DISPLAY, PR_DEFAULT_STORE, PR_MDB_PROVIDER
}
with TMAPITable.Create(MAPITable) do
begin
for iCount := 0 to Count - 1 do
CopyStoreHead(MailboxTreeView, Row[iCount]);
Free;
end;
end;
procedure TfrmMain.FormClose(Sender: TObject; var Action: TCloseAction);
begin
// Release all MAPI Interfaces and Delphi objects
ClearMAPIObjects;
// UnInitialize MAPI Subsystem
MapiUnInitialize;
end;
procedure TfrmMain.FormCreate(Sender: TObject);
begin
{$IF DEFINED (WIN64)}
Self.Caption := Self.Caption + ' - WIN64';
{$ELSE}
Self.Caption := Self.Caption + ' - WIN32';
{$IFEND}
DATAFolder := nil;
MAPIStore := nil;
MAPISession := nil;
hr := MapiInitialize(nil);
if failed(hr) then
raise EMAPIError.CreateMAPI(nil, hr);
MessageListView.Items.Count := 0;
// 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_CLIENT_SUBMIT_TIME;
MessageListView.Columns.Items[5].Tag := PR_MESSAGE_SIZE;
end;
procedure TfrmMain.MailboxTreeViewChange(Sender: TObject; Node: TTreeNode);
var
Cursor: TCursor;
begin
Cursor := Screen.Cursor;
Screen.Cursor := crHourGlass;
try
if Node.Level > 0 then
begin
CheckStore(PFolderHead(Node.Data)^.StoreID);
GetMessages(Node.Data);
end
else
begin
btFastMdgFilter.Enabled := False;
MessageListView.Items.Count := 0;
MessageListView.Refresh;
CheckStore(PStoreHead(Node.Data)^.ID);
end;
finally
Screen.Cursor := Cursor;
end;
if Node.Level = 0 then
StatusBar.Panels[0].Text := PStoreHead(Node.Data).DisplayName;
end;
procedure TfrmMain.MailboxTreeViewCollapsing(Sender: TObject; Node: TTreeNode; var AllowCollapse: Boolean);
begin
CollapseLevel(Node);
end;
procedure TfrmMain.MailboxTreeViewExpanding(Sender: TObject; Node: TTreeNode; var AllowExpansion: Boolean);
var
FirstChild: TTreeNode;
begin
FirstChild := Node.getFirstChild;
if Assigned(FirstChild) and (FirstChild.Data = nil) then
begin
Node.DeleteChildren;
ExpandLevel(Node);
end;
end;
procedure TfrmMain.MessageListViewColumnClick(Sender: TObject; Column: TListColumn);
var
iCount: Integer;
begin
if not Assigned(MessagesTable) then
Exit;
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;
MessagesTable.FastSort(ColumnTag, SortAscending);
MessageListView.Refresh;
SortAscendingOld := SortAscending;
ColumnTagOld := ColumnTag;
end;
procedure TfrmMain.MessageListViewData(Sender: TObject; Item: TListItem);
var
ItemIndex: Integer;
IconIndex: Integer;
MessageClass: string;
MessageFlags: Integer;
begin
ItemIndex := Item.Index;
if ItemIndex > MessagesTable.Count - 1 then
Exit;
(*
Default columns are:
PR_ENTRYID, PR_LONGTERM_ENTRYID_FROM_TABLE, PR_MESSAGE_CLASS, PR_HASATTACH, PR_SUBJECT, PR_SENDER_NAME,
PR_SENDER_EMAIL_ADDRESS, PR_CLIENT_SUBMIT_TIME, PR_MESSAGE_SIZE, PR_MESSAGE_FLAGS, PR_ICON_INDEX
*)
IconIndex := -1;
MessageClass := '';
MessageFlags := 0;
if MessagesTable.Row[ItemIndex].PropExistsEx(PR_ICON_INDEX) then
IconIndex := MessagesTable.Row[ItemIndex].ItemOf[PR_ICON_INDEX].AsInteger;
if MessagesTable.Row[ItemIndex].PropExistsEx(PR_MESSAGE_CLASS) then
MessageClass := MessagesTable.Row[ItemIndex].ItemOf[PR_MESSAGE_CLASS].AsString;
if MessagesTable.Row[ItemIndex].PropExistsEx(PR_MESSAGE_FLAGS) then
MessageFlags := MessagesTable.Row[ItemIndex].ItemOf[PR_MESSAGE_FLAGS].AsInteger;
Item.ImageIndex := CalculateMsgIconIndex(IconIndex, MessageClass, MessageFlags);
Item.SubItems.Add('');
if MessagesTable.Row[ItemIndex].ItemOf[PR_HASATTACH].AsBoolean then
Item.SubItemImages[0] := 187
else
Item.SubItemImages[0] := -1;
if MessagesTable.Row[ItemIndex].PropExistsEx(PR_SENDER_NAME) then
Item.SubItems.Add(MessagesTable.Row[ItemIndex].ItemOf[PR_SENDER_NAME].AsString)
else
Item.SubItems.Add('');
Item.SubItems.Add(MessagesTable.Row[ItemIndex].ItemOf[PR_SUBJECT].AsString);
if MessagesTable.Row[ItemIndex].PropExistsEx(PR_CLIENT_SUBMIT_TIME) then
Item.SubItems.Add(DateTimeToStr(MessagesTable.Row[ItemIndex].ItemOf[PR_CLIENT_SUBMIT_TIME].AsDateTime))
else
Item.SubItems.Add('');
Item.SubItems.Add(ShowCustomSize(MessagesTable.Row[ItemIndex].ItemOf[PR_MESSAGE_SIZE].AsInteger));
end;
procedure TfrmMain.MessageListViewDblClick(Sender: TObject);
var
ItemIndex: Integer;
MAPIMessage: IMessage;
ID: TBytes;
begin
ID := nil;
if (MessageListView.Items.Count < 1) or not Assigned(MessagesTable) then
Exit;
ItemIndex := MessageListView.Selected.Index;
if MessagesTable.Row[ItemIndex].PropExistsEx(PR_LONGTERM_ENTRYID_FROM_TABLE) then
ID := MessagesTable.Row[ItemIndex].ItemOf[PR_LONGTERM_ENTRYID_FROM_TABLE].AsBytes
else
ID := MessagesTable.Row[ItemIndex].ItemOf[PR_ENTRYID].AsBytes;
MAPIMessage := GetMapiMessage(MAPIStore, ID);
with TfrmMessage.Create(Self) do
begin
SetMessage(MAPIMessage);
ShowModal;
end;
end;
procedure TfrmMain.ExpandLevel(Node: TTreeNode);
var
iCount: Integer;
isStore: Boolean;
MAPITable: IMAPITable;
MAPIFolder: IMAPIFolder;
begin
isStore := (Node.Level = 0);
if isStore then
CheckStore(PStoreHead(Node.Data)^.ID);
if not isStore then
if Assigned(MAPIStore) and not IsSameMAPIObject(MAPISession, MAPIStore, PFolderHead(Node.Data)^.StoreID) then
begin
ReleaseMsgStore(MAPIStore);
MAPIStore := GetMAPIStore(MAPISession, PFolderHead(Node.Data)^.StoreID);
end;
if isStore then
MAPITable := GetMAPIFoldersTable(MAPIStore)
else
begin
MAPIFolder := GetMAPIFolder(MAPIStore, PFolderHead(Node.Data)^.ID);
MAPITable := GetMAPIFoldersTable(MAPIFolder);
end;
with TMAPITable.Create(MAPITable) do
begin
for iCount := 0 to Count - 1 do
CopyFolderHead(Node, Row[iCount]);
Free;
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
ClearHead(TreeNode);
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
GetMessages(Node.Data)
end;
// Add Dummy Node for [+] Icon
if isStore or PFolderHead(Node.Data)^.HasSubFolders then
MailboxTreeView.Items.AddChildObjectFirst(Node, '', nil);
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
begin
MAPIStore := GetMAPIStore(MAPISession, StoreID);
ClearSpecialFoldersList;
SpecialFoldersList := GetMAPISpecialFoldersIDList(MAPIStore);
end;
end;
procedure TfrmMain.GetMessages(P: Pointer);
var
FolderHead: PFolderHead;
MAPITable: IMAPITable;
begin
btFastMdgFilter.Enabled := False;
if not Assigned(P) then
Exit;
FolderHead := PFolderHead(P);
if not IsSameTBytes(FolderHead^.ID, FolderID) then
begin
if Assigned(MessagesTable) then
FreeAndNil(MessagesTable);
CheckStore(FolderHead^.StoreID);
DATAFolder := GetMAPIFolder(MAPIStore, FolderHead^.ID);
MAPITable := GetMsgTable(DATAFolder, ColumnTag, SortAscending);
SetLength(FolderID, Length(FolderHead^.ID));
Move(FolderHead^.ID[0], FolderID[0], Length(FolderHead^.ID));
MessagesTable := TMAPITable.Create(MAPITable);
end;
// Force virtual ListView to render items
if MessagesTable.Count <> MessageListView.Items.Count then
begin
MessageListView.Items.Count := MessagesTable.Count;
MessageListView.Refresh;
end;
StatusBar.Panels[0].Text := 'Message Count: ' + IntToStr(MessagesTable.Count) + ' in ' + FolderHead^.DisplayName;
Application.ProcessMessages;
btFastMdgFilter.Enabled := MessagesTable.Count > 0;
end;
end.
Copyright © 1999 - 2021 IMIBO |