|
MathiasSimmack
(Gast)
n/a Beiträge |
#24
Ich habe mal ein VCL-Beispiel für den Shell-Weg geschrieben. Das funktioniert nicht mit "FindFirst" (wenn du deinem Lehrer glaubhaft versichern kannst, dass das von dir ist, dann nimm´s für deine Schulaufgabe, @Kruemel2oo2,
![]()
Delphi-Quellcode:
Die (private) Prozedur "FillTV" folgt auf dem Fuße. Die Sortierfunktion stammt aus der Delphi-Hilfe, ich habe bloß das Minus vor "AnsiStrIComp" weggelassen:
procedure TForm1.FormCreate(Sender: TObject);
var fi : TSHFileInfo; hSmallImg : HIMAGELIST; begin ZeroMemory(@fi,sizeof(TSHFileInfo)); hSmallImg := HIMAGELIST(SHGetFileInfo('',0,fi,sizeof(fi), SHGFI_SYSICONINDEX or SHGFI_SMALLICON)); if(hSmallImg <> 0) then TreeView_SetImageList(tv.Handle,hSmallImg,TVSIL_NORMAL); self.FillTV; end;
Delphi-Quellcode:
Es fehlen noch ein paar Hilfsfunktionen, um bspw. den Namen für den Baum und das Symbol zu ermitteln:
function TVSort(Node1, Node2: TTreeNode; Data: Integer): Integer; stdcall;
begin Result := AnsiStrIComp(PChar(Node1.Text),PChar(Node2.Text)); end; procedure TForm1.FillTV; function CreateTreeNode(const iDesktopFolder: IShellFolder; hParent: TTreeNode; pidlNode: PItemIdList): TTreeNode; var szCaption : string; begin // der Name, wie man ihn aus dem Explorer kennt, ... szCaption := GetDisplayName(iDesktopFolder,pidlNode); // wer den kompletten Pfad sehen will (ein Vorteil bei der // Shell-Methode), der hängt als dritten Parameter die // beiden Flags // SHGDN_NORMAL or SHGDN_FORPARSING // an. :o) // Knoten erzeugen if(hParent = nil) then Result := tv.Items.AddFirst(nil,szCaption) else Result := tv.Items.AddChild(hParent,szCaption); Result.ImageIndex := GetShellImg(iDesktopFolder,pidlNode,false); Result.SelectedIndex := GetShellImg(iDesktopFolder,pidlNode,true); end; procedure Scan(const hParent: TTreeNode; iRootFolder: IShellFolder; pidlParent: PItemIdList; pMalloc: IMalloc); var tn : TTreeNode; iFolder : IShellFolder; ppEnum : IEnumIdList; hr : HRESULT; pidlItem : PItemIdList; uAttr, celtFetched : ULONG; begin // an ein untergeordnetes "IShellFolder"-Interface binden, ... if(iRootFolder.BindToObject(pidlParent,nil,IID_IShellFolder, iFolder) = S_OK) then begin // ... & die Enumerierung starten if(iFolder.EnumObjects(0,SHCONTF_FOLDERS or SHCONTF_INCLUDEHIDDEN, ppEnum) = S_OK) then begin hr := ppEnum.Next(1,pidlItem,celtFetched); while(hr = S_OK) and (celtFetched = 1) do begin // Knoten erzeugen tn := CreateTreeNode(iFolder,hParent,pidlItem); // wenn das aktuelle Element ein Ordner ist, // dann diese Prozedur erneut aufrufen und // den Ordner scannen lassen iFolder.GetAttributesOf(1,pidlItem,uAttr); if(uAttr and SFGAO_FOLDER <> 0) then Scan(tn,iFolder,pidlItem,pMalloc); // die benutzte "PItemIdList" freigeben, ... pMalloc.Free(pidlItem); pidlItem := nil; // ... & ab zum nächsten Element hr := ppEnum.Next(1,pidlItem,celtFetched); end; end; iFolder := nil; end; end; var pMalloc : IMalloc; iDesktop : IShellFolder; pidlRoot : PItemIdList; tn : TTreeNode; begin tv.Items.Clear; tv.Items.BeginUpdate; if(SHGetMalloc(pMalloc) = NOERROR) and (SHGetDesktopFolder(iDesktop) = NOERROR) then try // die "PItemIdList" des Laufwerks C:\ ermitteln GetIdFromPath(iDesktop,'c:\',pidlRoot); if(pidlRoot = nil) then exit; // Root einfügen, ... tn := CreateTreeNode(iDesktop,nil,pidlRoot); // ... & Laufwerk scannen, ... Scan(tn,iDesktop,pidlRoot,pMalloc); // "pidlRoot" freigeben if(pidlRoot <> nil) then pMalloc.Free(pidlRoot); pidlRoot := nil; finally pMalloc := nil; iDesktop := nil; end; tv.CustomSort(@TVSort,0); tv.Items[0].Expand(false); tv.Items.EndUpdate; end;
Delphi-Quellcode:
Die Funktion "GetShellImg" ist überladen, weil ich anfangs ein Problem mit dem Symbol von "Eigene Dateien" hatte. Zurückgeliefert wurde mir das "Unbekannte Datei"-Icon (das leere Blatt mit dem Win-Symbol). Ursache war, warum auch immer?, die Verwendung der "PItemIdList". Wenn ich stattdessen den kompletten Pfad benutzt habe, sah ich zwar das richtige Symbol, allerdings brach die Performance ein.
function GetIdFromPath(const iDesktopFolder: IShellFolder; szPath: string;
out pidl: PItemIdList): boolean; var pchEaten, dwAttributes : dword; pcwPath : array[0..MAX_PATH]of widechar; begin Result := false; if(iDesktopFolder <> nil) and (szPath <> '') then begin StringToWideChar(szPath,pcwPath,sizeof(pcwPath)); iDesktopFolder.ParseDisplayName(0,nil,pcwPath,pchEaten,pidl,dwAttributes); Result := (pidl <> nil); end; end; function GetShellImg(const pidl: PItemIdList; fOpen: boolean): integer; overload; var fi : TSHFileInfo; dwFlags : dword; begin dwFlags := SHGFI_PIDL or SHGFI_SYSICONINDEX; if(fOpen) then dwFlags := dwFlags or SHGFI_OPENICON; SHGetFileInfo(pchar(pidl),0,fi,sizeof(fi),dwFlags); Result := fi.iIcon; end; function GetShellImg(const iDesktop: IShellFolder; pidl: PItemIdList; fOpen: boolean): integer; overload; var isi : IShellIcon; uFlags : uint; begin if(iDesktop.QueryInterface(IID_IShellIcon,isi) = S_OK) then begin if(fOpen) then uFlags := GIL_OPENICON else uFlags := 0; if(isi.GetIconOf(pidl,uFlags,Result) <> NOERROR) then Result := GetShellImg(pidl,fOpen); if(isi <> nil) then isi := nil; end else Result := GetShellImg(pidl,fOpen); end; function GetDisplayName(const iDesktop: IShellFolder; pidl: PItemIdList; dwFlags: dword = SHGDN_NORMAL): string; var StrRet : TStrRet; p : pchar; begin Result := ''; iDesktop.GetDisplayNameOf(pidl,dwFlags,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: if(StrRet.pOleStr <> nil) then Result := StrRet.pOleStr end; end; Dank neolithos (meinen herzlichsten Dank nochmals! ![]() Hinweis: Ich habe erst seit dem Wochenende an diesen Interfaces gesessen. Es ist also keineswegs der optimalste Weg. Ich denke, man kann da noch mehr Geschwindigkeit rausholen, denn wenn ich bspw. meine XP-Partition K:\ scannen lasse, dauert das schon recht lange. Wenn ich dagegen an den Windows-Explorer denke, ... ![]() Wer also Optimierungen beisteuern kann und will, der ist von meiner Seite aus sehr gern gesehen. Mich interessiert das nämlich. ![]() Ach ja: Gebraucht werden die Units:
Delphi-Quellcode:
und
uses
ShellAPI, ShlObj, ActiveX, CommCtrl;
Delphi-Quellcode:
sollte auch angegeben werden.
initialization
CoInitialize(nil); finalization CoUninitialize; end. |
![]() |
Ansicht |
![]() |
![]() |
![]() |
ForumregelnEs ist dir nicht erlaubt, neue Themen zu verfassen.
Es ist dir nicht erlaubt, auf Beiträge zu antworten.
Es ist dir nicht erlaubt, Anhänge hochzuladen.
Es ist dir nicht erlaubt, deine Beiträge zu bearbeiten.
BB-Code ist an.
Smileys sind an.
[IMG] Code ist an.
HTML-Code ist aus. Trackbacks are an
Pingbacks are an
Refbacks are aus
|
|
Nützliche Links |
Heutige Beiträge |
Sitemap |
Suchen |
Code-Library |
Wer ist online |
Alle Foren als gelesen markieren |
Gehe zu... |
LinkBack |
![]() |
![]() |