{ This code is courtesy of Teus de Jong }

function SHGetIDListFromPath(Path: TFileName; var ShellFolder: IShellFolder): pItemIDList;
var TempPath, NextDir: TFileName;
    SlashPos: Integer;
    Folder, subFolder: IShellFolder;
    PIDL, PIDLbase: PItemIDList;
    ParseStruct: TStrRet;
    ParseNAme: string;
    EList: IEnumIDList;
    DidGet: integer;
    ScanParam: integer;
begin
  SHGetDesktopFolder(Folder);
  SHGetSpecialFolderLocation(0, CSIDL_DRIVES, PIDLbase);

  OLECheck(Folder.BindToObject(PIDLbase, nil, IID_IShellFolder, Pointer(SubFolder)));
  TempPath := Path;
  NextDir := '';

  { Enumerate the path one directory at a time }
  while Length(TempPath)>0 do
  begin
    SlashPos := Pos('\', TempPath);
    if SlashPos > 0 then
    begin
      if Pos(':', TempPath) > 0 then NextDir := Copy(TempPath, 1, 3)
      else NextDir := SlashDirName(NextDir) + Copy(TempPath, 1, SlashPos - 1);
      TempPath := Copy(TempPath, SlashPos + 1, Length(TempPath));
    end else begin
      if NextDir = '' then NextDir:=TempPath
      else NextDir := SlashDirName(NextDir) + TempPath;
      TempPath := '';
    end;

    Pidl := PidlBase;
    ScanParam := SHCONTF_FOLDERS or SHCONTF_INCLUDEHIDDEN;
    if (NextDir = Path) and (not DirectoryExists(Path))
      ScanParam := ScanParam or SHCONTF_NONFOLDERS;

    if S_OK = SubFolder.EnumObjects(0, ScanParam, EList) then
      while S_OK = EList.Next(1, pidl, DidGet) do
      begin
        OLECheck(SubFolder.GetDisplayNameOf(PIDL, SHGDN_FORPARSING, ParseStruct));
        case ParseStruct.uType of
          STRRET_CSTR: ParseName := ParseStruct.cStr;
          STRRET_WSTR: ParseName := WideCharToString(ParseStruct.pOleStr);
          STRRET_OFFSET: Parsename := PChar(DWORD(Pidl)+ParseStruct.uOffset);
        end;
        if UpperCase(Parsename) = UpperCase(NextDir) then Break;
      end else begin
        Folder:=nil;
        Result:=nil;
        Exit;
      end;

      if DidGet=0 then
      begin
        Folder := nil;
        Result := nil;
        Exit;
      end;
      PIDLBase := Pidl;
      Folder := subFolder;

      { As best as we can, determine whether or not this is a file.       }
      { If so then we cannot bind it to the ShellFolder (hence "folder".) }
      if not FileExists(NextDir) then
        OLECheck(Folder.BindToObject(Pidl, nil, IID_IShellFolder, Pointer(SubFolder)));
    end;

  ShellFolder := Folder;
  if ShellFolder = nil then Result := nil
  else Result := Pidl;
end;

function SlashDirName(ADir: String): string;
var s: string;
    RootDir: Boolean;
begin
  if ADir <> '' then
  begin
    s := ADir;
    RootDir := ((Length(s) = 3) and (S[2] = ':')) or (s = '\');
    if not RootDir then
      if s[Length(s)] <> '\' then s := s + '\';
    Result := s;
  end;
end;
 

Return to the main page