Verknüpfung vollstädnig auslesen

[MarcoWarm]

So... ausgeschwitzt

hier kommt nun ein Beispiel, wie man von jeder Verknüpfung einen voll qualifizierten Namen und Pfad bekommt:

Delphi-Quellcode:

uses ComObj, ActiveX, ShlObj;

const
  IID_IShellItem: TGUID = '{43826d1e-e718-42ee-bc55-a1e261c37bfe}';

type
  {$EXTERNALSYM IShellItem}
  IShellItem = interface(IUnknown)
  ['{43826d1e-e718-42ee-bc55-a1e261c37bfe}']
    function BindToHandler(pbc: IBindCtx; const rbhid: TGUID; const riid: TIID;
      out ppvOut): HResult; stdcall;
    function GetParent(out ppsi: IShellItem): HResult; stdcall;
    function GetDisplayName(sigdnName: DWord;
      out ppszName: POleStr): HResult; stdcall;
    function GetAttributes(sfgaoMask: ULong;
      out psfgaoAttribs: ULong): HResult; stdcall;
    function Compare(psi: IShellItem; hint: DWord;
      out piOrder: Integer): HResult; stdcall;
  end;

function SHBindToParent(pidl : PItemIdList; const riid : TIID; out ppv; var ppidlLast : PItemIdList) : Hresult; stdcall; external 'shell32.dll';
function SHCreateShellItem(pidlParent: PItemIDList; psfParent: IShellFolder; pidl: PItemIDList; out ppsi: IShellItem): HResult stdcall; external 'shell32.dll';

type
  TFolderNameType = (fnNormal, fnInFolder, fnForEditing, fnForAddressBar, fnForParsing);

function GetFolderName (folder : IShellFolder; pidl : PItemIDList; tp : TFolderNameType) : WideString; overload;
var
  t : DWORD;
  str : TStrRet;
begin
  case tp of
    fnInfolder      : t := SHGDN_INFOLDER;
    fnForEditing    : t := SHGDN_FOREDITING;
    fnForAddressBar : t := SHGDN_FORADDRESSBAR;
    fnForPARSING    : t := SHGDN_FORPARSING;
    else
      t := SHGDN_NORMAL;
  end;

  if Succeeded (folder.GetDisplayNameOf(pidl, t, str)) then
  case str.uType of
    STRRET_CSTR   : result := str.cStr;
    STRRET_WSTR   : begin
                      result := str.pOleStr;
                      CoTaskMemFree (str.pOleStr)
                    end;
    STRRET_OFFSET : result := PChar (pidl) + str.uOffset;
    else result := ''
  end
  else
    result := ''
end;

function ReadLnkFile(const LnkFileName: String; out Path, Arguments, WorkingDirectory, Description: String; out HotKey: Word; out ShowCmd: Integer; out IconPath: String; out IconIndex: Integer; out ItemIDList: PItemIDList): Boolean;
var
  ShellLink: IShellLink;
  PersistFile: IPersistFile;
  FileInfo: TWin32FindData;
begin
  Result:=False;
  if SUCCEEDED(CoCreateInstance(CLSID_ShellLink, nil, CLSCTX_INPROC_SERVER, IShellLink, ShellLink)) then
  begin
    PersistFile := ShellLink as IPersistFile;
    if SUCCEEDED(PersistFile.Load(StringToOleStr(LnkFileName), STGM_READ)) then
    with ShellLink do
    begin
      SetLength(Path, MAX_PATH + 1);
      if SUCCEEDED(GetPath(PChar(Path), MAX_PATH, FileInfo, SLR_ANY_MATCH)) then
      begin
        Path := PChar(Path);
        Result := True;
        SetLength(Arguments, MAX_PATH +  1);
        GetArguments(PChar(Arguments), MAX_PATH);
        Arguments := PChar(Arguments);
        SetLength(WorkingDirectory, MAX_PATH + 1);
        GetWorkingDirectory(PChar(WorkingDirectory), MAX_PATH);
        WorkingDirectory := PChar(WorkingDirectory);
        SetLength(Description, MAX_PATH + 1);
        GetDescription(PChar(Description), MAX_PATH);
        Description := PChar(Description);
        GetHotkey(HotKey);
        GetShowCmd(ShowCmd);
        SetLength(IconPath, MAX_PATH + 1);
        GetIconLocation(PChar(IconPath), MAX_PATH, IconIndex);
        IconPath := PChar(IconPath);
        if IconPath = '' then
          IconPath := Path;
        if not Succeeded(GetIDList(ItemIDList)) then
          ItemIDList:=nil;
      end
      else
        Path := '';
    end;
  end;
end;

function GetPathFromLnkFileEx(const ALnkFileName: string; out APathEx, AParsingPath : String ): Boolean;
var
  Path, Arguments, WorkingDirectory, Description: String;
  HotKey: Word;
  ShowCmd: Integer;
  IconPath: String;
  IconIndex: Integer;
  ItemIDList: PItemIDList;

  ItemIDListLast : PItemIDList;

  ShellFolder: IShellFolder;
  ShellItem,
  ShellItem2: IShellItem;

  PName : PWideChar;
begin
   Result:=False;
   ReadLnkFile(ALnkFileName, Path, Arguments, WorkingDirectory, Description, HotKey, ShowCmd, IconPath, IconIndex, ItemIDList);

  if assigned(ItemIDList) then
    if Succeeded(SHBindToParent(ItemIDList, IID_IShellFolder, ShellFolder, ItemIDListLast)) then
    begin
      Result:=True;
      AParsingPath:=GetFolderName(ShellFolder, ItemIDListLast, fnForParsing);

      if Succeeded(SHCreateShellItem(ItemIDList, ShellFolder, ItemIDListLast, ShellItem)) then
      begin
        APathEx:='';

        while Succeeded(ShellItem.GetParent(ShellItem2)) do
        begin
          if Assigned(ShellItem2) then
          begin
            ShellItem2.GetDisplayName(0, PName);
            APathEx:='\'+WideString(PName)+APathEx;
            CoTaskMemFree(PName);
            ShellItem:=ShellItem2;
          end
          else
            Break;
        end;
      end;
    end;
end;

aufgerufen wird das ganze so:

Delphi-Quellcode:

procedure TForm1.Button1Click(Sender: TObject);
var
  Path,                  //Der Pfad relativ zum Desktop (human readable)
  ParsingPath : string;  //Der Pfad, wie er im System gehalten wird .. entweder Dateipfad oder eine Liste von GUIDs.
begin
  GetPathFromLnkFileEx('C:\Users\MaWarm\Desktop\abc.lnk', Path, ParsingPath );
  Caption:=Path+' - '+ParsingPath 
end;

Ich hoffe, das hilft jemandem
Gruß
Marco