Thanks!!
Chuck Platt
For Delphi 3:
interface
uses //Some of these Uses clauses may not be necessary --this is extracted
from a larger unit Windows, { HResult, S_OK, GetLastError,
HKEY_CURRENT_USER... } SysUtils, { Exception, LastDelimiter... } Forms, {
TWindowState } Menus, { TShortcut } ActiveX, { IMalloc, IPersistFile,
CoCreateInstance, CLSCTX_INPROC_SERVER... } ShlObj; { PItemIDList,
IShellLink, CLSID_ShellLink, IID_IShellLinkA... }
const
{ ActiveX doesn't have as many IID GUIDs as OLE2
We took this TGUID from obsolete OLE2.pas }
IID_IPersistFile: TGUID = (
D1:$0000010B;D2:$0000;D3:$0000;D4:($C0,$00,$00,$00,$00,$00,$00,$46));
type
EShellOLEerror = class(Exception);
function DUTStringToWideChar(const Source : string; Dest : PWideChar;
DestSize : Integer) : PWideChar; function ResolveLink(LinkName : String) :
String; function ResolveLinkPIDL(LinkName : String) : PItemIDList;
implementation
uses
//See the Interface Uses comment above...
ShellAPI, { TSHFileInfo }
Registry, { TRegistry }
RegStr, { REGSTR_PATH_EXPLORER }
COMObj, { OLECheck }
InternetShortcuts; { IUniformResourceLocator, etc. }
function DUTStringToWideChar(const Source : string; Dest : PWideChar;
DestSize : Integer) : PWideChar; { Fixes a number of problems with
System.pas' StringToWideChar. This replacement function raises an exception
if things go awry. } const MB_ERR_INVALID_CHARS = $00000008; //Missing from
Windows.pas var Code : Integer; begin SetLastError(NO_ERROR); Code :=
MultiByteToWideChar(CP_ACP { ANSI code page }, MB_ERR_INVALID_CHARS,
PChar(Source), Length(Source), Dest, DestSize - 1); if Code = 0 then raise
Exception.CreateFmt('DUTStringToWideChar: "%s" (Error code %d)',
[SysErrorMessage(GetLastError), GetLastError]); Dest[Code] := #0; Result :=
Dest; end; { DUTStringToWideChar }
function ResolveLink(LinkName : String) : String; { Retrieves the long path
name of the file pointed to by the LinkName LNK file. LinkName must be a
fully qualified path and name. NOTE: ResolveLink will fail if the linked
object isn't a file (links to My Computer, other networked Computers,
virtual folders, etc.) } var SL : IShellLink; PF : IPersistFile; WStr :
array[0..MAX_PATH] of WideChar; Str : array[0..MAX_PATH] of Char; FindData
: TWin32FindData; { from Windows.pas } begin { Get an interface pointer to
the IShellLink interface } OLECheck(CoCreateInstance(CLSID_ShellLink, Nil,
CLSCTX_INPROC_SERVER, IID_IShellLinkA, SL)); { Get an interface pointer to
the IPersistFile interface of IShellLink }
OLECheck(SL.QueryInterface(IID_IPersistFile, PF)); { Convert the link file
pathname to a PWideChar } DUTStringToWideChar(LinkName, WStr, MAX_PATH); {
Initialize the IShellLink object from its disk image }
OLECheck(PF.Load(@WStr, STGM_READ or STGM_SHARE_DENY_NONE)); { Obtain the
linked path } OLECheck(SL.GetPath(@Str, MAX_PATH, FindData,
SLGP_UNCPRIORITY)); Result := String(Str); end; { ResolveLink }
function ResolveLinkPIDL(LinkName : String) : PItemIDList; { Retrieves the
PIDL of the object pointed to by the LinkName LNK file. LinkName must be a
fully qualified path and name. The calling application is responsible for
freeing the PItemIDList using the shell's task allocator
[SHGetMalloc(ShellMalloc) ... ShellMalloc.Free(PIDL)]. NOTE: Contrary to
ResolveLink, ResolveLinkPIDL will NOT fail if the linked object isn't a file
(links to My Computer, other networked Computers, etc.) } var SL :
IShellLink; PF : IPersistFile; WStr : array[0..MAX_PATH] of WideChar;
begin { Get an interface pointer to the IShellLink interface }
OLECheck(CoCreateInstance(CLSID_ShellLink, Nil, CLSCTX_INPROC_SERVER,
IID_IShellLinkA, SL)); { Get an interface pointer to the IPersistFile
interface of IShellLink } OLECheck(SL.QueryInterface(IID_IPersistFile, PF));
{ Convert the link file pathname to a PWideChar }
DUTStringToWideChar(LinkName, WStr, MAX_PATH); { Initialize the IShellLink
object from its disk image } OLECheck(PF.Load(@WStr, STGM_READ or
STGM_SHARE_DENY_NONE)); { Obtain the linked PIDL }
OLECheck(SL.GetIDList(Result)); end; { ResolveLinkPIDL }
Daniel U. Thibault
a.k.a. Urhixidur
a.k.a. Sire Bohémond de Nicée
Sent via Deja.com http://www.deja.com/
Before you buy.
Thanks!!!!
Chuck
Urhixidur <D.U.Th...@Bigfoot.com> wrote in message
news:8cd7pa$a4r$1...@nnrp1.deja.com...
> In article <8cd50i$i77$1...@slb1.atl.mindspring.net>,
> "Charles Platt" <---lordph...@mindspring.com> wrote:
> > Hey all! I have a quick question, and was hoping that someone had
attempted
> > it previously and could shed some light. I would like to be able to
> > determine from a shortcut file (.lnk extension) what it's target file
is.
> > There is some info on this in the Win. API help file, but I am having
> > trouble integrating that back into Delphi. Anyone out there have the
> > answer??
>
> For Delphi 3:
>
> interface
>
> uses file://Some of these Uses clauses may not be necessary --this is
extracted
> from a larger unit Windows, { HResult, S_OK, GetLastError,
> HKEY_CURRENT_USER... } SysUtils, { Exception, LastDelimiter... } Forms,
{
> TWindowState } Menus, { TShortcut } ActiveX, { IMalloc, IPersistFile,
> CoCreateInstance, CLSCTX_INPROC_SERVER... } ShlObj; { PItemIDList,
> IShellLink, CLSID_ShellLink, IID_IShellLinkA... }
>
> const
> { ActiveX doesn't have as many IID GUIDs as OLE2
> We took this TGUID from obsolete OLE2.pas }
> IID_IPersistFile: TGUID = (
>
D1:$0000010B;D2:$0000;D3:$0000;D4:($C0,$00,$00,$00,$00,$00,$00,$46));
>
> type
> EShellOLEerror = class(Exception);
>
> function DUTStringToWideChar(const Source : string; Dest : PWideChar;
> DestSize : Integer) : PWideChar; function ResolveLink(LinkName : String) :
> String; function ResolveLinkPIDL(LinkName : String) : PItemIDList;
>
> implementation
>
> uses
> file://See the Interface Uses comment above...
> ShellAPI, { TSHFileInfo }
> Registry, { TRegistry }
> RegStr, { REGSTR_PATH_EXPLORER }
> COMObj, { OLECheck }
> InternetShortcuts; { IUniformResourceLocator, etc. }
>
> function DUTStringToWideChar(const Source : string; Dest : PWideChar;
> DestSize : Integer) : PWideChar; { Fixes a number of problems with
> System.pas' StringToWideChar. This replacement function raises an
exception
> if things go awry. } const MB_ERR_INVALID_CHARS = $00000008;
file://Missing from