Search code examples
delphiwinapiwindows-shell

JclShell.ShellLinkResolve gets wrong data


JclShell.TShellLink.Target gives back the wrong path:

uses
  JclShell;
...
var
  ThisShellLinkRecord: JclShell.TShellLink;
  ThisTargetExePath: string;
begin
  JclShell.ShellLinkResolve('C:\ProgramData\Microsoft\Windows\Start Menu\Programs\Xara\Xara Designer Pro X9\Xara Designer Pro X9.lnk', ThisShellLinkRecord);
  ThisTargetExePath := ThisShellLinkRecord.Target;  

ThisTargetExePath from the above code results as:
C:\Program Files (x86)\Xara\Xara Designer Pro X9\DesignerPro.exe
Please note the (x86) in the resulting target path which indicates the 32-bit program files path.

HOWEVER, this is the wrong path and does not exist! When I manually open the Properties dialog of the Xara Designer Pro start menu link from the Windows Start Menu, the target path is:
C:\Program Files\Xara\Xara Designer Pro X9\DesignerPro.exe
Please note that this is the 64-bit program files path and DOES exist!

So why does ShellLinkResolve give back the wrong data here?

EDIT: I've opened the link in Notepad++: I've found only the ABSOLUTE 64-bit program files path in it (no environment variable), see here: goo.gl/jWUDb9

EDIT2:

You are right, there are different results if compiled as a 32-bit program or as a 64-bit program:

procedure TForm1.btn1Click(Sender: TObject);
var
  ThisShellLinkRecord: JclShell.TShellLink;
begin
  JclShell.ShellLinkResolve(Edit1.Text, ThisShellLinkRecord);

  {$IFDEF WIN32}
    Form1.Caption := 'This is a 32-bit program';
    Label1.Caption := ThisShellLinkRecord.Target;
  {$ELSE}
    Form1.Caption := 'This is a 64-bit program';
    Label1.Caption := JclFileUtils.PathGetLongName(ThisShellLinkRecord.Target);
  {$ENDIF}
end;

Here are the visual results:
http://goo.gl/MttrZA
http://goo.gl/hvQqP6

EDIT3: Here is the encoded link file (Xara Designer Pro X9.lnk, encoded with Soap.EncdDecd.EncodeBase64):

TAAAAAEUAgAAAAAAwAAAAAAAAEabAAAAICAAAHCmGD2HDc8Ba9NGcKwWzwFwphg9hw3PASiAxAEA AAAAAQAAAAAAAAAAAAAAAAAAANcBFAAfUOBP0CDqOmkQotgIACswMJ0ZAC9DOlwAAAAAAAAAAAAA AAAAAAAAAAAAiAAxAAAAAAA1RFVrESBQUk9HUkF+MQAAcAAIAAQA777uOoUaNURVayoAAAA8AAAA AAABAAAAAAAAAAAARgAAAAAAUAByAG8AZwByAGEAbQAgAEYAaQBsAGUAcwAAAEAAcwBoAGUAbABs ADMAMgAuAGQAbABsACwALQAyADEANwA4ADEAAAAYAEoAMQAAAAAANURVaxAgWGFyYQAANgAIAAQA 7741RFVrNURVayoAAABpfRUAAAAFAAAAAAAAAAAAAAAAAAAAWABhAHIAYQAAABQAbgAxAAAAAAA1 RFlrECBYQVJBREV+MQAAVgAIAAQA7741RFVrNURZayoAAABqfRUAAAADAAAAAAAAAAAAAAAAAAAA WABhAHIAYQAgAEQAZQBzAGkAZwBuAGUAcgAgAFAAcgBvACAAWAA5AAAAGABoADIAKIDEASlE+rAg IERFU0lHTn4xLkVYRQAATAAIAAQA774pRPqwNURZayoAAACEgRUAAAADAAAAAAAAAAAAAAAAAAAA RABlAHMAaQBnAG4AZQByAFAAcgBvAC4AZQB4AGUAAAAcAAAAcwAAABwAAAABAAAAHAAAADcAAAAA AAAAcgAAABsAAAADAAAAdG6zfBAAAABXaW43U1lTVEVNAEM6XFByb2dyYW0gRmlsZXNcWGFyYVxY YXJhIERlc2lnbmVyIFBybyBYOVxEZXNpZ25lclByby5leGUAAEwALgAuAFwALgAuAFwALgAuAFwA LgAuAFwALgAuAFwALgAuAFwALgAuAFwAUAByAG8AZwByAGEAbQAgAEYAaQBsAGUAcwBcAFgAYQBy AGEAXABYAGEAcgBhACAARABlAHMAaQBnAG4AZQByACAAUAByAG8AIABYADkAXABEAGUAcwBpAGcA bgBlAHIAUAByAG8ALgBlAHgAZQArAEMAOgBcAFAAcgBvAGcAcgBhAG0AIABGAGkAbABlAHMAXABY AGEAcgBhAFwAWABhAHIAYQAgAEQAZQBzAGkAZwBuAGUAcgAgAFAAcgBvACAAWAA5AFwAEAAAAAUA AKAmAAAAtQAAABwAAAALAACgtmNekL/BTkmynGW3MtPSGrUAAABNAAAACQAAoEEAAAAxU1BT4opY RrxMOEO7/BOTJphtziUAAAAEAAAAAB8AAAAJAAAAUwAtADEALQA1AC0AMQA4AAAAAAAAAAAAAAAA AGAAAAADAACgWAAAAAAAAABoYXVwdC1wYwAAAAAAAAAAEIn2YAe8i0eH0eCntqcHxhEBFJmGguMR s54cb2UwHBYQifZgB7yLR4fR4Ke2pwfGEQEUmYaC4xGznhxvZTAcFgAAAAA=


Solution

  • Maybe this help: direct reading of target path from lnk file via parsing of internal structures:

    type
      TdecShellLinkHeader = packed record
        HeaderSize: DWORD;
        LinkCLSID: TGUID;
        LinkFlags: DWORD;
        FileAttributes: DWORD;
        CreationTime: TFILETIME;
        AccessTime: TFILETIME;
        WriteTime: TFILETIME;
        FileSize: DWORD;
        IconIndex: Integer;
        ShowCommand: DWORD;
        HotKey: Word;
        Reserved1: Word;
        Reserved2: DWORD;
        Reserved3: DWORD;
      end;
    
    const
      LnkFileCLSID: TGUID = '{00021401-0000-0000-C000-000000000046}';
    
    function DirectReadTargetNameFromLnkFile(const AFileName: UnicodeString): UnicodeString;
    var
      Stream: TStream;
      Header: TdecShellLinkHeader;
      Size: Word;
      IDList: PItemIDList;
      Desktop: IShellFolder;
      ShellFolder: IShellFolder;
      ChildItem: PItemIDList;
      StrRet: TStrRet;
      AnsiResult: AnsiString;
      Result2: UnicodeString;
    begin
      Result := '';
      Stream := TFileStream.Create(AFileName, fmOpenRead);
      try
        Stream.ReadBuffer(Header, SizeOf(Header));
        if not (Header.HeaderSize = SizeOf(Header)) or
          not IsEqualCLSID(Header.LinkCLSID, LnkFileCLSID) then
            raise Exception.Create('Invalid Lnk file');
    
        if Header.LinkFlags and SLDF_HAS_ID_LIST <> 0 then
          begin
            Stream.ReadBuffer(Size, SizeOf(Size));
            IDList := CoTaskMemAlloc(Size);
            try
              Stream.ReadBuffer(IDList^, Size);
              OleCheck(SHGetDesktopFolder(Desktop));
              try
                OleCheck(SHBindToParent(IDList, IShellFolder, Pointer(ShellFolder), ChildItem));
                try
                  OleCheck(ShellFolder.GetDisplayNameOf(ChildItem, SHGDN_FORPARSING, StrRet));
                  case StrRet.uType of
                    STRRET_WSTR:
                      begin
                        Result := StrRet.pOleStr;
                        CoTaskMemFree(StrRet.pOleStr);
                      end;
                    STRRET_OFFSET:
                      begin
                        Inc(PByte(ChildItem), StrRet.uOffset);
                        Result := UnicodeString(PAnsiChar(ChildItem));
                      end;
                    STRRET_CSTR:
                      Result := UnicodeString(AnsiString(StrRet.cStr));
                  else Result := '';
                  end;
                  Exit;
                finally
                  ShellFolder := nil;
                end;
              finally
                Desktop := nil;
              end;
            finally
              CoTaskMemFree(IDList);
            end;
          end;
    
        if Header.LinkFlags and SLDF_HAS_LINK_INFO <> 0 then
          begin
            Stream.ReadBuffer(Size, SizeOf(Size));
            Stream.Seek(Size - SizeOf(Size), soFromCurrent);
          end;
    
        if Header.LinkFlags and SLDF_HAS_NAME <> 0 then
          begin
            Stream.ReadBuffer(Size, SizeOf(Size));
            if Header.LinkFlags and SLDF_UNICODE <> 0 then
              Stream.Seek(Size * SizeOf(WideChar), soFromCurrent)
            else
              Stream.Seek(Size * SizeOf(AnsiChar), soFromCurrent);
          end;
    
        if Header.LinkFlags and SLDF_HAS_RELPATH <> 0 then
          begin
            Stream.ReadBuffer(Size, SizeOf(Size));
            if Header.LinkFlags and SLDF_UNICODE <> 0 then
              begin
                SetLength(Result, Size);
                if Size > 0 then
                  Stream.ReadBuffer(PWideChar(Result)^, Size * SizeOf(WideChar));
              end
            else
              begin
                SetLength(AnsiResult, Size);
                if Size > 0 then
                  Stream.ReadBuffer(PAnsiChar(AnsiResult)^, Size * SizeOf(AnsiChar));
                Result := AnsiResult;
              end;
    
            if Header.LinkFlags and SLDF_HAS_EXP_SZ <> 0 then
              begin
                Size := ExpandEnvironmentStringsW(PWideChar(Result), nil, 0);
                if Size > 1 then
                  begin
                    SetLength(Result2, Size - 1);
                    ExpandEnvironmentStringsW(PWideChar(Result), PWideChar(Result2), Size);
                    Result := Result2;
                  end;
              end;
    
            Result2 := ExtractFileDir(AFileName);
            while Pos('..\', Result) = 1 do
              begin
                Result2 := ExtractFileDir(Result2);
                Delete(Result, 1, 3);
              end;
            Result := Result2 + '\' + Result;
          end;
      finally
        Stream.Free;
      end;
    end;
    

    USE ON YOUR OWN RISK!