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.

[Luckie]

Das get auch einfacher:

Delphi-Quellcode:

type
  TDesktopIconInfo = packed record
    Caption: string;
    Position: TPoint;
  end;

  TDesktopIconInfoArray = array of TDesktopIconInfo;
  TIniSections = array of string;

Delphi-Quellcode:

////////////////////////////////////////////////////////////////////////////////
// Diese Funktion ist zwar einfach, aber nicht sicher genug (WinXP)

{-----------------------------------------------------------------------------
  Procedure : GetDesktopListView - Author : -
  Purpose   : Desktop Listview Handle ermitteln
  Result    : HWND
-----------------------------------------------------------------------------}

function GetDesktopListView(): HWND;
var
  ClassName    : string;
begin
  Result := FindWindow('ProgMan', nil);
  Result := GetWindow(Result, GW_CHILD);
  Result := GetWindow(Result, GW_CHILD);
  SetLength(ClassName, 40);
  SetLength(ClassName, GetClassName(Result, PChar(ClassName), 39));
  if (ClassName <> 'SysListView32') then
  begin
    MessageBox(0, PChar(ERROR_GETDESKTOPHANDLE), APPNAME, MB_ICONERROR or MB_OK);
    Result := 0;
  end;
end;

////////////////////////////////////////////////////////////////////////////////
// Durch die Verwendung von VirtualAllocEx() funktioniert dieser Code nur auf NT

{-----------------------------------------------------------------------------
  Procedure : GetDesktopIconInfo - Author : Nico Bendlin
  Purpose   : Gets the caption and the position of the desktopicons
  Result    : TDesktopIconInfoArray
-----------------------------------------------------------------------------}

function GetDesktopIconInfo(): TDesktopIconInfoArray;
var
  ListView     : HWND;
  ProcessId    : DWORD;
  Process      : THandle;
  Size         : Cardinal; // SIZE_T
  MemLocal     : Pointer;
  MemRemote    : Pointer;
  NumBytes     : Cardinal; // SIZE_T
  IconCount    : DWORD;
  IconIndex    : Integer;
  IconLabel    : string;
  IconPos      : TPoint;
  DesktopIconInfoArray: TDesktopIconInfoArray;
begin
  // Fensterhandle des Desktop-ListView ermitteln und Prozess oeffnen
  ProcessId := 0;
  ListView := GetDesktopListView();
  GetWindowThreadProcessId(ListView, @ProcessId);
  Process := OpenProcess(PROCESS_VM_OPERATION or PROCESS_VM_READ or
    PROCESS_VM_WRITE, False, ProcessId);
  if (Process <> 0) then
  try
    // Lokalen und entfernten (im Zielprozess) Puffer anlegen
    Size := SizeOf(TLVItem) + SizeOf(Char) * MAX_PATH + 1;
    MemLocal := VirtualAlloc(nil, Size, MEM_RESERVE or MEM_COMMIT,
      PAGE_READWRITE);
    MemRemote := VirtualAllocEx(Process, nil, Size, MEM_RESERVE or MEM_COMMIT,
      PAGE_READWRITE);
    if Assigned(MemLocal) and Assigned(MemRemote) then
    try
      // Anzahl der Symbole ermitteln und in einer Schleife durchlaufen
      IconCount := SendMessage(ListView, LVM_GETITEMCOUNT, 0, 0);
      Setlength(DesktopIconInfoArray, IconCount);
      for IconIndex := 0 to IconCount - 1 do
      begin
        // Symboltext auslesen
        // (es gibt zwei identische Strukturen, jeweils eine in diesem und eine
        //  im Zielprozess. Wobei die Daten zwischen den Puffern hin und her
        //  kopiert werden muessen. Dieser Aufwand ist noetig, da LVM_GETITEM
        //  eine Struktur liest und schreibt, die sich im Adressraum des
        //  Prozesses befindet, dem das entsprechende Fenster gehoert...)
        ZeroMemory(MemLocal, SizeOf(TLVItem));
        with PLVItem(MemLocal)^ do
        begin
          mask := LVIF_TEXT;
          iItem := IconIndex;
          // Der Puffer fuer den Text liegt direkt hinter der TLVItem-Struktur
          pszText := LPTSTR(Cardinal(MemRemote) + Cardinal(SizeOf(TLVItem)));
          cchTextMax := MAX_PATH;
        end;
        NumBytes := 0;
        if WriteProcessMemory(Process, MemRemote, MemLocal, Size, NumBytes) and
          Boolean(SendMessage(ListView, LVM_GETITEM, 0, LPARAM(MemRemote))) and
          ReadProcessMemory(Process, MemRemote, MemLocal, Size, NumBytes) then
        begin
          IconLabel := string(
            PChar(Cardinal(MemLocal) + Cardinal(SizeOf(TLVItem))));
          // Position auslesen
          // (-1, -1 ist nur ein Indiz fuer einen Fehlschlag, da diese Position
          //  natuerlich moeglich ist...)
          IconPos.X := -1;
          IconPos.Y := -1;
          if Boolean(SendMessage(ListView, LVM_GETITEMPOSITION, IconIndex,
            LPARAM(MemRemote))) and ReadProcessMemory(Process, MemRemote,
            MemLocal, Size, NumBytes) then
          begin
            IconPos := PPoint(MemLocal)^;
          end;
          // Speichern ;)
          DesktopIconInfoArray[IconIndex].Caption := IconLabel;
          DesktopIconInfoArray[IconIndex].Position.X := IconPos.X;
          DesktopIconInfoArray[IconIndex].Position.Y := IconPos.Y;
        end;
        result := DesktopIconInfoArray;
      end;
    except
      // Exceptions ignorieren
    end;
    // Aufraeumen
    if Assigned(MemRemote) then
      VirtualFreeEx(Process, MemRemote, 0, MEM_RELEASE);
    if Assigned(MemLocal) then
      VirtualFree(MemLocal, 0, MEM_RELEASE);
  finally
    CloseHandle(Process);
  end;
end;

Frisch aus meinen LuckieDips.

[MathiasSimmack]

Übrigens: Mit der Überschrift hat der Code nicht viel zu tun. Wer alle Desktop-Symbole auslesen will, kommt um ein Programm wie das von Luckie vermutlich nicht herum. Mit dem Shell-Weg ginge es zwar theoretisch auch (man muss ja nur CSIDL_DRIVES durch CSIDL_DESKTOP bzw. CSIDL_COMMON_DESKTOPDIRECTORY ersetzen), aber das zeigt dann natürlich nur den Inhalt des Desktop-Ordners an. Arbeitsplatz, Netzwerkumgebung und Papierkorb und eure sonstigen Systemsymbole würden fehlen.

Ich würde daher die Überschrift ändern (vllt. "Inhalt vom Arbeitsplatz anzeigen"), und dann biete ich hier gleich mal meine Version an. Natürlich kürzer. 8) Aber ernsthaft, es gibt zwei ähnliche Beispiele in den Win32-API-Tutorials von Luckie. Tree-View und Splitter nutzen ja auch die Shell-Funktionen zum Anzeigen von Ordnern usw. Und da die Symbole auch schon im System vorhanden sind, muss man eigentlich sich nicht selbst mit den Icons herumärgern.

Voraussetzungen:

• Eine List-View namens "lv" auf der Form.
• Zwei Imagelisten (small, big), mit "ShareImages" auf TRUE. Beide Imagelisten werden der List-View zugeordnet.
• Die Unit "ShellHelper.pas" aus den o.g. Tutorials (s. Anhang).

Delphi-Quellcode:

uses
  ShlObj, ShellAPI, ActiveX, CommCtrl, ShellHelper;


procedure TForm1.FormCreate(Sender: TObject);
var
  TempImgList : HIMAGELIST;
  fi          : TSHFileInfo;
begin
  // Ich sag´s noch mal: Die beiden Imagelisten "small" und
  // "big" müssen der List-View zugeordnet sein, UND IHRE
  // EIGENSCHAFT "ShareImages" MUSS AUF true STEHEN!!!

  // kleine Symbole aus dem System
  TempImgList := HIMAGELIST(SHGetFileInfo('',0,fi,sizeof(fi),
    SHGFI_SYSICONINDEX or SHGFI_SMALLICON));
  if(TempImgList <> 0) then small.Handle := TempImgList;

  // große Symbole aus dem System
  TempImgList := HIMAGELIST(SHGetFileInfo('',0,fi,sizeof(fi),
    SHGFI_SYSICONINDEX or SHGFI_ICON));
  if(TempImgList <> 0) then big.Handle := TempImgList;
end;


procedure TForm1.Button1Click(Sender: TObject);
var
  pMalloc      : IMalloc;
  iDesktop,
  iMyComputer  : IShellFolder;
  pidlRoot,
  pidlItem,
  tmp          : PItemIdList;
  ppEnum       : IEnumIdList;
  celtFetched  : ULONG;
begin
  lv.Items.Clear;
  lv.Items.BeginUpdate;

  if(CoInitializeEx(nil,COINIT_APARTMENTTHREADED) = S_OK) then
  try
    if(SHGetMalloc(pMalloc) = NOERROR) and
      (SHGetDesktopFolder(iDesktop) = NOERROR) then
    try
      // PIDL des Arbeitsplatzes ermitteln, ...
      SHGetSpecialFolderLocation(self.Handle,CSIDL_DRIVES,pidlRoot);
      if(pidlRoot <> nil) then
      begin
      // ... & an ein IShellFolder-Interface binden, ...
        if(iDesktop.BindToObject(pidlRoot,nil,IID_IShellFolder,
          iMyComputer) = S_OK) then
        begin
      // ... & alle vorhandenen Objekte der Reihe nach durchlaufen
          if(iMyComputer.EnumObjects(0,SHCONTF_FOLDERS or SHCONTF_NONFOLDERS or
            SHCONTF_INCLUDEHIDDEN,ppEnum) = S_OK) then
          begin
            while(ppEnum.Next(1,pidlItem,celtFetched) = S_OK) and
                 (celtFetched = 1) do
            begin
              // temporäre PIDL erzeugen, die für die Symbole gebraucht
              // wird (s. Erklärung zu "SHGetFileInfo" im PSDK; relative
              // PIDLs sind nicht erlaubt!)
              tmp := AppendPIDL(pidlRoot,pidlItem);

              // Eintrag & Symbol erzeugen
              with lv.Items.Add do
              begin
                // Entweder man nimmt die absolute PIDL, dann aber "iDesktop"
                // zum Ermitteln des Namens
                //    Caption    := GetDisplayName(iDesktop,tmp);
                // oder die relative PIDL und "iMyComputer"
                Caption    := GetDisplayName(iMyComputer,pidlItem);

                // für die Symbole ist aber auf jeden Fall die absolute PIDL
                // erforderlich, sonst wird nichts angezeigt (speziell beim
                // Arbeitsplatz ist mir das aufgefallen)
                ImageIndex := GetShellImg(iDesktop,tmp,false);
              end;

              // PIDLs freigeben
              pMalloc.Free(tmp);      tmp      := nil;
              pMalloc.Free(pidlItem); pidlItem := nil;
            end;
          end;
        end;
      end;

      // Arbeitsplatz-PIDL freigeben
      if(pidlRoot <> nil) then pMalloc.Free(pidlRoot);
      pidlRoot := nil;
    finally
      iDesktop := nil;
      pMalloc  := nil;
    end;
  finally
    CoUninitialize;
  end;

  lv.Items.EndUpdate;
end;

Voilà.