PIDL und der Font-Ordner - geht nicht

[KodeZwerg]

Ich habe gestern rumprobiert. Vieeeel rumprobiert.
Das phänomen tritt nur auf wenn du es auf dateien loslässt, nicht auf den ordner wie die topic es benennt.
Das ausbremsen konnt ich nicht verhindern, nichts desto trotz hab ich 'ne mini "verschlimmbesserung" eingebaut.

Delphi-Quellcode:

uses
  System.IOUtils, Winapi.ShlObj, Winapi.ActiveX;

function PathToPidl(const Path: String; out Fallback: Boolean): PItemIdList;
var
  DesktopFolder: IShellFolder;
  dummy: Cardinal;
begin
  Fallback := False;
  Result := nil;
  if (TDirectory.Exists(path, False) or TFile.Exists(path, False)) then
    if Succeeded(SHGetDesktopFolder(DesktopFolder)) then
      if DesktopFolder.ParseDisplayName(0, nil, PChar(Path), dummy, Result, dummy) <> NOERROR then
        if DesktopFolder.ParseDisplayName(0, nil, PChar(ExtractFilePath(Path)), dummy, Result, dummy) = NOERROR then
          Fallback := True;
end;

Aufruf dann so:

Delphi-Quellcode:

procedure TForm1.Button1Click(Sender: TObject);
var
   PIDL: PItemIDList;
   PathName: array[0..MAX_PATH - 1] of Char;
   checker: Boolean;
   path: String;
begin
  path := 'c:\windows\fonts\arial.ttf';
  Memo1.Clear;

  Memo1.Lines.Add('Führe "PathToPIDL(path);" aus.');
  PIDL := PathToPIDL(path, checker);
  if (Assigned(PIDL)) then
    begin
      if SHGetPathFromIDList(PIDL, @PathName) then
        begin
          Memo1.Lines.Add('PathToPIDL: ' + PathName);
          if checker then
            Memo1.Lines.Add('Fallback zum Ordnernamen wurde genutzt.');
         Memo1.Lines.Add('PathToPIDL war ok.');
        end;
      ILFree(PIDL);
    end
    else
      Memo1.Lines.Add('PathToPIDL hat nicht geklappt.');
end;

hier meine anderen versuche, mit ordner klappt alles, mit dateien im fonts ordner versagen alle...

Delphi-Quellcode:

// der klassiker
function PathToPIDL(const Path: String): PItemIDList;
var
  Attrs: DWORD;
begin
  Result := nil;
  try
    CoInitialize(nil);
(*    if (SHParseDisplayName(PChar(Path), nil, Result, 0, Attrs) = S_OK) then
      if not Assigned(Result) then
        Result := nil;*)
    SHParseDisplayName(PChar(Path), nil, Result, 0, Attrs);
  finally
    CoUnInitialize();
  end;
end;

// das was ich oben beschrieben hatte
function PathToPIDL(const Path: String): PItemIDList;
begin
  Result := ILCreateFromPath(PChar(Path));
end;

// deine version etwas entschlackt
function PathToPIDL(const Path: String): PItemIdList;
var
  DesktopFolder: IShellFolder;
  dummy: Cardinal;
begin
  if Succeeded(SHGetDesktopFolder(DesktopFolder)) then
    if DesktopFolder.ParseDisplayName(0, nil, PChar(Path), dummy, Result, dummy) <> NOERROR then
      Result := nil
end;

Ich werd noch bissl rumprob'sen... bye