Symbole des Desktops auslesen (Auflisten der DesktopSymbole)

[Giantics]

Der folgende Code liest alle Symbole vom Arbeitsplatz aus,
samt Bilder und Namen und zeigt diese in einem ListView an.

Die Form besitzt 3 Komponenten:

ein Listview mit ViewStyle = vsIcon
ein ImageList mit Height und Width = 32 und BkColor = clWhite
ein Button mit OnClick = ReadDataCklick

Quellcode getestet nur auf XP.

Delphi-Quellcode:

{Source by Havoc}

unit MyComputer;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ImgList, StdCtrls, ExtCtrls, ComCtrls,
  ShlObj, ActiveX, ShellApi, ComObj, CommCtrl;

type
  TMainForm = class(TForm)
    ListView: TListView;
    Panel: TPanel;
    btnReadData: TButton;
    SysImageList: TImageList;
    procedure ReadDataClick(Sender: TObject);
  private
    {Private-Deklarationen}
  public
    {Public-Deklarationen}
    procedure AddNewItem(RootFolder : IShellFolder; ID : PItemIDList);
end;

var
  MainForm: TMainForm;

implementation

{$R *.dfm}

function GetInterfaceForObj(const ItemIDList : PItemIDList) : IUnknown;
var
  Desktop : IShellFolder;
begin
  Assert(SHGetDesktopFolder(Desktop)= S_OK); //Ermittle die Interface für den 
Desktop
  try
    //Das übergebene Object wird als ein Unterordner von Desktop regestriert
    Assert(Desktop.BindToObject(ItemIDList, nil, IID_IShellFolder, result) = S_OK);
  finally
    Desktop:=nil; //Interface freigeben
  end;
end;

function StrRetToString(SR : StrRet; ID : TItemIDList) : String;
var
  Malloc : IMalloc;
begin
  case SR.uType of
    STRRET_CSTR : result:=SR.cStr;
    STRRET_WSTR : 
      begin
        result:=WideString(SR.pOleStr);
        if SHGetMalloc(Malloc) = S_OK then
        begin
          Malloc.Free(SR.pOleStr);
          SR.pOleStr:=nil;
          Malloc:=nil;
        end;
      end;
    STRRET_OFFSET : result:=String(PChar(Cardinal(@ID)+SR.uOffset));
    else result:='';
  end;
end;

function PackIconSize (LargeIcon, SmallIcon : Word) : Cardinal;
begin
  result:=SmallIcon shl 16;
  result:=result or LargeIcon;
end;

procedure TMainForm.AddNewItem(RootFolder : IShellFolder; ID : PItemIDList);
var
  DispName : STRRet;
  IconExtractor : IExtractIconW;
  IconFile : PWideChar;
  IconIndex : Integer;
  retFlags : Cardinal;
  LargeIcon : HICON;
begin
  RootFolder.GetDisplayNameOf(ID, SHGDN_NORMAL, DispName); //Caption des Items holen
  with ListView.Items.Add do //Neues Item in dem ListView erzeugen
  begin
    Caption:=StrRetToString(DispName, ID^); //Caption setzen
    RootFolder.GetUIObjectOf(Handle, 1, ID, IID_IExtractIconW, nil, IconExtractor); //Interface für das extrairen des Symbols hohlen
    retFlags := 0;
    if IconExtractor<>nil then
    begin
      GetMem(IconFile, MAX_PATH*SizeOf(WideChar));
      try
        if IconExtractor.GetIconLocation(GIL_FORSHELL, IconFile, MAX_PATH, IconIndex, retFlags) = S_OK then //Name und Index des Symbols hohlen
        begin
          if IconExtractor.Extract(IconFile, IconIndex, LargeIcon, HICON(nil^), PackIconSize(32, 16)) = NOERROR then //Symbol extrairen
          ImageIndex:=ImageList_AddIcon(Self.ListView.LargeImages.Handle, LargeIcon);
        end;
      finally
        //Wenn das Icon eine extra für uns angelegte Kopie ist, dann freigeben
        if (GIL_DONTCACHE and retFlags = 0) and (LargeIcon<>0) then DestroyIcon(LargeIcon);
        FreeMem(IconFile, MAX_PATH*SizeOf(WideChar));
        IconExtractor:=nil; //Interface freigeben
      end;
    end else ImageIndex:=-1;
  end;
end;

procedure TMainForm.ReadDataClick(Sender: TObject);
var
  MyComputerID : PItemIDList;
  Malloc : IMalloc;
  MyComputer : IShellFolder;
  EnumIDList : IEnumIDList;
  ItemID : PItemIDList;
  Fetched : Cardinal;
  Return : HResult;
begin
  SHGetMalloc(Malloc); //Speichermanager ermitteln
  try
    MyComputerID:=Malloc.Alloc(SizeOf(TItemIDList)); //Speicher für die ID des Arbeitsplatzes reservieren
    try
      SHGetSpecialFolderLocation(Handle, CSIDL_DRIVES, MyComputerID); //Nach dem ID des Arbeitsplatzes fragen
      MyComputer:=GetInterfaceForObj(MyComputerID) as IShellFolder; //Interface für das ID ermitteln
      MyComputer.EnumObjects(Handle, SHCONTF_FOLDERS or SHCONTF_INCLUDEHIDDEN, EnumIDList); //Alle objecte aufzählen
      ItemID:=Malloc.Alloc(SizeOf(TItemIDList)); //Speicher für die IDs der Items reservieren
      try
        repeat
          Return := EnumIDList.Next(1, ItemID, Fetched); //Das aktuelle Item ermitteln
          if (Return = NOERROR) and (Fetched > 0) then //Wenn ales ohne Fehler verlief und ein Item wurde zurückgegeben, dann ...
            AddNewItem(MyComputer, ItemID); //dann dieses Item der Liste hinzufügen
        until Return = S_FALSE;
      finally
        Malloc.Free(ItemID); //Speicher für die IDs der Items wieder freigeben
        ItemID:=nil;
        EnumIDList:=nil; //Liste mit den Items wieder freigeben
      end;
    finally
      Malloc.Free(MyComputerID); //Speicher freigeben
      MyComputerID:=nil;
      MyComputer:=nil; //Arbeitsplazinterface freigeben
    end;
  finally
    Malloc:=nil; //Speichermanager freigeben
  end;
end;

end.