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 } |
|
