846 lines
24 KiB
ObjectPascal
846 lines
24 KiB
ObjectPascal
|
unit GroupControlMain;
|
||
|
|
|
||
|
|
interface
|
||
|
|
|
||
|
|
uses
|
||
|
|
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
|
||
|
|
ComCtrls, StdCtrls, ToolWin, ShlObj, ImgList, Menus, ExtCtrls,
|
||
|
|
dxNavBarBase, dxNavBarCollns, dxNavBar, Grids;
|
||
|
|
|
||
|
|
type
|
||
|
|
PShellItem = ^TShellItem;
|
||
|
|
TShellItem = record
|
||
|
|
FullID,
|
||
|
|
ID: PItemIDList;
|
||
|
|
ParentID: PItemIDList;
|
||
|
|
ShellFolder: IShellFolder;
|
||
|
|
Empty: Boolean;
|
||
|
|
DisplayName,
|
||
|
|
TypeName: string;
|
||
|
|
ImageIndex,
|
||
|
|
Size,
|
||
|
|
Attributes: Integer;
|
||
|
|
ModDate: string;
|
||
|
|
end;
|
||
|
|
|
||
|
|
TfmGroupControlMain = class(TForm)
|
||
|
|
lvMain: TListView;
|
||
|
|
CoolBar1: TCoolBar;
|
||
|
|
ToolBar2: TToolBar;
|
||
|
|
ToolbarImages: TImageList;
|
||
|
|
btnLargeIcons: TToolButton;
|
||
|
|
btnSmallIcons: TToolButton;
|
||
|
|
btnList: TToolButton;
|
||
|
|
btnReport: TToolButton;
|
||
|
|
ToolButton3: TToolButton;
|
||
|
|
btnBack: TToolButton;
|
||
|
|
nbMain: TdxNavBar;
|
||
|
|
bgPlaces: TdxNavBarGroup;
|
||
|
|
bgSearch: TdxNavBarGroup;
|
||
|
|
bgSearchControl: TdxNavBarGroupControl;
|
||
|
|
btnSearch: TButton;
|
||
|
|
StatusBar1: TStatusBar;
|
||
|
|
ilSmall: TImageList;
|
||
|
|
ilLarge: TImageList;
|
||
|
|
biDesktop: TdxNavBarItem;
|
||
|
|
biMyDocuments: TdxNavBarItem;
|
||
|
|
biNetwork: TdxNavBarItem;
|
||
|
|
edSearch: TEdit;
|
||
|
|
bgFavorites: TdxNavBarGroup;
|
||
|
|
bgMyComputer: TdxNavBarGroup;
|
||
|
|
bgMyComputerControl: TdxNavBarGroupControl;
|
||
|
|
bgFavoritesControl: TdxNavBarGroupControl;
|
||
|
|
lvMyFavorites: TListView;
|
||
|
|
tvMyComputer: TTreeView;
|
||
|
|
Splitter1: TSplitter;
|
||
|
|
ToolButton1: TToolButton;
|
||
|
|
cbViews: TComboBox;
|
||
|
|
Panel1: TPanel;
|
||
|
|
procedure FormCreate(Sender: TObject);
|
||
|
|
procedure lvMainData(Sender: TObject; Item: TListItem);
|
||
|
|
procedure btnLargeIconsClick(Sender: TObject);
|
||
|
|
procedure lvMainDblClick(Sender: TObject);
|
||
|
|
procedure lvMainDataHint(Sender: TObject; StartIndex,
|
||
|
|
EndIndex: Integer);
|
||
|
|
procedure lvMainKeyDown(Sender: TObject; var Key: Word;
|
||
|
|
Shift: TShiftState);
|
||
|
|
procedure lvMainDataFind(Sender: TObject; Find: TItemFind;
|
||
|
|
const FindString: String; const FindPosition: TPoint;
|
||
|
|
FindData: Pointer; StartIndex: Integer; Direction: TSearchDirection;
|
||
|
|
Wrap: Boolean; var Index: Integer);
|
||
|
|
procedure lvMainCustomDrawItem(Sender: TCustomListView;
|
||
|
|
Item: TListItem; State: TCustomDrawState; var DefaultDraw: Boolean);
|
||
|
|
procedure lvMainCustomDrawSubItem(Sender: TCustomListView;
|
||
|
|
Item: TListItem; SubItem: Integer; State: TCustomDrawState;
|
||
|
|
var DefaultDraw: Boolean);
|
||
|
|
procedure btnBackClick(Sender: TObject);
|
||
|
|
procedure Form1Close(Sender: TObject; var Action: TCloseAction);
|
||
|
|
procedure btnSearchClick(Sender: TObject);
|
||
|
|
procedure biDesktopClick(Sender: TObject);
|
||
|
|
procedure biMyDocumentsClick(Sender: TObject);
|
||
|
|
procedure biNetworkClick(Sender: TObject);
|
||
|
|
procedure FormDestroy(Sender: TObject);
|
||
|
|
procedure tvMyComputerClick(Sender: TObject);
|
||
|
|
procedure lvMyFavoritesClick(Sender: TObject);
|
||
|
|
procedure cbViewsChange(Sender: TObject);
|
||
|
|
private
|
||
|
|
FIDList: TList;
|
||
|
|
FSearchShellID: PItemIDList;
|
||
|
|
FShellID: PItemIDList;
|
||
|
|
FDesktopFolder: IShellFolder;
|
||
|
|
FSearching: Boolean;
|
||
|
|
|
||
|
|
function GetShellFolder: IShellFolder;
|
||
|
|
function GetShellItemCount: Integer;
|
||
|
|
function GetShellItem(Index: Integer): PShellItem;
|
||
|
|
|
||
|
|
procedure ClearIDList;
|
||
|
|
protected
|
||
|
|
function GetIDByPath(APath: string): PItemIDList;
|
||
|
|
function GetIDBySpetialFolder(ASpetialFolder: Integer): PItemIDList;
|
||
|
|
function GetShellFolderByID(AID: PItemIDList): IShellFolder;
|
||
|
|
function GetEnumIDListByFolder(AFolder: IShellFolder): IEnumIDList;
|
||
|
|
|
||
|
|
function CompareNames(Path, Pattern: string): Boolean;
|
||
|
|
procedure SetSearch(AID: PItemIDList; const Pattern: string);
|
||
|
|
procedure SetPath(const Value: string); overload;
|
||
|
|
procedure SetPath(ID: PItemIDList); overload;
|
||
|
|
procedure PopulateIDList(AID: PItemIDList);
|
||
|
|
procedure PopulateSearchIDList(ASearchID: PItemIDList; Pattern: string);
|
||
|
|
procedure PopulateMyFavoritesList(AID: PItemIDList);
|
||
|
|
procedure PopulateMyComputerTree(AID: PItemIDList);
|
||
|
|
procedure CheckShellItems(StartIndex, EndIndex: Integer);
|
||
|
|
public
|
||
|
|
property DesktopFolder: IShellFolder read FDesktopFolder;
|
||
|
|
property SearchShellID: PItemIDList read FSearchShellID;
|
||
|
|
property ShellFolder: IShellFolder read GetShellFolder;
|
||
|
|
property ShellID: PItemIDList read FShellID;
|
||
|
|
|
||
|
|
property ShellItems[Index: Integer]: PShellItem read GetShellItem;
|
||
|
|
property ShellItemCount: Integer read GetShellItemCount;
|
||
|
|
end;
|
||
|
|
|
||
|
|
var
|
||
|
|
fmGroupControlMain: TfmGroupControlMain;
|
||
|
|
|
||
|
|
implementation
|
||
|
|
|
||
|
|
{$R *.dfm}
|
||
|
|
|
||
|
|
uses dxNavBarViewsFact, ShellAPI, ActiveX, ComObj, CommCtrl;
|
||
|
|
|
||
|
|
procedure DisposePIDL(ID: PItemIDList);
|
||
|
|
var
|
||
|
|
Malloc: IMalloc;
|
||
|
|
begin
|
||
|
|
if ID = nil then Exit;
|
||
|
|
OLECheck(SHGetMalloc(Malloc));
|
||
|
|
Malloc.Free(ID);
|
||
|
|
end;
|
||
|
|
|
||
|
|
function NextPIDL(IDList: PItemIDList): PItemIDList;
|
||
|
|
begin
|
||
|
|
Result := IDList;
|
||
|
|
Inc(PChar(Result), IDList^.mkid.cb);
|
||
|
|
end;
|
||
|
|
|
||
|
|
function GetPIDLSize(IDList: PItemIDList): Integer;
|
||
|
|
begin
|
||
|
|
Result := 0;
|
||
|
|
if Assigned(IDList) then
|
||
|
|
begin
|
||
|
|
Result := SizeOf(IDList^.mkid.cb);
|
||
|
|
while IDList^.mkid.cb <> 0 do
|
||
|
|
begin
|
||
|
|
Result := Result + IDList^.mkid.cb;
|
||
|
|
IDList := NextPIDL(IDList);
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure StripLastID(IDList: PItemIDList);
|
||
|
|
var
|
||
|
|
MarkerID: PItemIDList;
|
||
|
|
begin
|
||
|
|
MarkerID := IDList;
|
||
|
|
if Assigned(IDList) then
|
||
|
|
begin
|
||
|
|
while IDList.mkid.cb <> 0 do
|
||
|
|
begin
|
||
|
|
MarkerID := IDList;
|
||
|
|
IDList := NextPIDL(IDList);
|
||
|
|
end;
|
||
|
|
MarkerID.mkid.cb := 0;
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
|
||
|
|
function CreatePIDL(Size: Integer): PItemIDList;
|
||
|
|
var
|
||
|
|
Malloc: IMalloc;
|
||
|
|
HR: HResult;
|
||
|
|
begin
|
||
|
|
Result := nil;
|
||
|
|
|
||
|
|
HR := SHGetMalloc(Malloc);
|
||
|
|
if Failed(HR) then
|
||
|
|
Exit;
|
||
|
|
|
||
|
|
try
|
||
|
|
Result := Malloc.Alloc(Size);
|
||
|
|
if Assigned(Result) then
|
||
|
|
FillChar(Result^, Size, 0);
|
||
|
|
finally
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
|
||
|
|
function CopyPIDL(IDList: PItemIDList): PItemIDList;
|
||
|
|
var
|
||
|
|
Size: Integer;
|
||
|
|
begin
|
||
|
|
Size := GetPIDLSize(IDList);
|
||
|
|
Result := CreatePIDL(Size);
|
||
|
|
if Assigned(Result) then
|
||
|
|
CopyMemory(Result, IDList, Size);
|
||
|
|
end;
|
||
|
|
|
||
|
|
function ConcatPIDLs(IDList1, IDList2: PItemIDList): PItemIDList;
|
||
|
|
var
|
||
|
|
cb1, cb2: Integer;
|
||
|
|
begin
|
||
|
|
if Assigned(IDList1) then
|
||
|
|
cb1 := GetPIDLSize(IDList1) - SizeOf(IDList1^.mkid.cb)
|
||
|
|
else cb1 := 0;
|
||
|
|
cb2 := GetPIDLSize(IDList2);
|
||
|
|
|
||
|
|
Result := CreatePIDL(cb1 + cb2);
|
||
|
|
if Assigned(Result) then
|
||
|
|
begin
|
||
|
|
if Assigned(IDList1) then
|
||
|
|
CopyMemory(Result, IDList1, cb1);
|
||
|
|
CopyMemory(PChar(Result) + cb1, IDList2, cb2);
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
|
||
|
|
function GetDisplayName(ShellFolder: IShellFolder; PIDL: PItemIDList;
|
||
|
|
ForParsing: Boolean): string;
|
||
|
|
var
|
||
|
|
StrRet: TStrRet;
|
||
|
|
P: PChar;
|
||
|
|
Flags: Integer;
|
||
|
|
begin
|
||
|
|
Result := '';
|
||
|
|
if ForParsing then
|
||
|
|
Flags := SHGDN_FORPARSING
|
||
|
|
else Flags := SHGDN_NORMAL;
|
||
|
|
|
||
|
|
ShellFolder.GetDisplayNameOf(PIDL, Flags, StrRet);
|
||
|
|
case StrRet.uType of
|
||
|
|
STRRET_CSTR:
|
||
|
|
SetString(Result, StrRet.cStr, lStrLen(StrRet.cStr));
|
||
|
|
STRRET_OFFSET:
|
||
|
|
begin
|
||
|
|
P := @PIDL.mkid.abID[StrRet.uOffset - SizeOf(PIDL.mkid.cb)];
|
||
|
|
SetString(Result, P, PIDL.mkid.cb - StrRet.uOffset);
|
||
|
|
end;
|
||
|
|
STRRET_WSTR:
|
||
|
|
Result := StrRet.pOleStr;
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
|
||
|
|
function GetShellImage(PIDL: PItemIDList; Large, Open: Boolean): Integer;
|
||
|
|
var
|
||
|
|
FileInfo: TSHFileInfo;
|
||
|
|
Flags: Integer;
|
||
|
|
begin
|
||
|
|
FillChar(FileInfo, SizeOf(FileInfo), #0);
|
||
|
|
Flags := SHGFI_PIDL or SHGFI_SYSICONINDEX or SHGFI_ICON;
|
||
|
|
if Open then Flags := Flags or SHGFI_OPENICON;
|
||
|
|
if Large then Flags := Flags or SHGFI_LARGEICON
|
||
|
|
else Flags := Flags or SHGFI_SMALLICON;
|
||
|
|
SHGetFileInfo(PChar(PIDL), 0, FileInfo, SizeOf(FileInfo), Flags);
|
||
|
|
Result := FileInfo.iIcon;
|
||
|
|
end;
|
||
|
|
|
||
|
|
function IsFolder(ShellFolder: IShellFolder; ID: PItemIDList): Boolean;
|
||
|
|
var
|
||
|
|
Flags: UINT;
|
||
|
|
begin
|
||
|
|
Flags := SFGAO_FOLDER;
|
||
|
|
ShellFolder.GetAttributesOf(1, ID, Flags);
|
||
|
|
Result := SFGAO_FOLDER and Flags <> 0;
|
||
|
|
end;
|
||
|
|
|
||
|
|
|
||
|
|
function ListSortFunc(Item1, Item2: Pointer): Integer;
|
||
|
|
begin
|
||
|
|
Result := SmallInt(fmGroupControlMain.ShellFolder.CompareIDs(0,
|
||
|
|
PShellItem(Item1).ID, PShellItem(Item2).ID));
|
||
|
|
end;
|
||
|
|
|
||
|
|
{TForm1}
|
||
|
|
|
||
|
|
procedure TfmGroupControlMain.FormCreate(Sender: TObject);
|
||
|
|
var
|
||
|
|
I: Integer;
|
||
|
|
FileInfo: TSHFileInfo;
|
||
|
|
ImageListHandle: THandle;
|
||
|
|
NewPIDL: PItemIDList;
|
||
|
|
begin
|
||
|
|
cbViews.Items.Clear;
|
||
|
|
for I := 0 to dxNavBarViewsFactory.Count - 1 do
|
||
|
|
cbViews.Items.Add(dxNavBarViewsFactory.Names[I]);
|
||
|
|
cbViews.ItemIndex := nbMain.View;
|
||
|
|
|
||
|
|
OLECheck(SHGetDesktopFolder(FDesktopFolder));
|
||
|
|
FIDList := TList.Create;
|
||
|
|
|
||
|
|
ImageListHandle := SHGetFileInfo('C:\', 0, FileInfo, SizeOf(FileInfo),
|
||
|
|
SHGFI_SYSICONINDEX or SHGFI_SMALLICON);
|
||
|
|
SendMessage(lvMain.Handle, LVM_SETIMAGELIST, LVSIL_SMALL, ImageListHandle);
|
||
|
|
SendMessage(lvMyFavorites.Handle, LVM_SETIMAGELIST, LVSIL_SMALL, ImageListHandle);
|
||
|
|
SendMessage(tvMyComputer.Handle, TVM_SETIMAGELIST, TVSIL_NORMAL, ImageListHandle);
|
||
|
|
|
||
|
|
ImageListHandle := SHGetFileInfo('C:\', 0, FileInfo, SizeOf(FileInfo),
|
||
|
|
SHGFI_SYSICONINDEX or SHGFI_LARGEICON);
|
||
|
|
SendMessage(lvMain.Handle, LVM_SETIMAGELIST, LVSIL_NORMAL, ImageListHandle);
|
||
|
|
SendMessage(lvMyFavorites.Handle, LVM_SETIMAGELIST, LVSIL_NORMAL, ImageListHandle);
|
||
|
|
|
||
|
|
OLECheck(SHGetSpecialFolderLocation(Application.Handle, CSIDL_DRIVES, NewPIDL));
|
||
|
|
FShellID := NewPIDL;
|
||
|
|
SetPath(NewPIDL);
|
||
|
|
PopulateMyFavoritesList(GetIDBySpetialFolder(CSIDL_FAVORITES));
|
||
|
|
PopulateMyComputerTree(NewPIDL);
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure TfmGroupControlMain.btnLargeIconsClick(Sender: TObject);
|
||
|
|
begin
|
||
|
|
lvMain.ViewStyle := TViewStyle((Sender as TComponent).Tag);
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure TfmGroupControlMain.lvMainDblClick(Sender: TObject);
|
||
|
|
var
|
||
|
|
AShellFolder: IShellFolder;
|
||
|
|
AParentID, AID: PItemIDList;
|
||
|
|
begin
|
||
|
|
if lvMain.Selected <> nil then
|
||
|
|
begin
|
||
|
|
AID := ShellItems[lvMain.Selected.Index].ID;
|
||
|
|
AParentID := ShellItems[lvMain.Selected.Index].ParentID;
|
||
|
|
if FSearchShellID = nil then
|
||
|
|
begin
|
||
|
|
AShellFolder := ShellItems[lvMain.Selected.Index].ShellFolder;
|
||
|
|
if IsFolder(AShellFolder, AID) then
|
||
|
|
SetPath(ConcatPIDLs(AParentID, AID));
|
||
|
|
end
|
||
|
|
else SetPath(AParentID);
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
|
||
|
|
function TfmGroupControlMain.GetShellFolder: IShellFolder;
|
||
|
|
begin
|
||
|
|
Result := GetShellFolderByID(FShellID);
|
||
|
|
end;
|
||
|
|
|
||
|
|
function TfmGroupControlMain.GetShellItemCount: Integer;
|
||
|
|
begin
|
||
|
|
Result := FIDList.Count;
|
||
|
|
end;
|
||
|
|
|
||
|
|
function TfmGroupControlMain.GetShellItem(Index: Integer): PShellItem;
|
||
|
|
begin
|
||
|
|
Result := PShellItem(FIDList[Index]);
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure TfmGroupControlMain.lvMainKeyDown(Sender: TObject; var Key: Word;
|
||
|
|
Shift: TShiftState);
|
||
|
|
begin
|
||
|
|
case Key of
|
||
|
|
VK_RETURN:
|
||
|
|
lvMainDblClick(Sender);
|
||
|
|
VK_BACK:
|
||
|
|
btnBackClick(Sender);
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure TfmGroupControlMain.ClearIDList;
|
||
|
|
var
|
||
|
|
I: Integer;
|
||
|
|
begin
|
||
|
|
for I := 0 to ShellItemCount - 1 do
|
||
|
|
begin
|
||
|
|
DisposePIDL(ShellItems[I].ID);
|
||
|
|
Dispose(ShellItems[I]);
|
||
|
|
end;
|
||
|
|
FIDList.Clear;
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure TfmGroupControlMain.PopulateIDList(AID: PItemIDList);
|
||
|
|
var
|
||
|
|
ID: PItemIDList;
|
||
|
|
AShellFolder: IShellFolder;
|
||
|
|
EnumList: IEnumIDList;
|
||
|
|
NumIDs: LongWord;
|
||
|
|
SaveCursor: TCursor;
|
||
|
|
ShellItem: PShellItem;
|
||
|
|
begin
|
||
|
|
AShellFolder := GetShellFolderByID(AID);
|
||
|
|
SaveCursor := Screen.Cursor;
|
||
|
|
try
|
||
|
|
Screen.Cursor := crHourglass;
|
||
|
|
ClearIDList;
|
||
|
|
EnumList := GetEnumIDListByFolder(AShellFolder);
|
||
|
|
|
||
|
|
FShellID := AID;
|
||
|
|
FSearchShellID := nil;
|
||
|
|
while EnumList.Next(1, ID, NumIDs) = S_OK do
|
||
|
|
begin
|
||
|
|
ShellItem := New(PShellItem);
|
||
|
|
ShellItem.ID := ID;
|
||
|
|
ShellItem.ParentID := AID;
|
||
|
|
ShellItem.ShellFolder := ShellFolder;
|
||
|
|
ShellItem.DisplayName := GetDisplayName(AShellFolder, ID, False);
|
||
|
|
ShellItem.Empty := True;
|
||
|
|
FIDList.Add(ShellItem);
|
||
|
|
end;
|
||
|
|
FIDList.Sort(ListSortFunc);
|
||
|
|
finally
|
||
|
|
lvMain.Items.Count := ShellItemCount;
|
||
|
|
lvMain.Repaint;
|
||
|
|
Screen.Cursor := SaveCursor;
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure TfmGroupControlMain.PopulateSearchIDList(ASearchID: PItemIDList; Pattern: string);
|
||
|
|
|
||
|
|
procedure CheckFolder(AID: PItemIDList);
|
||
|
|
var
|
||
|
|
AFolder: IShellFolder;
|
||
|
|
ID: PItemIDList;
|
||
|
|
EnumList: IEnumIDList;
|
||
|
|
NumIDs: LongWord;
|
||
|
|
ShellItem: PShellItem;
|
||
|
|
begin
|
||
|
|
AFolder := GetShellFolderByID(AID);
|
||
|
|
EnumList := GetEnumIDListByFolder(AFolder);
|
||
|
|
while EnumList.Next(1, ID, NumIDs) = S_OK do
|
||
|
|
begin
|
||
|
|
if CompareNames(GetDisplayName(AFolder, ID, True), Pattern) then
|
||
|
|
begin
|
||
|
|
ShellItem := New(PShellItem);
|
||
|
|
ShellItem.ID := ID;
|
||
|
|
ShellItem.ParentID := AID;
|
||
|
|
ShellItem.ShellFolder := AFolder;
|
||
|
|
ShellItem.DisplayName := GetDisplayName(AFolder, ID, False);
|
||
|
|
ShellItem.Empty := True;
|
||
|
|
FIDList.Add(ShellItem);
|
||
|
|
end;
|
||
|
|
Application.ProcessMessages;
|
||
|
|
if not FSearching then exit;
|
||
|
|
|
||
|
|
if IsFolder(AFolder, ID) then
|
||
|
|
begin
|
||
|
|
StatusBar1.SimpleText := Format('Search in %s ...', [GetDisplayName(AFolder, ID, False)]);
|
||
|
|
CheckFolder(ConcatPIDLs(AID, ID));
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
lvMain.Items.Count := ShellItemCount;
|
||
|
|
lvMain.Repaint;
|
||
|
|
end;
|
||
|
|
|
||
|
|
begin
|
||
|
|
FSearchShellID := ASearchID;
|
||
|
|
ClearIDList;
|
||
|
|
CheckFolder(ASearchID);
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure TfmGroupControlMain.PopulateMyFavoritesList(AID: PItemIDList);
|
||
|
|
var
|
||
|
|
AItem: TListItem;
|
||
|
|
ID, FullID: PItemIDList;
|
||
|
|
AShellFolder: IShellFolder;
|
||
|
|
EnumList: IEnumIDList;
|
||
|
|
NumIDs: LongWord;
|
||
|
|
SaveCursor: TCursor;
|
||
|
|
FileInfo: TSHFileInfo;
|
||
|
|
begin
|
||
|
|
AShellFolder := GetShellFolderByID(AID);
|
||
|
|
lvMyFavorites.Items.BeginUpdate;
|
||
|
|
SaveCursor := Screen.Cursor;
|
||
|
|
try
|
||
|
|
Screen.Cursor := crHourglass;
|
||
|
|
EnumList := GetEnumIDListByFolder(AShellFolder);
|
||
|
|
while EnumList.Next(1, ID, NumIDs) = S_OK do
|
||
|
|
begin
|
||
|
|
AItem := lvMyFavorites.Items.Add;
|
||
|
|
FullID := ConcatPIDLs(AID, ID);
|
||
|
|
AItem.Caption := GetDisplayName(AShellFolder, ID, False);
|
||
|
|
AItem.ImageIndex := GetShellImage(FullID, False, False);
|
||
|
|
|
||
|
|
SHGetFileInfo(PChar(FullID), 0, FileInfo, SizeOf(FileInfo), SHGFI_TYPENAME or SHGFI_PIDL);
|
||
|
|
AItem.SubItems.Add(FileInfo.szTypeName);
|
||
|
|
if IsFolder(AShellFolder, ID) then
|
||
|
|
AItem.Data := FullID
|
||
|
|
else AItem.Data := nil;
|
||
|
|
end;
|
||
|
|
finally
|
||
|
|
lvMyFavorites.Repaint;
|
||
|
|
lvMyFavorites.Items.EndUpdate;
|
||
|
|
Screen.Cursor := SaveCursor;
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure TfmGroupControlMain.PopulateMyComputerTree(AID: PItemIDList);
|
||
|
|
var
|
||
|
|
ANode, AItemNode: TTreeNode;
|
||
|
|
ID, FullID: PItemIDList;
|
||
|
|
AShellFolder: IShellFolder;
|
||
|
|
EnumList: IEnumIDList;
|
||
|
|
NumIDs: LongWord;
|
||
|
|
SaveCursor: TCursor;
|
||
|
|
begin
|
||
|
|
ANode := tvMyComputer.Items.Add(nil, 'MyComputer');
|
||
|
|
ANode.ImageIndex := GetShellImage(AID, False, False);
|
||
|
|
ANode.SelectedIndex := GetShellImage(AID, False, False);
|
||
|
|
ANode.Data := AID;
|
||
|
|
AShellFolder := GetShellFolderByID(AID);
|
||
|
|
tvMyComputer.Items.BeginUpdate;
|
||
|
|
SaveCursor := Screen.Cursor;
|
||
|
|
try
|
||
|
|
Screen.Cursor := crHourglass;
|
||
|
|
EnumList := GetEnumIDListByFolder(AShellFolder);
|
||
|
|
while EnumList.Next(1, ID, NumIDs) = S_OK do
|
||
|
|
begin
|
||
|
|
AItemNode := tvMyComputer.Items.AddChild(ANode, GetDisplayName(AShellFolder, ID, False));
|
||
|
|
FullID := ConcatPIDLs(AID, ID);
|
||
|
|
AItemNode.ImageIndex := GetShellImage(FullID, False, False);
|
||
|
|
AItemNode.SelectedIndex := GetShellImage(FullID, False, False);
|
||
|
|
if IsFolder(AShellFolder, ID) then
|
||
|
|
AItemNode.Data := FullID
|
||
|
|
else AItemNode.Data := nil;
|
||
|
|
end;
|
||
|
|
finally
|
||
|
|
tvMyComputer.SortType := stText;
|
||
|
|
tvMyComputer.Items.EndUpdate;
|
||
|
|
Screen.Cursor := SaveCursor;
|
||
|
|
end;
|
||
|
|
tvMyComputer.FullExpand;
|
||
|
|
end;
|
||
|
|
|
||
|
|
function TfmGroupControlMain.GetIDByPath(APath: string): PItemIDList;
|
||
|
|
var
|
||
|
|
P: PWideChar;
|
||
|
|
Flags,
|
||
|
|
NumChars: LongWord;
|
||
|
|
begin
|
||
|
|
NumChars := Length(APath);
|
||
|
|
Flags := 0;
|
||
|
|
P := StringToOleStr(APath);
|
||
|
|
OLECheck(DesktopFolder.ParseDisplayName(Application.Handle, nil, P,
|
||
|
|
NumChars, Result, Flags));
|
||
|
|
end;
|
||
|
|
|
||
|
|
function TfmGroupControlMain.GetIDBySpetialFolder(ASpetialFolder: Integer): PItemIDList;
|
||
|
|
begin
|
||
|
|
OLECheck(SHGetSpecialFolderLocation(Application.Handle, ASpetialFolder, Result));
|
||
|
|
end;
|
||
|
|
|
||
|
|
function TfmGroupControlMain.GetShellFolderByID(AID: PItemIDList): IShellFolder;
|
||
|
|
begin
|
||
|
|
if AID <> nil then
|
||
|
|
OLECheck(DesktopFolder.BindToObject(AID, nil, IID_IShellFolder, Pointer(Result)))
|
||
|
|
else Result := nil;
|
||
|
|
end;
|
||
|
|
|
||
|
|
function TfmGroupControlMain.GetEnumIDListByFolder(AFolder: IShellFolder): IEnumIDList;
|
||
|
|
const
|
||
|
|
Flags = SHCONTF_FOLDERS or SHCONTF_NONFOLDERS or SHCONTF_INCLUDEHIDDEN;
|
||
|
|
begin
|
||
|
|
if AFolder <> nil then
|
||
|
|
OleCheck(AFolder.EnumObjects(Application.Handle, Flags, Result))
|
||
|
|
else Result := nil;
|
||
|
|
end;
|
||
|
|
|
||
|
|
function TfmGroupControlMain.CompareNames(Path, Pattern: string): Boolean;
|
||
|
|
var
|
||
|
|
APos: Integer;
|
||
|
|
S, Name, Extention, PatName, PatExt: string;
|
||
|
|
begin
|
||
|
|
S := Path;
|
||
|
|
repeat
|
||
|
|
APos := Pos('\', S);
|
||
|
|
if APos > 0 then S := Copy(S, APos + 1, Length(S) - APos + 1);
|
||
|
|
until APos = 0;
|
||
|
|
APos := Pos('.', S);
|
||
|
|
if APos > 0 then
|
||
|
|
begin
|
||
|
|
Name := UpperCase(Copy(S, 1, APos - 1));
|
||
|
|
Extention := UpperCase(Copy(S, APos + 1, Length(S) - APos + 1));
|
||
|
|
end
|
||
|
|
else
|
||
|
|
begin
|
||
|
|
Name := UpperCase(S);
|
||
|
|
Extention := '';
|
||
|
|
end;
|
||
|
|
Pattern := UpperCase(Pattern);
|
||
|
|
APos := Pos('.', Pattern);
|
||
|
|
if APos > 0 then
|
||
|
|
begin
|
||
|
|
PatName := Copy(Pattern, 1, APos - 1);
|
||
|
|
PatExt := Copy(Pattern, APos + 1, Length(Pattern) - APos + 1);
|
||
|
|
end
|
||
|
|
else
|
||
|
|
begin
|
||
|
|
PatName := Pattern;
|
||
|
|
PatExt := '';
|
||
|
|
end;
|
||
|
|
Result := (((Name = PatName) or (PatName = '*')) and
|
||
|
|
((Extention = PatExt) or (PatExt = '*') or (PatExt = ''))) or
|
||
|
|
((PatExt = '') and (PatName <> '') and (Pos(PatName, Name) > 0));
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure TfmGroupControlMain.SetSearch(AID: PItemIDList; const Pattern: string);
|
||
|
|
begin
|
||
|
|
lvMain.Items.BeginUpdate;
|
||
|
|
try
|
||
|
|
FSearching := True;
|
||
|
|
btnSearch.Caption := 'Stop';
|
||
|
|
try
|
||
|
|
PopulateSearchIDList(AID, Pattern);
|
||
|
|
if lvMain.Items.Count > 0 then
|
||
|
|
begin
|
||
|
|
lvMain.Selected := lvMain.Items[0];
|
||
|
|
lvMain.Selected.Focused := True;
|
||
|
|
lvMain.Selected.MakeVisible(False);
|
||
|
|
end;
|
||
|
|
finally
|
||
|
|
StatusBar1.SimpleText := '';
|
||
|
|
btnSearch.Caption := 'Search';
|
||
|
|
FSearching := False;
|
||
|
|
end;
|
||
|
|
finally
|
||
|
|
lvMain.Items.EndUpdate;
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure TfmGroupControlMain.SetPath(const Value: string);
|
||
|
|
var
|
||
|
|
NewPIDL: PItemIDList;
|
||
|
|
begin
|
||
|
|
NewPIDL := GetIDByPath(Value);
|
||
|
|
SetPath(NewPIDL);
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure TfmGroupControlMain.SetPath(ID: PItemIDList);
|
||
|
|
begin
|
||
|
|
lvMain.Items.BeginUpdate;
|
||
|
|
try
|
||
|
|
PopulateIDList(ID);
|
||
|
|
if lvMain.Items.Count > 0 then
|
||
|
|
begin
|
||
|
|
lvMain.Selected := lvMain.Items[0];
|
||
|
|
lvMain.Selected.Focused := True;
|
||
|
|
lvMain.Selected.MakeVisible(False);
|
||
|
|
end;
|
||
|
|
finally
|
||
|
|
lvMain.Items.EndUpdate;
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure TfmGroupControlMain.CheckShellItems(StartIndex, EndIndex: Integer);
|
||
|
|
|
||
|
|
function ValidFileTime(FileTime: TFileTime): Boolean;
|
||
|
|
begin
|
||
|
|
Result := (FileTime.dwLowDateTime <> 0) or (FileTime.dwHighDateTime <> 0);
|
||
|
|
end;
|
||
|
|
|
||
|
|
var
|
||
|
|
FileData: TWin32FindData;
|
||
|
|
FileInfo: TSHFileInfo;
|
||
|
|
SysTime: TSystemTime;
|
||
|
|
I: Integer;
|
||
|
|
LocalFileTime: TFILETIME;
|
||
|
|
begin
|
||
|
|
for I := StartIndex to EndIndex do
|
||
|
|
begin
|
||
|
|
if ShellItems[I]^.Empty then
|
||
|
|
with ShellItems[I]^ do
|
||
|
|
begin
|
||
|
|
FullID := ConcatPIDLs(ParentID, ID);
|
||
|
|
ImageIndex := GetShellImage(FullID, lvMain.ViewStyle = vsIcon, False);
|
||
|
|
|
||
|
|
SHGetFileInfo(PChar(FullID), 0, FileInfo, SizeOf(FileInfo), SHGFI_TYPENAME or SHGFI_PIDL);
|
||
|
|
TypeName := FileInfo.szTypeName;
|
||
|
|
|
||
|
|
FillChar(FileData, SizeOf(FileData), #0);
|
||
|
|
SHGetDataFromIDList(ShellFolder, ID, SHGDFIL_FINDDATA, @FileData, SizeOf(FileData));
|
||
|
|
|
||
|
|
Size := (FileData.nFileSizeLow + 1023 ) div 1024;
|
||
|
|
if Size = 0 then Size := 1;
|
||
|
|
|
||
|
|
FillChar(LocalFileTime, SizeOf(TFileTime), #0);
|
||
|
|
with FileData do
|
||
|
|
if ValidFileTime(ftLastWriteTime)
|
||
|
|
and FileTimeToLocalFileTime(ftLastWriteTime, LocalFileTime)
|
||
|
|
and FileTimeToSystemTime(LocalFileTime, SysTime) then
|
||
|
|
try
|
||
|
|
ModDate := DateTimeToStr(SystemTimeToDateTime(SysTime))
|
||
|
|
except
|
||
|
|
on EConvertError do ModDate := '';
|
||
|
|
end
|
||
|
|
else ModDate := '';
|
||
|
|
|
||
|
|
Attributes := FileData.dwFileAttributes;
|
||
|
|
Empty := False;
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure TfmGroupControlMain.lvMainDataHint(Sender: TObject; StartIndex,
|
||
|
|
EndIndex: Integer);
|
||
|
|
begin
|
||
|
|
if (StartIndex > ShellItemCount) or (EndIndex > ShellItemCount) then Exit;
|
||
|
|
CheckShellItems(StartIndex, EndIndex);
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure TfmGroupControlMain.lvMainData(Sender: TObject; Item: TListItem);
|
||
|
|
var
|
||
|
|
Attrs: string;
|
||
|
|
begin
|
||
|
|
if (Item.Index > ShellItemCount) then Exit;
|
||
|
|
with ShellItems[Item.Index]^ do
|
||
|
|
begin
|
||
|
|
Item.Caption := DisplayName;
|
||
|
|
Item.ImageIndex := ImageIndex;
|
||
|
|
|
||
|
|
if lvMain.ViewStyle <> vsReport then Exit;
|
||
|
|
|
||
|
|
if not IsFolder(ShellFolder, ID) then
|
||
|
|
Item.SubItems.Add(Format('%dKB', [Size]))
|
||
|
|
else Item.SubItems.Add('');
|
||
|
|
Item.SubItems.Add(TypeName);
|
||
|
|
try
|
||
|
|
Item.SubItems.Add(ModDate);
|
||
|
|
except
|
||
|
|
end;
|
||
|
|
|
||
|
|
if Bool(Attributes and FILE_ATTRIBUTE_READONLY) then Attrs := Attrs + 'R';
|
||
|
|
if Bool(Attributes and FILE_ATTRIBUTE_HIDDEN) then Attrs := Attrs + 'H';
|
||
|
|
if Bool(Attributes and FILE_ATTRIBUTE_SYSTEM) then Attrs := Attrs + 'S';
|
||
|
|
if Bool(Attributes and FILE_ATTRIBUTE_ARCHIVE) then Attrs := Attrs + 'A';
|
||
|
|
end;
|
||
|
|
Item.SubItems.Add(Attrs);
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure TfmGroupControlMain.lvMainDataFind(Sender: TObject; Find: TItemFind;
|
||
|
|
const FindString: String; const FindPosition: TPoint; FindData: Pointer;
|
||
|
|
StartIndex: Integer; Direction: TSearchDirection; Wrap: Boolean;
|
||
|
|
var Index: Integer);
|
||
|
|
var
|
||
|
|
I: Integer;
|
||
|
|
Found: Boolean;
|
||
|
|
begin
|
||
|
|
I := StartIndex;
|
||
|
|
if (Find = ifExactString) or (Find = ifPartialString) then
|
||
|
|
begin
|
||
|
|
repeat
|
||
|
|
if (I = ShellItemCount - 1) then
|
||
|
|
if Wrap then I := 0 else Exit;
|
||
|
|
Found := Pos(UpperCase(FindString), UpperCase(ShellItems[I]^.DisplayName)) = 1;
|
||
|
|
Inc(I);
|
||
|
|
until Found or (I = StartIndex);
|
||
|
|
if Found then Index := I-1;
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure TfmGroupControlMain.lvMainCustomDrawItem(Sender: TCustomListView;
|
||
|
|
Item: TListItem; State: TCustomDrawState; var DefaultDraw: Boolean);
|
||
|
|
var
|
||
|
|
Attrs: Integer;
|
||
|
|
begin
|
||
|
|
if Item = nil then Exit;
|
||
|
|
Attrs := ShellItems[Item.Index].Attributes;
|
||
|
|
if Bool(Attrs and FILE_ATTRIBUTE_READONLY) then
|
||
|
|
lvMain.Canvas.Font.Color := clGrayText;
|
||
|
|
if Bool(Attrs and FILE_ATTRIBUTE_HIDDEN) then
|
||
|
|
lvMain.Canvas.Font.Style :=
|
||
|
|
lvMain.Canvas.Font.Style + [fsStrikeOut];
|
||
|
|
if Bool(Attrs and FILE_ATTRIBUTE_SYSTEM) then
|
||
|
|
lvMain.Canvas.Font.Color := clHighlight;
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure TfmGroupControlMain.lvMainCustomDrawSubItem(Sender: TCustomListView;
|
||
|
|
Item: TListItem; SubItem: Integer; State: TCustomDrawState;
|
||
|
|
var DefaultDraw: Boolean);
|
||
|
|
begin
|
||
|
|
if SubItem = 0 then Exit;
|
||
|
|
lvMain.Canvas.Font.Color := GetSysColor(COLOR_WINDOWTEXT);
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure TfmGroupControlMain.btnBackClick(Sender: TObject);
|
||
|
|
var
|
||
|
|
Temp: PItemIDList;
|
||
|
|
begin
|
||
|
|
if FSearchShellID = nil then
|
||
|
|
begin
|
||
|
|
Temp := CopyPIDL(FShellID);
|
||
|
|
if Assigned(Temp) then
|
||
|
|
StripLastID(Temp);
|
||
|
|
if Temp.mkid.cb <> 0 then
|
||
|
|
SetPath(Temp)
|
||
|
|
else Beep;
|
||
|
|
end
|
||
|
|
else SetPath(FSearchShellID);
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure TfmGroupControlMain.Form1Close(Sender: TObject; var Action: TCloseAction);
|
||
|
|
begin
|
||
|
|
FSearching := False;
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure TfmGroupControlMain.btnSearchClick(Sender: TObject);
|
||
|
|
begin
|
||
|
|
if not FSearching then
|
||
|
|
SetSearch(FShellID, edSearch.Text)
|
||
|
|
else FSearching := False;
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure TfmGroupControlMain.biDesktopClick(Sender: TObject);
|
||
|
|
begin
|
||
|
|
SetPath(GetIDBySpetialFolder(CSIDL_DESKTOPDIRECTORY));
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure TfmGroupControlMain.biMyDocumentsClick(Sender: TObject);
|
||
|
|
begin
|
||
|
|
SetPath(GetIDBySpetialFolder(CSIDL_PERSONAL));
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure TfmGroupControlMain.biNetworkClick(Sender: TObject);
|
||
|
|
begin
|
||
|
|
SetPath(GetIDBySpetialFolder(CSIDL_NETWORK));
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure TfmGroupControlMain.FormDestroy(Sender: TObject);
|
||
|
|
begin
|
||
|
|
ClearIDList;
|
||
|
|
FIDList.Free;
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure TfmGroupControlMain.tvMyComputerClick(Sender: TObject);
|
||
|
|
begin
|
||
|
|
if (tvMyComputer.Selected <> nil) and (tvMyComputer.Selected.Data <> nil) then
|
||
|
|
SetPath(PItemIDList(tvMyComputer.Selected.Data));
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure TfmGroupControlMain.lvMyFavoritesClick(Sender: TObject);
|
||
|
|
begin
|
||
|
|
if (lvMyFavorites.Selected <> nil) and (lvMyFavorites.Selected.Data <> nil) then
|
||
|
|
SetPath(PItemIDList(lvMyFavorites.Selected.Data));
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure TfmGroupControlMain.cbViewsChange(Sender: TObject);
|
||
|
|
begin
|
||
|
|
nbMain.View := cbViews.ItemIndex;
|
||
|
|
end;
|
||
|
|
|
||
|
|
end.
|