1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100
| function SlashDirName(szDir: String): String;
var
s: String;
bRootDir: Boolean;
begin
if szDir <> '' then
begin
s := szDir;
bRootDir := ((Length(s) = 3) and (S[2] = ':')) or (s = '\');
if not bRootDir then
if s[Length(s)] <> '\' then
s := s + '\';
Result := s;
end;
end;
function SHGetIDListFromPath(Path: TFileName; var ShellFolder: IShellFolder): pItemIDList;
var
TempPath, NextDir: TFileName;
nSlashPos, nScanParam: Integer;
Folder, subFolder: IShellFolder;
PIDL, PIDLbase: PItemIDList;
ParseStruct: TStrRet;
szParseName: String;
EList: IEnumIDList;
DidGet: ULONG;
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
nSlashPos := Pos('\', TempPath);
if nSlashPos > 0 then
begin
if Pos(':', TempPath) > 0 then
NextDir := Copy(TempPath, 1, 3)
else
NextDir := SlashDirName(NextDir) + Copy(TempPath, 1, nSlashPos - 1);
TempPath := Copy(TempPath, nSlashPos + 1, Length(TempPath));
end
else
begin
if NextDir = '' then
NextDir:=TempPath
else
NextDir := SlashDirName(NextDir) + TempPath;
TempPath := '';
end;
Pidl := PidlBase;
nScanParam := SHCONTF_FOLDERS or SHCONTF_INCLUDEHIDDEN;
if (NextDir = Path) and (not DirectoryExists(Path)) then
nScanParam := nScanParam or SHCONTF_NONFOLDERS;
if S_OK = SubFolder.EnumObjects(0, nScanParam, 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: szParseName := ParseStruct.cStr;
STRRET_WSTR: szParseName := WideCharToString(ParseStruct.pOleStr);
STRRET_OFFSET: szParsename := PChar(DWORD(Pidl) + ParseStruct.uOffset);
end;
if UpperCase(szParsename) = 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; |
Partager