e FillTreeView(Folder: IShellFolder; FullPIDL: PItemIDList; ParentNode: TTreeNode);
end;
var
Form1: TForm1;
implementation
{$R *.DFM}
uses
ActiveX, ComObj, ShellAPI, CommCtrl;
// 以下是几个对项目标识符进行操作的函数
procedure DisposePIDL(ID: PItemIDList);
var
Malloc: IMalloc;
begin
if ID = nil then Exit;
OLECheck(SHGetMalloc(Malloc));
Malloc.Free(ID);
end;
function CopyItemID(ID: PItemIDList): PItemIDList;
var
Malloc: IMalloc;
begin
Result := nil;
OLECheck(SHGetMalloc(Malloc));
if Assigned(ID) then
begin
Result := Malloc.Alloc(ID^.mkid.cb + sizeof(ID^.mkid.cb));
CopyMemory(Result, ID, ID^.mkid.cb + sizeof(ID^.mkid.cb));
end;
end;
function NextPIDL(ID: PItemIDList): PItemIDList;
begin
Result := ID;
Inc(PChar(Result), ID^.mkid.cb);
end;
function GetPIDLSize(ID: PItemIDList): Integer;
begin
Result := 0;
if Assigned(ID) then
begin
Result := sizeof(ID^.mkid.cb);
while ID^.mkid.cb <> 0 do
begin
Inc(Result, ID^.mkid.cb);
ID := NextPIDL(ID);
end;
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 ConcatPIDLs(ID1, ID2: PItemIDList): PItemIDList;
var
cb1, cb2: Integer;
begin
if Assigned(ID1) then
cb1 := GetPIDLSize(ID1) - sizeof(ID1^.mkid.cb)
else
cb1 := 0;
cb2 := GetPIDLSize(ID2);
Result := CreatePIDL(cb1 + cb2);
if Assigned(Result) then
begin
if Assigned(ID1) then
CopyMemory(Result, ID1, cb1);
CopyMemory(PChar(Result) + cb1, ID2, cb2);
end;
end;
// 将二进制表示的项目标识符列表转换成有可识的项目名
function GetDisplayName(Folder: 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;
Folder.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 GetIcon(PIDL: PItemIDList; Open: Boolean): Integer;
const
IconFlag = SHGFI_PIDL or SHGFI_SYSICONINDEX or SHGFI_SMALLICON;
var
FileInfo: TSHFileInfo;
Flags: Integer;
begin
if Open then
Flags := IconFlag or SHGFI_OPENICON
else
Flags := IconFlag;
SHGetFileInfo(PChar(PIDL), 0, FileInfo, sizeof(TSHFileInfo), Flags);
Result := FileInfo.iIcon;
end;
// 获得每个文件夹在系统中的图标
procedure GetItemIcons(FullPIDL: PItemIDList; TreeNode: TTreeNode);
begin
with TreeNode do
begin
ImageIndex := GetIcon(FullPIDL, False);
SelectedIndex := GetIcon(FullPIDL, True);
end;
end;
// 获得系统的图标列表
procedure TForm1.SetTreeViewImageList;
var
ImageList: THandle;
FileInfo: TSHFileInfo;
begin
ImageList := SHGetFileInfo(PChar(''C:\''), 0, FileInfo,
sizeof(TSHFileInfo), SHGFI_SYSICONINDEX or SHGFI_
