Just to verify, you say that something like the following does not correctly get the link information?

Regards,
Russell

------------------

type
  TLinkParams    =  packed record
     Target:     String;
     Description:String;
     Parameters: String;
     WorkDir:    String;
  end;

function ResolveLink(LinkFile: String; var LinkParams: TLinkParams): HResult;
var  psl:        IShellLink;
     ppf:        IPersistFile;
     wfd:        WIN32_FIND_DATA;
     wszFile:    Array [0..MAX_PATH] of WideChar;
     szArgs:     Array [0..MAX_PATH] of Char;
     szPath:     Array [0..MAX_PATH] of Char;
     szDesc:     Array [0..MAX_PATH] of Char;
begin

  // Get a pointer to the IShellLink interface.
  result:=CoCreateInstance(CLSID_ShellLink, nil, CLSCTX_INPROC_SERVER, IShellLink, psl);
  if (result = S_OK) then
  begin
     // Get a pointer to the IPersistFile interface.
     result:=psl.QueryInterface(IPersistFile, ppf);
     if (result = S_OK) then
     begin
        // Ensure that the string is Unicode.
        MultiByteToWideChar(CP_ACP, 0, PChar(LinkFile), -1, @wszFile, MAX_PATH);
        // Load the shortcut.
        result:=ppf.Load(@wszFile, STGM_READ);
        if (result = S_OK) then
        begin
           // Resolve the link.
           result:=psl.Resolve(Application.Handle, 0);
           if (result = S_OK) then
           begin
              // Get the path to the link target.
              result:=psl.GetPath(szPath, MAX_PATH, wfd, SLGP_SHORTPATH);
              if (result = S_OK) then
              begin
                 LinkParams.Target:=szPath;
                 // Get the description of the target.
                 result:=psl.GetDescription(szDesc, MAX_PATH);
                 if (result = S_OK) then
                 begin
                    LinkParams.Description:=szDesc;
                    // Get the arguments
                    result:=psl.GetArguments(szArgs, MAX_PATH);
                    if (result = S_OK) then
                    begin
                       LinkParams.Parameters:=szArgs;
                       // Get the working directory
                       result:=psl.GetWorkingDirectory(szPath, MAX_PATH);
                       if (result = S_OK) then LinkParams.WorkDir:=szPath;
                    end;
                 end;
              end;
           end;
        end;
        // Release the pointer to the IPersistFile interface.
        ppf:=nil;
     end;
     // Release the pointer to the IShellLink interface.
     psl:=nil;
  end;

end;


var  lpParams:   TLinkParams;
begin

  if ResolveLink('c:\path\YourLinkFile.lnk', lpParams) = S_OK then
  begin
     ShowMessage(lpParams.Target);
  end;

end;

Correct. This code will gives you
---------------------------
C:\WINDOWS\Installer\{90110409-6000-11D3-8CFE-0150048383C9}\wordicon.exe
---------------------------
for the Windows Installer shortcut to Word 2003, for instance. Normally they point to an ico file or something else silly like that.

rllibby, this was a great asnwer that solved the problem perfectly. Thank you!

Skip

My pleasure, and thank you.

Russell

rllibby,
I have one more problem, and I don't mind opeing up another point question if you think you can solve it. My old way, and your new way, of getting shortcut information do not work with shortcuts made from the Control Panel tools or shortcuts made from My Computer, My Network Places, and Internet Explorer. Any ideas about those shortcuts? Again, I will award points via another question if you (or anyone else of course) can handle this.

Skip

I can handle it no problem,  BUT....

These shortcuts are actually based on a pidl (pointer to an id list). While I can convert/dig out the info for you, you are still not going to get back an actual "path", as these shortcuts are not based on an FSO (file system object). They are based on a shell namespace item.

Let me know what your after, and I'll try and help you out.

Russell



 

I am using these functions to drag items (files, folders, URLs, shortcuts, etc.) into a menu system. When they are dragged to the form, I gather the target and any parameters and save them to a listview item so that when the user selects that item, my program runs them with CreateProcess. I have always used CreateProcess to run commands like 'C:\Windows\MyProgram.exe'. If CreateParams can run a pidl address that I can save textually to a listview subitem, then this would be very useful to me. Otherwise, I guess I would not need to know how to extract the pidl info.

Skip

Skip,
I am including all source for the following:

1.) PItemIDList handling routines.
2.) Updated function to get the pidl, and if the description is not set, to use the "name" of the pidl for Description field.
3.) Routine to execute/launch a pidl, which can also take an address to a dword (@Variable) if you need the process handle. Please note that neither CreateProcess, WinExec, or ShellExecute can handle pidl launching, thus the use of ShellExecuteEx.

Please be sure to include the ShellAPI in the uses clause of the unit you have this code in.

Russell

--------------

procedure DisposePIDL(ID: PItemIDList);
var  Malloc:     IMalloc;
begin
  if Assigned(ID) then
  begin
     OLECheck(SHGetMalloc(Malloc));
     Malloc.Free(ID);
     Malloc:=nil;
  end;
end;

function CopyITEMID(Malloc: IMalloc; ID: PItemIDList): PItemIDList;
begin

  result:=Malloc.Alloc(ID^.mkid.cb + SizeOf(ID^.mkid.cb));
  CopyMemory(Result, ID, ID^.mkid.cb+SizeOf(ID^.mkid.cb));

end;

function NextPIDL(IDList: PItemIDList): PItemIDList;
begin

  result:=IDList;
  Inc(PChar(Result), IDList^.mkid.cb);

end;

function GetPIDLSize(IDList: PItemIDList): Integer;
begin

  if Assigned(IDList) then
  begin
     result:=SizeOf(IDList^.mkid.cb);
     while (IDList^.mkid.cb <> 0) do
     begin
        Inc(result, IDList^.mkid.cb);
        IDList:=NextPIDL(IDList);
     end;
  end
  else
     result:=0;

end;

procedure StripLastID(IDList: PItemIDList);
var  MarkerID:   PItemIDList;
begin

  MarkerID:=IDList;
  if Assigned(IDList) then
  begin
     while (IDList.mkid.cb <> 0) do
     begin
        MarkerID:=IDList;
        IDList:=NextPIDL(IDList);
     end;
     MarkerID.mkid.cb:=0;
  end;

end;

function CreatePIDL(Size: Integer): PItemIDList;
var  Malloc:     IMalloc;
begin

  if (SHGetMalloc(Malloc) <> S_OK) then
    result:=nil
  else
  begin
     try
        result:=Malloc.Alloc(Size);
        if Assigned(Result) then FillChar(Result^, Size, 0);
     finally
        Malloc:=nil;
     end;
  end;

end;

function CopyPIDL(IDList: PItemIDList): PItemIDList;
var  Size:       Integer;
begin

  Size:=GetPIDLSize(IDList);
  result:=CreatePIDL(Size);
  if Assigned(result) then CopyMemory(result, IDList, Size);

end;

function ConcatPIDLs(IDList1, IDList2: PItemIDList): PItemIDList;
var  cb1, cb2:   Integer;
begin

  if Assigned(IDList1) then
    cb1:=GetPIDLSize(IDList1)-SizeOf(IDList1^.mkid.cb)
  else
    cb1:=0;
  cb2:=GetPIDLSize(IDList2);
  result:=CreatePIDL(cb1 + cb2);
  if Assigned(result) then
  begin
     if Assigned(IDList1) then CopyMemory(result, IDList1, cb1);
     CopyMemory(PChar(result)+cb1, IDList2, cb2);
  end;

end;

function ExecutePidl(IDList: PItemIDList; pdwProcess: PDWORD): Boolean;
var  lpExecInfo:    TShellExecuteInfo;
begin

  // Check process handle buffer
  if Assigned(pdwProcess) then pdwProcess^:=0;

  // Clear buffer
  ZeroMemory(@lpExecInfo, SizeOf(lpExecInfo));

  // Set parameters
  lpExecInfo.cbSize:=SizeOf(lpExecInfo);
  lpExecInfo.fMask:=SEE_MASK_FLAG_NO_UI or SEE_MASK_IDLIST;
  if Assigned(pdwProcess) then lpExecInfo.fMask:=lpExecInfo.fMask or SEE_MASK_NOCLOSEPROCESS;
  lpExecInfo.Wnd:=GetDesktopWindow;
  lpExecInfo.nShow:=SW_SHOWNORMAL;
  lpExecInfo.lpIDList:=IDList;

  // Attempt the start
  result:=ShellExecuteEx(@lpExecInfo);

  // Return the process handle if successful and buffer was passed
  if result and Assigned(pdwProcess) then pdwProcess^:=lpExecInfo.hProcess;

end;

function MsiLocateComponentA(szComponent: PChar; lpPathBuf: PChar; pcchBuf: PDWORD): Integer; stdcall; external 'msi.dll';
function MsiGetShortcutTargetA(szShortcutTarget, szProductCode, szFeatureID, szComponentCode: PChar): Integer; stdcall; external 'msi.dll';

type
  TLinkParams    =  packed record
     Target:     String;
     pdlTarget:  PItemIDList;
     Description:String;
     Parameters: String;
     WorkDir:    String;
  end;

function ResolveLink(LinkFile: String; var LinkParams: TLinkParams): HResult;
var  psl:        IShellLink;
     ppf:        IPersistFile;
     ppshf:      IShellFolder;
     psldl:      IShellLinkDataList;
     pdl:        PItemIDList;
     lpData:     Pointer;
     str:        TStrRet;
     dwSize:     DWORD;
     szDID:      String;
     wfd:        WIN32_FIND_DATA;
     wszFile:    Array [0..MAX_PATH] of WideChar;
     szArgs:     Array [0..MAX_PATH] of Char;
     szPath:     Array [0..MAX_PATH] of Char;
     szDesc:     Array [0..MAX_PATH] of Char;
begin

  // Clear out buffer
  with LinkParams do
  begin
     Target:='';
     pdlTarget:=nil;
     Description:='';
     Parameters:='';
     WorkDir:='';
  end;

  // Get a pointer to the IShellLink interface.
  result:=CoCreateInstance(CLSID_ShellLink, nil, CLSCTX_INPROC_SERVER, IShellLink, psl);
  if (result = S_OK) then
  begin
     // Get a pointer to the IPersistFile interface.
     result:=psl.QueryInterface(IPersistFile, ppf);
     if (result = S_OK) then
     begin
        // Ensure that the string is Unicode.
        MultiByteToWideChar(CP_ACP, 0, PChar(LinkFile), -1, @wszFile, MAX_PATH);
        // Load the shortcut.
        result:=ppf.Load(@wszFile, STGM_READ);
        if (result = S_OK) then
        begin
           // Resolve the link.
           result:=psl.Resolve(Application.Handle, SLR_UPDATE);
           if (result = S_OK) then
           begin
              // Get the path to the link target.
              result:=psl.GetPath(@szPath, MAX_PATH, wfd, SLGP_UNCPRIORITY); // SLGP_SHORTPATH);
              // Check result, may need to get the pidl
              if (result <> S_OK) then
              begin
                 // Attempt the pidl get
                 result:=psl.GetIDList(pdl);
                 if (result = S_OK) then
                 begin
                    // Make a copy of this
                    LinkParams.pdlTarget:=CopyPidl(pdl);
                    DisposePIDL(pdl);
                    ZeroMemory(@szPath, SizeOf(szPath));
                 end;
              end;
              if (result = S_OK) then
              begin
                 LinkParams.Target:=szPath;
                 // Check IShellLinkDataList
                 if (psl.QueryInterface(IShellLinkDataList, psldl) = S_OK) then
                 begin
                    if (MsiGetShortcutTargetA(PChar(LinkFile), nil, nil, @szDesc) = 0) then
                    begin
                       MsiLocateComponentA(@szDesc, @szPath, @dwSize);
                       LinkParams.Target:=szPath;
                    end;
                 end;
                 // Get the description of the target.
                 result:=psl.GetDescription(@szDesc, MAX_PATH);
                 // Check description
                 if (result = S_OK) then
                 begin
                    // Check for null description
                    if (szDesc[0] = #0) and Assigned(LinkParams.pdlTarget) then
                    begin
                       ShGetDesktopFolder(ppshf);
                       if (ppshf.GetDisplayNameOf(LinkParams.pdlTarget, SHGDN_NORMAL, str) = S_OK) then
                       begin
                          case str.uType of
                             STRRET_CSTR    :
                                SetString(LinkParams.Description, str.cStr, lstrlen(str.cStr));
                             STRRET_OFFSET  :
                             begin
                                lpData:=@LinkParams.pdlTarget.mkid.abID[str.uOffset-SizeOf(LinkParams.pdlTarget.mkid.cb)];
                                SetString(LinkParams.Description, PChar(lpData), LinkParams.pdlTarget.mkid.cb-str.uOffset);
                             end;
                             STRRET_WSTR    :
                             begin
                                LinkParams.Description:=str.pOleStr;
                                SysFreeString(str.pOleStr);
                             end;
                          end;
                       end;
                       // Release the desktop folder
                       ppshf:=nil;
                    end
                    else
                       // Description
                       LinkParams.Description:=szDesc;
                    // Get the arguments
                    result:=psl.GetArguments(@szArgs, MAX_PATH);
                    if (result = S_OK) then
                    begin
                       LinkParams.Parameters:=szArgs;
                       // Get the working directory
                       result:=psl.GetWorkingDirectory(@szPath, MAX_PATH);
                       if (result = S_OK) then LinkParams.WorkDir:=szPath;
                    end;
                 end;
              end;
           end;
        end;
        // Release the pointer to the IPersistFile interface.
        ppf:=nil;
     end;
     // Release the pointer to the IShellLink interface.
     psl:=nil;
  end;

end;

-------------
example
-------------

var  lpParams:   TLinkParams;
begin

  if ResolveLink('C:\Documents and Settings\rllibby\Desktop\test.lnk', lpParams) = S_OK then
  begin
     if Assigned(lpParams.pdlTarget) then
        ExecutePidl(lpParams.pdlTarget, nil)
     else
        ShowMessage(lpParams.Target);
  end;

end;

This is how my unit now looks. Below that is code I am using.

With this new pidl code I am now getting an error (a CPU window pops up). When I close that and press Run to continue, it can't interpret the link.

unit ShellObjEx;

interface

uses
  Windows, Forms, ShellAPI, ShlObj, ComObj, ActiveX;

const
  EXP_DARWIN_ID_SIG       = $A0000006;   // The link's Microsoft© Windows© Installer identifier (ID).
  EXP_LOGO3_ID_SIG        = $A0000007;
  EXP_SPECIAL_FOLDER_SIG  = $A0000005;   // Special folder information.
  EXP_SZLINK_SIG          = $A0000001;   // The target name.
  EXP_SZICON_SIG          = $A0000007;   // The icon name.
  NT_CONSOLE_PROPS_SIG    = $A0000002;   // Console properties.
  NT_FE_CONSOLE_PROPS_SIG = $A0000004;   // The console's code page.

type
  LPDATABLOCK_HEADER      =  ^DATABLOCK_HEADER;
  DATABLOCK_HEADER        = packed record
    cbSize,
    dwSignature:          DWORD;
  end;

  LPEXP_DARWIN_LINK       =  ^EXP_DARWIN_LINK;
  EXP_DARWIN_LINK         =  packed record
    dbh:                  DATABLOCK_HEADER;
    szDarwinID:           Array [0..MAX_PATH-1] of char;
    szwDarwinID:          Array [0..MAX_PATH-1] of word;
  end;

  LPEXP_SPECIAL_FOLDER    =  ^EXP_SPECIAL_FOLDER;
  EXP_SPECIAL_FOLDER      =  packed record
    dbh:                  DATABLOCK_HEADER;
    idSpecialFolder,
    cbOffset:             DWORD;
  end;

  LP_EXP_SZ_LINK          =  ^EXP_SZ_LINK;
  EXP_SZ_LINK             =  packed record
    dbh:                  DATABLOCK_HEADER;
    szTarget:             Array [0..MAX_PATH-1] of char;
    szwTarget:            Array [0..MAX_PATH-1] of word;
  end;

  NT_CONSOLE_PROPS        =  packed record
    dbh:                  DATABLOCK_HEADER;
    wFillAttribute:       WORD;
    wPopupFillAttribute:  WORD;
    dwScreenBufferSize:   COORD;
    dwWindowSize:         COORD;
    dwWindowOrigin:       COORD;
    nFont:                DWORD;
    nInputBufferSize:     DWORD;
    dwFontSize:           COORD;
    uFontFamily:          UINT;
    uFontWeight:          UINT;
    FaceName:             Array [0..LF_FACESIZE-1] of word;
    uCursorSize:          UINT;
    bFullScreen:          BOOL;
    bQuickEdit:           BOOL;
    bInsertMode:          BOOL;
    bAutoPosition:        BOOL;
    uHistoryBufferSize:      UINT;
    uNumberOfHistoryBuffers: UINT;
    bHistoryNoDup:        BOOL;
    ColorTable:           Array [0..16-1] of COLORREF;
  end;

  NT_FE_CONSOLE_PROPS     =  packed record
    dbh:                  DATABLOCK_HEADER;
    uCodePage:            UINT;
  end;

const
  SLDF_HAS_ID_LIST        = $00000001;   // Shell link saved with ID list
  SLDF_HAS_LINK_INFO      = $00000002;   // Shell link saved with LinkInfo
  SLDF_HAS_NAME           = $00000004;
  SLDF_HAS_RELPATH        = $00000008;
  SLDF_HAS_WORKINGDIR     = $00000010;
  SLDF_HAS_ARGS           = $00000020;
  SLDF_HAS_ICONLOCATION   = $00000040;
  SLDF_UNICODE            = $00000080;   // the strings are unicode
  SLDF_FORCE_NO_LINKINFO  = $00000100;   // don't create a LINKINFO (make a dumb link)
  SLDF_HAS_EXP_SZ         = $00000200;   // the link contains expandable env strings
  SLDF_RUN_IN_SEPARATE    = $00000400;   // Run the 16-bit target exe in a separate VDM/WOW
  SLDF_HAS_LOGO3ID        = $00000800;   // this link is a special Logo3/MSICD link
  SLDF_HAS_DARWINID       = $00001000;   // this link is a special Darwin link
  SLDF_RUNAS_USER         = $00002000;   // Run this link as a different user
  SLDF_HAS_EXP_ICON_SZ    = $00004000;   // contains expandable env string for icon path
  SLDF_NO_PIDL_ALIAS      = $00008000;   // don't ever resolve to a logical location
  SLDF_FORCE_UNCNAME      = $00010000;   // make GetPath() prefer the UNC name to the local name
  SLDF_RUN_WITH_SHIMLAYER = $00020000;   // Launch the target of this link w/ shim layer active
  SLDF_RESERVED           = $80000000;

type
  IShellLinkDataList   =  interface(IUnknown)
     ['{45E2B4AE-B1C3-11D0-B92F-00A0C90312E1}']
     function AddDataBlock(pDataBlock: Pointer): HResult; stdcall;
     function CopyDataBlock(dwSig: DWORD; var ppDataBlock: Pointer): HResult; stdcall;
     function RemoveDataBlock(dwSig: DWORD): HResult; stdcall;
     function GetFlags(pdwFlags: PDWORD): HResult; stdcall;
     function SetFlags(dwFlags: DWORD): HResult; stdcall;
  end;

type
  TLinkParams = packed record
     Target:     String;
     pdlTarget:  PItemIDList;
     Description:String;
     Parameters: String;
     WorkDir:    String;
  end;

function ResolveLink(LinkFile: String; var LinkParams: TLinkParams): HResult;
function ExecutePidl(IDList: PItemIDList; pdwProcess: PDWORD): Boolean;

implementation

function MsiLocateComponentA(szComponent: PChar; lpPathBuf: PChar; pcchBuf: PDWORD): Integer; stdcall; external 'msi.dll';
function MsiGetShortcutTargetA(szShortcutTarget, szProductCode, szFeatureID, szComponentCode: PChar): Integer; stdcall; external 'msi.dll';

procedure DisposePIDL(ID: PItemIDList);
var  Malloc:     IMalloc;
begin
  if Assigned(ID) then
  begin
     OLECheck(SHGetMalloc(Malloc));
     Malloc.Free(ID);
     Malloc:=nil;
  end;
end;

function CopyITEMID(Malloc: IMalloc; ID: PItemIDList): PItemIDList;
begin

  result:=Malloc.Alloc(ID^.mkid.cb + SizeOf(ID^.mkid.cb));
  CopyMemory(Result, ID, ID^.mkid.cb+SizeOf(ID^.mkid.cb));

end;

function NextPIDL(IDList: PItemIDList): PItemIDList;
begin

  result:=IDList;
  Inc(PChar(Result), IDList^.mkid.cb);

end;

function GetPIDLSize(IDList: PItemIDList): Integer;
begin

  if Assigned(IDList) then
  begin
     result:=SizeOf(IDList^.mkid.cb);
     while (IDList^.mkid.cb <> 0) do
     begin
        Inc(result, IDList^.mkid.cb);
        IDList:=NextPIDL(IDList);
     end;
  end
  else
     result:=0;

end;

procedure StripLastID(IDList: PItemIDList);
var  MarkerID:   PItemIDList;
begin

  MarkerID:=IDList;
  if Assigned(IDList) then
  begin
     while (IDList.mkid.cb <> 0) do
     begin
        MarkerID:=IDList;
        IDList:=NextPIDL(IDList);
     end;
     MarkerID.mkid.cb:=0;
  end;

end;

function CreatePIDL(Size: Integer): PItemIDList;
var  Malloc:     IMalloc;
begin

  if (SHGetMalloc(Malloc) <> S_OK) then
    result:=nil
  else
  begin
     try
        result:=Malloc.Alloc(Size);
        if Assigned(Result) then FillChar(Result^, Size, 0);
     finally
        Malloc:=nil;
     end;
  end;

end;

function CopyPIDL(IDList: PItemIDList): PItemIDList;
var  Size:       Integer;
begin

  Size:=GetPIDLSize(IDList);
  result:=CreatePIDL(Size);
  if Assigned(result) then CopyMemory(result, IDList, Size);

end;

function ConcatPIDLs(IDList1, IDList2: PItemIDList): PItemIDList;
var  cb1, cb2:   Integer;
begin

  if Assigned(IDList1) then
    cb1:=GetPIDLSize(IDList1)-SizeOf(IDList1^.mkid.cb)
  else
    cb1:=0;
  cb2:=GetPIDLSize(IDList2);
  result:=CreatePIDL(cb1 + cb2);
  if Assigned(result) then
  begin
     if Assigned(IDList1) then CopyMemory(result, IDList1, cb1);
     CopyMemory(PChar(result)+cb1, IDList2, cb2);
  end;

end;

function ExecutePidl(IDList: PItemIDList; pdwProcess: PDWORD): Boolean;
var  lpExecInfo:    TShellExecuteInfo;
begin

  // Check process handle buffer
  if Assigned(pdwProcess) then pdwProcess^:=0;

  // Clear buffer
  ZeroMemory(@lpExecInfo, SizeOf(lpExecInfo));

  // Set parameters
  lpExecInfo.cbSize:=SizeOf(lpExecInfo);
  lpExecInfo.fMask:=SEE_MASK_FLAG_NO_UI or SEE_MASK_IDLIST;
  if Assigned(pdwProcess) then lpExecInfo.fMask:=lpExecInfo.fMask or SEE_MASK_NOCLOSEPROCESS;
  lpExecInfo.Wnd:=GetDesktopWindow;
  lpExecInfo.nShow:=SW_SHOWNORMAL;
  lpExecInfo.lpIDList:=IDList;

  // Attempt the start
  result:=ShellExecuteEx(@lpExecInfo);

  // Return the process handle if successful and buffer was passed
  if result and Assigned(pdwProcess) then pdwProcess^:=lpExecInfo.hProcess;

end;

function ResolveLink(LinkFile: String; var LinkParams: TLinkParams): HResult;
var  psl:        IShellLink;
     ppf:        IPersistFile;
     ppshf:      IShellFolder;
     psldl:      IShellLinkDataList;
     pdl:        PItemIDList;
     lpData:     Pointer;
     str:        TStrRet;
     dwSize:     DWORD;
     //szDID:      String;
     wfd:        WIN32_FIND_DATA;
     wszFile:    Array [0..MAX_PATH] of WideChar;
     szArgs:     Array [0..MAX_PATH] of Char;
     szPath:     Array [0..MAX_PATH] of Char;
     szDesc:     Array [0..MAX_PATH] of Char;
begin

  // Clear out buffer
  with LinkParams do
  begin
     Target:='';
     pdlTarget:=nil;
     Description:='';
     Parameters:='';
     WorkDir:='';
  end;

  // Get a pointer to the IShellLink interface.
  result:=CoCreateInstance(CLSID_ShellLink, nil, CLSCTX_INPROC_SERVER, IShellLink, psl);
  if (result = S_OK) then
  begin
     // Get a pointer to the IPersistFile interface.
     result:=psl.QueryInterface(IPersistFile, ppf);
     if (result = S_OK) then
     begin
        // Ensure that the string is Unicode.
        MultiByteToWideChar(CP_ACP, 0, PChar(LinkFile), -1, @wszFile, MAX_PATH);
        // Load the shortcut.
        result:=ppf.Load(@wszFile, STGM_READ);
        if (result = S_OK) then
        begin
           // Resolve the link.
           result:=psl.Resolve(Application.Handle, SLR_UPDATE);
           if (result = S_OK) then
           begin
              // Get the path to the link target.
              result:=psl.GetPath(@szPath, MAX_PATH, wfd, SLGP_UNCPRIORITY); // SLGP_SHORTPATH);
              // Check result, may need to get the pidl
              if (result <> S_OK) then
              begin
                 // Attempt the pidl get
                 result:=psl.GetIDList(pdl);
                 if (result = S_OK) then
                 begin
                    // Make a copy of this
                    LinkParams.pdlTarget:=CopyPidl(pdl);
                    DisposePIDL(pdl);
                    ZeroMemory(@szPath, SizeOf(szPath));
                 end;
              end;
              if (result = S_OK) then
              begin
                 LinkParams.Target:=szPath;
                 // Check IShellLinkDataList
                 if (psl.QueryInterface(IShellLinkDataList, psldl) = S_OK) then
                 begin
                    if (MsiGetShortcutTargetA(PChar(LinkFile), nil, nil, @szDesc) = 0) then
                    begin
                       MsiLocateComponentA(@szDesc, @szPath, @dwSize);
                       LinkParams.Target:=szPath;
                    end;
                 end;
                 // Get the description of the target.
                 result:=psl.GetDescription(@szDesc, MAX_PATH);
                 // Check description
                 if (result = S_OK) then
                 begin
                    // Check for null description
                    if (szDesc[0] = #0) and Assigned(LinkParams.pdlTarget) then
                    begin
                       ShGetDesktopFolder(ppshf);
                       if (ppshf.GetDisplayNameOf(LinkParams.pdlTarget, SHGDN_NORMAL, str) = S_OK) then
                       begin
                          case str.uType of
                             STRRET_CSTR    :
                                SetString(LinkParams.Description, str.cStr, lstrlen(str.cStr));
                             STRRET_OFFSET  :
                             begin
                                lpData:=@LinkParams.pdlTarget.mkid.abID[str.uOffset-SizeOf(LinkParams.pdlTarget.mkid.cb)];
                                SetString(LinkParams.Description, PChar(lpData), LinkParams.pdlTarget.mkid.cb-str.uOffset);
                             end;
                             STRRET_WSTR    :
                             begin
                                LinkParams.Description:=str.pOleStr;
                                SysFreeString(str.pOleStr);
                             end;
                          end;
                       end;
                       // Release the desktop folder
                       ppshf:=nil;
                    end
                    else
                       // Description
                       LinkParams.Description:=szDesc;
                    // Get the arguments
                    result:=psl.GetArguments(@szArgs, MAX_PATH);
                    if (result = S_OK) then
                    begin
                       LinkParams.Parameters:=szArgs;
                       // Get the working directory
                       result:=psl.GetWorkingDirectory(@szPath, MAX_PATH);
                       if (result = S_OK) then LinkParams.WorkDir:=szPath;
                    end;
                 end;
              end;
           end;
        end;
        // Release the pointer to the IPersistFile interface.
        ppf:=nil;
     end;
     // Release the pointer to the IShellLink interface.
     psl:=nil;
  end;
end;

end.


////////////////////////////////////////

My code to call it:

function TMainfrm.Translate(const f: string): boolean;
var
  msi: TLinkParams;
begin
  Result := false;
  if ResolveLink(f, msi) = S_OK then begin
    if msi.Target = '' then
      Result := f
    else
      Result := msi.Target+SW+msi.Parameters;
...

Any ideas?

Skip

What line is the CPU window popping up on? (have you single stepped though the code??). There is debug code (INT 3 calls) in the OLE units, and it is common to see this happen for SysFreeString. As a quick check, you can comment out the following

   SysFreeString(str.pOleStr);

---------

Russell

You are right. That is the line. I guess I can live with that line commented out, no? But the big problem is that it as changed nothing. I still can't interpret the My Computer, etc., shortcuts.

It gets a pdlTarget, like $171CA8, and it gets the Description (which is the same as the file name), but it doesn't get the Target which is the all important piece of information I need. It does get the pdlTarget, and it can execute it (Executepdl(pdl.Target, 0)) but what I need is to be able to save the pdlTarget to a string that I can retrieve later to run. I'd rather have the Target, but I guess there isn't one for these PIDLs.

Is there a way to save this pdlTarget, like $171CA8, to some type of string that I can retrieve later and then call/execute? And does this number remain stable or is only appropriate at the time is was received?

If the above can be done, what do I do about the SysFreeString line, just leave it commented out?

1.) Its ok to leave that line commented; in truth, I believe the compiler actually frees the olestr in the struct on the exit of the procedure.

2.) You are missing the point. The pidl ** IS ** the target. This is not a file system object, so there is no path. Its part of the shell namespace, and as such, the pidl is the only thing you get.

3.) You can't save the pidl to a string (i guess you could if it was converted to a string of hex characters), but you could stream it out, and be able to stream it back in. The pidl address can change on you, but the contents of the pidl (which is what you would stream out/in) would remain constant.

If you need help streaming pidls, then I will provide the code. Hopefully that will finish this question off, as it is starting to go way outside the scope of the original question

Russell

procedure SavePidlToStream(Stream: TStream; IDList: PItemIDList);
var  lpszBuffer: Array [0..255] of Char;
     dwSize:     DWORD;
begin

  // Save 3 byte marker for PDL header (used for identification)
  StrCopy(@lpszBuffer, 'PDL');
  Stream.Write(lpszBuffer, 3);

  // Calculate the total pidl size
  dwSize:=GetPIDLSize(IDList);
  Stream.Write(dwSize, SizeOf(DWORD));

  // Write the pidl to the stream
  if (dwSize > 0) and Assigned(IDList) then Stream.Write(IDList^, dwSize);

end;

function LoadPidlFromStream(Stream: TStream): PItemIDList;
var  lpszBuffer: Array [0..255] of Char;
     dwSize:     DWORD;
begin

  // Set default result
  result:=nil;

  // Read 3 bytes and check for marker (PDL) header
  if (Stream.Read(lpszBuffer, 3) = 3) then
  begin
     // Verify the header
     if (StrLComp(lpszBuffer, 'PDL', 3) = 0) then
     begin
        // Read in the pidl size
        if (Stream.Read(dwSize, SizeOf(DWORD)) = SizeOf(DWORD)) then
        begin
           // Is size non zero?
           if (dwSize > 0) then
           begin
              // Create a new pidl and read in from stream
              result:=CreatePidl(dwSize);
              Stream.Read(result^, dwSize);
           end;
        end;
     end;
  end;

end;

--------------

Russell

Ok, I have it all working. I am getting the target, or rather the PIDL blob, and putting it in a stream. Then I can get it from a stream later and then execute it, all because of your code. But I need a way for the stream to servive between sessions. I used a TMemoryStream so I could save and load it from a file, but that is not a great answer seeing that a lot of users will be using this program and will have their own menu data files. So the last thing I need, and you mentioned this, is I need to convert this stream to a string that I can save it in the user's ini file (menu data file). Then when they run the program, this pidl will be in their menu from the ini file just like the other items. I would need two functions that I can't find to be done with this: a PIDLToStr or StreamToStr and then a StrToPIDL or StrToHex.

Even if you can't provide these last two items for me, I want to award 500 more points to you for all of this fine stuff and your fine work. If you can, it would "complete" my problem and I would award 1000 more points to you.

Now, how do you suggest I do my part? Open this question as a point question that you will then grab and answer and I will accept? Or is there another way seeing that we have done all that already?

Skip

Skip,
I will finish the rest of the code for you, so you can convert the stream to a string, then back again. (glad to hear its working).
When done, and only if you want to, you can post another q with points addressed to me, referencing this question (place the link in the new q).

Regards,
Russell

I do and I will. Thanks.

Skip,
Here is the code for both saving a stream to hex string, and loading a hex stream into a string. This will allow you to save this binary data (pidl stream) into a pure text format. Let me know if you have any issues.

Russell

---------------

const
  HEX_CHARS:     Array [0..15] of Char   =  ('0', '1', '2', '3', '4', '5', '6', '7',
                                             '8', '9', 'A', 'B', 'C', 'D', 'E', 'F');

function StreamSaveToStr(Stream: TStream): String;
var  pbaData:    PByteArray;
     dwPos:      Integer;
     dwHold:     Integer;
     dwIndex:    Integer;
     dwSize:     Integer;
begin

  // Save stream position
  dwHold:=Stream.Position;

  // Resource protection
  try
     Stream.Position:=0;
     // Get the stream size
     dwSize:=Stream.Size;
     // Check for empty stream
     if (dwSize > 0) then
     begin
        // Allocate the memory required to read the stream data
        pbaData:=AllocMem(dwSize);
        try
           // Read from the stream
           Stream.Read(pbaData^, dwSize);
           // Allocate memory for result string
           SetLength(result, dwSize * 2);
           // Convert the binary data to hex string
           dwPos:=0;
           for dwIndex:=0 to Pred(dwSize) do
           begin
              // Get the high bit
              Inc(dwPos);
              result[dwPos]:=HEX_CHARS[pbaData^[dwIndex] div 16];
              // Get the lo bit
              Inc(dwPos);
              result[dwPos]:=HEX_CHARS[pbaData^[dwIndex] mod 16];
           end;
        finally
           // Free the byte array
           FreeMem(pbaData);
        end;
     end
     else
        // Return empty string
        result:='';
  finally
     // Reset the stream position
     Stream.Position:=dwHold;
  end;

end;

procedure StreamLoadFromStr(Stream: TStream; Str: String);
var  pbaData:    PByteArray;
     dwPos:      Integer;
     dwValue:    Integer;
     dwError:    Integer;
     dwBytes:    Integer;
     dwIndex:    Integer;
     dwSize:     Integer;
begin

  // Clear the stream first
  Stream.Position:=0;
  Stream.Size:=0;

  // Check the string
  dwSize:=Length(Str);

  // Make sure its even length
  if Odd(dwSize) then Dec(dwSize);

  // Check length
  if (dwSize > 0) then
  begin
     // Allocate memory for the byte stream
     dwBytes:=dwSize div 2;
     pbaData:=AllocMem(dwBytes);
     // Resource protection
     try
        // Convert hex string to binary stream
        dwPos:=1;
        for dwIndex:=0 to Pred(dwBytes) do
        begin
           // Convert the data to integer
           Val('$'+Str[dwPos]+Str[Succ(dwPos)], dwValue, dwError);
           // Check the conversion
           if (dwError <> 0) then
              // Raise conversion exception
              EConvertError.Create('Invalid hex data in the string!')
           else
              // Set the data
              pbaData^[dwIndex]:=dwValue;
           // Push to the next 2 byte set
           Inc(dwPos, 2);
        end;
        // Byte stream is assembled, now write it to the stream
        Stream.Write(pbaData^, dwBytes);
     finally
        // Free the memory
        FreeMem(pbaData);
        // Set the stream starting position
        Stream.Position:=0;
     end;
  end;

end;

----

Simple Example:
----------------------

var  lpParams:   TLinkParams;
     strm:       TFileStream;
     strmMem:    TMemoryStream;
     pdl:        PItemIDList;
     szStr:      String;
begin

  if ResolveLink('C:\Documents and Settings\rllibby\Desktop\test.lnk', lpParams) = S_OK then
  begin
     if Assigned(lpParams.pdlTarget) then
     begin
        // Create file stream
        strm:=TFileStream.Create('c:\test.txt', fmCreate);
        // Save pidl to the stream
        SavePidlToStream(strm, lpParams.pdlTarget);
        // Convert the stream to a string
        szStr:=StreamSaveToStr(strm);
        // Free file stream
        strm.Free;
        // Show the hex string
        ShowMessage(szStr);
        // Create memory stream
        strmMem:=TMemoryStream.Create;
        // Load the stream using the hex data
        StreamLoadFromStr(strmMem, szStr);
        // Load the pidl from the stream
        pdl:=LoadPidlFromStream(strmMem);
        // Free the memory stream
        strmMem.Free;

        // Execute the pidl
        ExecutePidl(pdl, nil);

        // Make sure to free ALL the pidl memory (just in good taste, plus
        // its technically a memory leak if you don't);

        DisposePidl(pdl);
        DisposePidl(lpParams.pdlTarget);
        lpParams.pdlTarget:=nil;

     end
     else
        ShowMessage(lpParams.Target);
  end;

end;

Ok Russell, your code did not work because SavePidlToStream requires a memorystream but your code is trying to save it to a filestream:

        // Save pidl to the stream
        SavePidlToStream(strm, lpParams.pdlTarget);

So I skipped that and made this code from your example (I don't need or necessarily want any temp files anyway unless I had to):

      if Assigned(lpParams.pdlTarget) then begin
        strmMem:=TMemoryStream.Create;
        SavePidlToStream(strmMem, lpParams.pdlTarget);
        szStr:=StreamSaveToStr(strmMem);
        ShowMessage(szStr);
        StreamLoadFromStr(strmMem, szStr);
        pdl:=LoadPidlFromStream(strmMem);
        strmMem.Free;
        ExecutePidl(pdl, nil);
        DisposePidl(pdl);
        DisposePidl(lpParams.pdlTarget);
        lpParams.pdlTarget:=nil;
      end;

Works great! Thank you so much. I'll open the other q directed to you now.

Actually, my code does work (or at least in the context of my system). The code i wrote takes a TStream, so file/memory/other stream makes no difference, as they are all decendants of TStream. (I just used s TFileStream as an example)

Anyways, it was just an example so you had some idea of what you were looking at with the code

And thanks for the pts, much appreciated.

Russell

And thanks for the knowledge. I have been programming for many years in both TP and Delphi, and somehow I never got into Streams, but now that I see their power, I like them!

I'd love to send you the results of what I have been putting together, but I guess you'd have to give up your email address for that...

Glad to have helped, and yes, the streams and their "children" are pretty powerful. (My email addr is in my profile.)

Regards,
Russell