uses shlobj, activex, shellapi, commctrl;
procedure Arbeitsplatz(lv: TListview; il: TImagelist);
var
pshl, ShlFlr: IShellFolder;
FileInfo: SHFileInfo;
PIDL: PITEMIDLIST;
EIDL: IEnumIDList;
PMalloc: IMalloc;
item: TListitem;
strr: _STRRET;
sl: TStringList;
pF: Cardinal;
x: integer;
begin
il.clear;
il.width := 32;
il.height := 32;
lv.Items.clear;
lv.ViewStyle := vsIcon;
lv.LargeImages := il;
sl := TStringList.Create;
try
SHGetDesktopFolder(ShlFlr);
SHGetSpecialFolderLocation(0, CSIDL_DRIVES, pidl);
SHGetMalloc(PMalloc);
ShlFlr.BindToObject(pidl, nil, IID_IShellFolder, Pointer(pshl));
pshl.EnumObjects(0, SHCONTF_FOLDERS, EIDL);
while EIDL.Next(1, pidl, pF) = S_OK do
begin
pF := 0;
strr.uType := 0;
pshl.GetDisplayNameOf(pidl, SHGDN_FORPARSING, strr);
sl.Add(strr.pOleStr);
end;
for x := 0 to sl.count - 1 do begin
SHGetFileInfo(PChar(sl[x]), 0,
FileInfo, sizeof(SHFileInfo), SHGFI_ICON or SHGFI_DISPLAYNAME);
ImageList_AddIcon(il.handle, FileInfo.hIcon);
item := lv.items.add;
item.Imageindex := x;
item.caption := FileInfo.szDisplayName;
end;
finally
sl.Free;
pMalloc._Release;
pMalloc := nil;
end;
end;
// Beispielaufruf
procedure TForm1.Button1Click(Sender: TObject);
begin
Arbeitsplatz(Listview1, Imagelist1);
end;