• Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 292
  • Last Modified:

Subdirectory of \\computername

I need some _code_ to get the subdirectories of \\computername in say a TStringList. Its easy to get the subdirectories/files from say \\computername\c-drive however findfirst doesnt work with \\computername.
0
Portal
Asked:
Portal
  • 2
1 Solution
 
EpsylonCommented:
This works for Delphi 4 and 5:


unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, ShellAPI;

type
  TForm1 = class(TForm)
    ListBox1: TListBox;
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

uses ShellFolders;

{$R *.DFM}

procedure TForm1.FormCreate(Sender: TObject);
var sf: TShellFolders;
begin
  sf := TShellFolders.Create('\\Babylon4');
  ListBox1.Clear;
  ListBox1.Items.AddStrings(sf.FileList);
  sf.Free;
end;

end.
0
 
EpsylonCommented:
unit ShellFolders;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, ShlObj, ShellApi, ActiveX, ComCtrls;

type
  TShellFolders = class(TObject)
  private
    FShellMalloc: IMalloc;
    RootFolder: IShellFolder;
    function GetDisplayName(ShellFolder: IShellFolder;
                            PIDL: PItemIDList;
                            Flags: Cardinal): string;
    function GetSFFlags: DWORD;
    procedure Enumerate(parentfolder: IShellFolder; pidl: PItemIDList);
    procedure FreePIDL(PIDL: PItemIDList);
    function GetIDFromPath(const ShellFolder: IShellFolder;
                           const APath: string;
                           var ID: PItemIDList): boolean;
  public
    FileList: TStringList;
    constructor Create(Path: String);
    destructor Destroy; override;
  end;
                         
implementation

{ TShellFolders }

constructor TShellFolders.Create(Path: String);
var pidl: PItemIDList;
begin
  inherited Create;
  FileList := TStringList.Create;
  SHGetMalloc(FShellMalloc);
  SHGetDesktopFolder(RootFolder);
  if GetIDFromPath(RootFolder, Path, pidl) then
  begin
    Enumerate(RootFolder, pidl);
    FreePIDL(pidl);
  end;
end;

destructor TShellFolders.Destroy;
begin
  FileList.Free;
  inherited;
end;

procedure TShellFolders.Enumerate(parentfolder: IShellFolder; pidl: PItemIDList);
var tpidl: PItemIDList;
    folder: IShellFolder;
    EnumList: IEnumIDList;
    NumIDs: LongWord;
    Name: String;
begin
  parentfolder.BindToObject(pidl, nil, IID_IShellFolder, Pointer(folder));
  if folder.EnumObjects(Application.Handle,GetSFFlags,EnumList) = NO_ERROR then
  begin
    while EnumList.Next(1, tpidl, NumIDs) = NO_ERROR do
    begin
      Name := GetDisplayName(folder, tpidl, SHGDN_INFOLDER);
      FileList.Add(Name);
      FreePIDL(tpidl);
    end;
  end;
end;

function TShellFolders.GetSFFlags: DWORD;
begin
  Result:= SHCONTF_FOLDERS or SHCONTF_NONFOLDERS or SHCONTF_INCLUDEHIDDEN;
end;

function TShellFolders.GetDisplayName(ShellFolder: IShellFolder;
                               PIDL: PItemIDList;
                               Flags: Cardinal): string;
var StrRet: TStrRet;
    P: PChar;
begin
  Result := '';
  ShellFolder.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 TShellFolders.GetIDFromPath(const ShellFolder: IShellFolder;
                                  const APath: string;
                                  var ID: PItemIDList): boolean;
var
  OLEStr: array[0..MAX_PATH] of TOLEChar;
  Eaten: ULONG;
  Attr: ULONG;
begin
  if ShellFolder.ParseDisplayName(Application.Handle, NIL,
       StringToWideChar(APath, OLEStr, MAX_PATH),
       Eaten, ID, Attr) = NOERROR then
    Result:=true
  else
    Result:=false;
end;

procedure TShellFolders.FreePIDL(PIDL: PItemIDList);
begin
  if Assigned(PIDL) then FShellMalloc.Free(PIDL);
end;

end.
0
 
l8knightCommented:
Epsylon: Nice Code.

But it only worked for me when I added a backslash to the path.

e.g. '\\Babylon4' should be '\\Babylon4\'

l8knight
0
 
PortalAuthor Commented:
Epsylon you are a god - fantastic answer and it also works in delphi 3 (with a change from longword to integer).
0
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

Join & Write a Comment

Featured Post

Cloud Class® Course: Python 3 Fundamentals

This course will teach participants about installing and configuring Python, syntax, importing, statements, types, strings, booleans, files, lists, tuples, comprehensions, functions, and classes.

  • 2
Tackle projects and never again get stuck behind a technical roadblock.
Join Now