bremeski
asked on
How do I convert/extract information from a Windows Installer shortcut?
I know how to extract info from a normal shortcut (CoCreateInstance(CLSID_Sh
I need to be able to get the normal shortcut info like:
Target
Parameters (arguments)
WorkDir
I need to be able to get the normal shortcut info like:
Target
Parameters (arguments)
WorkDir
ASKER
Correct. This code will gives you
--------------------------
C:\WINDOWS\Installer\{9011
--------------------------
for the Windows Installer shortcut to Word 2003, for instance. Normally they point to an ico file or something else silly like that.
--------------------------
C:\WINDOWS\Installer\{9011
--------------------------
for the Windows Installer shortcut to Word 2003, for instance. Normally they point to an ico file or something else silly like that.
ASKER CERTIFIED SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
ASKER
rllibby, this was a great asnwer that solved the problem perfectly. Thank you!
Skip
Skip
My pleasure, and thank you.
Russell
Russell
ASKER
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 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
ASKER
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'
Skip
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(Mallo
Malloc.Free(ID);
Malloc:=nil;
end;
end;
function CopyITEMID(Malloc: IMalloc; ID: PItemIDList): PItemIDList;
begin
result:=Malloc.Alloc(ID^.m
CopyMemory(Result, ID, ID^.mkid.cb+SizeOf(ID^.mki
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^.mki
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)-
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)+c
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.fMask:=SEE_MASK
if Assigned(pdwProcess) then lpExecInfo.fMask:=lpExecIn
lpExecInfo.Wnd:=GetDesktop
lpExecInfo.nShow:=SW_SHOWN
lpExecInfo.lpIDList:=IDLis
// Attempt the start
result:=ShellExecuteEx(@lp
// Return the process handle if successful and buffer was passed
if result and Assigned(pdwProcess) then pdwProcess^:=lpExecInfo.hP
end;
function MsiLocateComponentA(szComp
function MsiGetShortcutTargetA(szSh
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(C
if (result = S_OK) then
begin
// Get a pointer to the IPersistFile interface.
result:=psl.QueryInterface
if (result = S_OK) then
begin
// Ensure that the string is Unicode.
MultiByteToWideChar(CP_ACP
// Load the shortcut.
result:=ppf.Load(@wszFile,
if (result = S_OK) then
begin
// Resolve the link.
result:=psl.Resolve(Applic
if (result = S_OK) then
begin
// Get the path to the link target.
result:=psl.GetPath(@szPat
// 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:=Copy
DisposePIDL(pdl);
ZeroMemory(@szPath, SizeOf(szPath));
end;
end;
if (result = S_OK) then
begin
LinkParams.Target:=szPath;
// Check IShellLinkDataList
if (psl.QueryInterface(IShell
begin
if (MsiGetShortcutTargetA(PCh
begin
MsiLocateComponentA(@szDes
LinkParams.Target:=szPath;
end;
end;
// Get the description of the target.
result:=psl.GetDescription
// Check description
if (result = S_OK) then
begin
// Check for null description
if (szDesc[0] = #0) and Assigned(LinkParams.pdlTar
begin
ShGetDesktopFolder(ppshf);
if (ppshf.GetDisplayNameOf(Li
begin
case str.uType of
STRRET_CSTR :
SetString(LinkParams.Descr
STRRET_OFFSET :
begin
lpData:=@LinkParams.pdlTar
SetString(LinkParams.Descr
end;
STRRET_WSTR :
begin
LinkParams.Description:=st
SysFreeString(str.pOleStr)
end;
end;
end;
// Release the desktop folder
ppshf:=nil;
end
else
// Description
LinkParams.Description:=sz
// Get the arguments
result:=psl.GetArguments(@
if (result = S_OK) then
begin
LinkParams.Parameters:=szA
// Get the working directory
result:=psl.GetWorkingDire
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\t
begin
if Assigned(lpParams.pdlTarge
ExecutePidl(lpParams.pdlTa
else
ShowMessage(lpParams.Targe
end;
end;
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(Mallo
Malloc.Free(ID);
Malloc:=nil;
end;
end;
function CopyITEMID(Malloc: IMalloc; ID: PItemIDList): PItemIDList;
begin
result:=Malloc.Alloc(ID^.m
CopyMemory(Result, ID, ID^.mkid.cb+SizeOf(ID^.mki
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^.mki
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)-
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)+c
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.fMask:=SEE_MASK
if Assigned(pdwProcess) then lpExecInfo.fMask:=lpExecIn
lpExecInfo.Wnd:=GetDesktop
lpExecInfo.nShow:=SW_SHOWN
lpExecInfo.lpIDList:=IDLis
// Attempt the start
result:=ShellExecuteEx(@lp
// Return the process handle if successful and buffer was passed
if result and Assigned(pdwProcess) then pdwProcess^:=lpExecInfo.hP
end;
function MsiLocateComponentA(szComp
function MsiGetShortcutTargetA(szSh
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(C
if (result = S_OK) then
begin
// Get a pointer to the IPersistFile interface.
result:=psl.QueryInterface
if (result = S_OK) then
begin
// Ensure that the string is Unicode.
MultiByteToWideChar(CP_ACP
// Load the shortcut.
result:=ppf.Load(@wszFile,
if (result = S_OK) then
begin
// Resolve the link.
result:=psl.Resolve(Applic
if (result = S_OK) then
begin
// Get the path to the link target.
result:=psl.GetPath(@szPat
// 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:=Copy
DisposePIDL(pdl);
ZeroMemory(@szPath, SizeOf(szPath));
end;
end;
if (result = S_OK) then
begin
LinkParams.Target:=szPath;
// Check IShellLinkDataList
if (psl.QueryInterface(IShell
begin
if (MsiGetShortcutTargetA(PCh
begin
MsiLocateComponentA(@szDes
LinkParams.Target:=szPath;
end;
end;
// Get the description of the target.
result:=psl.GetDescription
// Check description
if (result = S_OK) then
begin
// Check for null description
if (szDesc[0] = #0) and Assigned(LinkParams.pdlTar
begin
ShGetDesktopFolder(ppshf);
if (ppshf.GetDisplayNameOf(Li
begin
case str.uType of
STRRET_CSTR :
SetString(LinkParams.Descr
STRRET_OFFSET :
begin
lpData:=@LinkParams.pdlTar
SetString(LinkParams.Descr
end;
STRRET_WSTR :
begin
LinkParams.Description:=st
SysFreeString(str.pOleStr)
end;
end;
end;
// Release the desktop folder
ppshf:=nil;
end
else
// Description
LinkParams.Description:=sz
// Get the arguments
result:=psl.GetArguments(@
if (result = S_OK) then
begin
LinkParams.Parameters:=szA
// Get the working directory
result:=psl.GetWorkingDire
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\t
begin
if Assigned(lpParams.pdlTarge
ExecutePidl(lpParams.pdlTa
else
ShowMessage(lpParams.Targe
end;
end;
ASKER
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
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(szComp
function MsiGetShortcutTargetA(szSh
procedure DisposePIDL(ID: PItemIDList);
var Malloc: IMalloc;
begin
if Assigned(ID) then
begin
OLECheck(SHGetMalloc(Mallo
Malloc.Free(ID);
Malloc:=nil;
end;
end;
function CopyITEMID(Malloc: IMalloc; ID: PItemIDList): PItemIDList;
begin
result:=Malloc.Alloc(ID^.m
CopyMemory(Result, ID, ID^.mkid.cb+SizeOf(ID^.mki
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^.mki
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)-
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)+c
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.fMask:=SEE_MASK
if Assigned(pdwProcess) then lpExecInfo.fMask:=lpExecIn
lpExecInfo.Wnd:=GetDesktop
lpExecInfo.nShow:=SW_SHOWN
lpExecInfo.lpIDList:=IDLis
// Attempt the start
result:=ShellExecuteEx(@lp
// Return the process handle if successful and buffer was passed
if result and Assigned(pdwProcess) then pdwProcess^:=lpExecInfo.hP
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(C
if (result = S_OK) then
begin
// Get a pointer to the IPersistFile interface.
result:=psl.QueryInterface
if (result = S_OK) then
begin
// Ensure that the string is Unicode.
MultiByteToWideChar(CP_ACP
// Load the shortcut.
result:=ppf.Load(@wszFile,
if (result = S_OK) then
begin
// Resolve the link.
result:=psl.Resolve(Applic
if (result = S_OK) then
begin
// Get the path to the link target.
result:=psl.GetPath(@szPat
// 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:=Copy
DisposePIDL(pdl);
ZeroMemory(@szPath, SizeOf(szPath));
end;
end;
if (result = S_OK) then
begin
LinkParams.Target:=szPath;
// Check IShellLinkDataList
if (psl.QueryInterface(IShell
begin
if (MsiGetShortcutTargetA(PCh
begin
MsiLocateComponentA(@szDes
LinkParams.Target:=szPath;
end;
end;
// Get the description of the target.
result:=psl.GetDescription
// Check description
if (result = S_OK) then
begin
// Check for null description
if (szDesc[0] = #0) and Assigned(LinkParams.pdlTar
begin
ShGetDesktopFolder(ppshf);
if (ppshf.GetDisplayNameOf(Li
begin
case str.uType of
STRRET_CSTR :
SetString(LinkParams.Descr
STRRET_OFFSET :
begin
lpData:=@LinkParams.pdlTar
SetString(LinkParams.Descr
end;
STRRET_WSTR :
begin
LinkParams.Description:=st
SysFreeString(str.pOleStr)
end;
end;
end;
// Release the desktop folder
ppshf:=nil;
end
else
// Description
LinkParams.Description:=sz
// Get the arguments
result:=psl.GetArguments(@
if (result = S_OK) then
begin
LinkParams.Parameters:=szA
// Get the working directory
result:=psl.GetWorkingDire
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.Paramete
...
Any ideas?
Skip
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
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(szComp
function MsiGetShortcutTargetA(szSh
procedure DisposePIDL(ID: PItemIDList);
var Malloc: IMalloc;
begin
if Assigned(ID) then
begin
OLECheck(SHGetMalloc(Mallo
Malloc.Free(ID);
Malloc:=nil;
end;
end;
function CopyITEMID(Malloc: IMalloc; ID: PItemIDList): PItemIDList;
begin
result:=Malloc.Alloc(ID^.m
CopyMemory(Result, ID, ID^.mkid.cb+SizeOf(ID^.mki
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^.mki
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)-
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)+c
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.fMask:=SEE_MASK
if Assigned(pdwProcess) then lpExecInfo.fMask:=lpExecIn
lpExecInfo.Wnd:=GetDesktop
lpExecInfo.nShow:=SW_SHOWN
lpExecInfo.lpIDList:=IDLis
// Attempt the start
result:=ShellExecuteEx(@lp
// Return the process handle if successful and buffer was passed
if result and Assigned(pdwProcess) then pdwProcess^:=lpExecInfo.hP
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(C
if (result = S_OK) then
begin
// Get a pointer to the IPersistFile interface.
result:=psl.QueryInterface
if (result = S_OK) then
begin
// Ensure that the string is Unicode.
MultiByteToWideChar(CP_ACP
// Load the shortcut.
result:=ppf.Load(@wszFile,
if (result = S_OK) then
begin
// Resolve the link.
result:=psl.Resolve(Applic
if (result = S_OK) then
begin
// Get the path to the link target.
result:=psl.GetPath(@szPat
// 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:=Copy
DisposePIDL(pdl);
ZeroMemory(@szPath, SizeOf(szPath));
end;
end;
if (result = S_OK) then
begin
LinkParams.Target:=szPath;
// Check IShellLinkDataList
if (psl.QueryInterface(IShell
begin
if (MsiGetShortcutTargetA(PCh
begin
MsiLocateComponentA(@szDes
LinkParams.Target:=szPath;
end;
end;
// Get the description of the target.
result:=psl.GetDescription
// Check description
if (result = S_OK) then
begin
// Check for null description
if (szDesc[0] = #0) and Assigned(LinkParams.pdlTar
begin
ShGetDesktopFolder(ppshf);
if (ppshf.GetDisplayNameOf(Li
begin
case str.uType of
STRRET_CSTR :
SetString(LinkParams.Descr
STRRET_OFFSET :
begin
lpData:=@LinkParams.pdlTar
SetString(LinkParams.Descr
end;
STRRET_WSTR :
begin
LinkParams.Description:=st
SysFreeString(str.pOleStr)
end;
end;
end;
// Release the desktop folder
ppshf:=nil;
end
else
// Description
LinkParams.Description:=sz
// Get the arguments
result:=psl.GetArguments(@
if (result = S_OK) then
begin
LinkParams.Parameters:=szA
// Get the working directory
result:=psl.GetWorkingDire
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.Paramete
...
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
ASKER
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?
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:
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
ASKER
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
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 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
ASKER
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[p
// Get the lo bit
Inc(dwPos);
result[dwPos]:=HEX_CHARS[p
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[Suc
// Check the conversion
if (dwError <> 0) then
// Raise conversion exception
EConvertError.Create('Inva
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\t
begin
if Assigned(lpParams.pdlTarge
begin
// Create file stream
strm:=TFileStream.Create('
// Save pidl to the stream
SavePidlToStream(strm, lpParams.pdlTarget);
// Convert the stream to a string
szStr:=StreamSaveToStr(str
// Free file stream
strm.Free;
// Show the hex string
ShowMessage(szStr);
// Create memory stream
strmMem:=TMemoryStream.Cre
// Load the stream using the hex data
StreamLoadFromStr(strmMem,
// Load the pidl from the stream
pdl:=LoadPidlFromStream(st
// 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.pdlTa
lpParams.pdlTarget:=nil;
end
else
ShowMessage(lpParams.Targe
end;
end;
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[p
// Get the lo bit
Inc(dwPos);
result[dwPos]:=HEX_CHARS[p
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[Suc
// Check the conversion
if (dwError <> 0) then
// Raise conversion exception
EConvertError.Create('Inva
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\t
begin
if Assigned(lpParams.pdlTarge
begin
// Create file stream
strm:=TFileStream.Create('
// Save pidl to the stream
SavePidlToStream(strm, lpParams.pdlTarget);
// Convert the stream to a string
szStr:=StreamSaveToStr(str
// Free file stream
strm.Free;
// Show the hex string
ShowMessage(szStr);
// Create memory stream
strmMem:=TMemoryStream.Cre
// Load the stream using the hex data
StreamLoadFromStr(strmMem,
// Load the pidl from the stream
pdl:=LoadPidlFromStream(st
// 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.pdlTa
lpParams.pdlTarget:=nil;
end
else
ShowMessage(lpParams.Targe
end;
end;
ASKER
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.pdlTarge
strmMem:=TMemoryStream.Cre
SavePidlToStream(strmMem, lpParams.pdlTarget);
szStr:=StreamSaveToStr(str
ShowMessage(szStr);
StreamLoadFromStr(strmMem,
pdl:=LoadPidlFromStream(st
strmMem.Free;
ExecutePidl(pdl, nil);
DisposePidl(pdl);
DisposePidl(lpParams.pdlTa
lpParams.pdlTarget:=nil;
end;
Works great! Thank you so much. I'll open the other q directed to you now.
// 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.pdlTarge
strmMem:=TMemoryStream.Cre
SavePidlToStream(strmMem, lpParams.pdlTarget);
szStr:=StreamSaveToStr(str
ShowMessage(szStr);
StreamLoadFromStr(strmMem,
pdl:=LoadPidlFromStream(st
strmMem.Free;
ExecutePidl(pdl, nil);
DisposePidl(pdl);
DisposePidl(lpParams.pdlTa
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
ASKER
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...
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
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(C
if (result = S_OK) then
begin
// Get a pointer to the IPersistFile interface.
result:=psl.QueryInterface
if (result = S_OK) then
begin
// Ensure that the string is Unicode.
MultiByteToWideChar(CP_ACP
// Load the shortcut.
result:=ppf.Load(@wszFile,
if (result = S_OK) then
begin
// Resolve the link.
result:=psl.Resolve(Applic
if (result = S_OK) then
begin
// Get the path to the link target.
result:=psl.GetPath(szPath
if (result = S_OK) then
begin
LinkParams.Target:=szPath;
// Get the description of the target.
result:=psl.GetDescription
if (result = S_OK) then
begin
LinkParams.Description:=sz
// Get the arguments
result:=psl.GetArguments(s
if (result = S_OK) then
begin
LinkParams.Parameters:=szA
// Get the working directory
result:=psl.GetWorkingDire
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\YourL
begin
ShowMessage(lpParams.Targe
end;
end;