Shortcut creation
Matthias Schick
the topic says it all. Is there a component (or function)
available, that can create shortcuts in the Win32 environemnt?
Thanks for your help and a merry christmas
------------------------------------------------------
Matthias Schick sch...@itkompetenz.com
it kompetenz GmbH Fon: +49 40 23885020
20097 Hamburg Fax: +49 40 23885033
Glen Swindell
Yes there are a number available. Tack a look at the Delphi Super page at
http://delphi.icm.edu.pl/ and do a search for "Shortcut". This brings up a
number of them.
Hope this helps
Glen Swindell
CSM Limited
Matthias Schick <sch...@itkompetenz.com> wrote in message
news:3860B47E...@itkompetenz.com...
Davie Reed
your program and to use CoUnInitialize when your program exits.
Otherwise you will have to UN-COMMENT out my lines of code that do that
for you.
Davie
P.S. Have fun with them if you can figure them out. Actually, they are
pretty EZ to use.
========== SHORTCUT FUNCTIONS ===========
Function
CreateShortCut_Lnk(LpszPathObjStr,LpszPathLinkStr,LpszDescStr:String):HResult;
Var
psl:IShellLink;
ppf:IPersistFile;
HRes:HRESULT;
wsz:PWideChar; {Max_Path}
LpszPathObj,LpszPathLink,LpszDesc:Array[0..Max_Path] Of Char;
Begin
StrPCopy(LpszPathObj,LpszPathObjStr);
StrPCopy(LpszPathLink,LpszPathLinkStr);
StrPCopy(LpszDesc,LpszDescStr);
{
CoInitialize(Nil);
}
GetMem(Wsz,Max_Path*2);
Hres:=CoCreateInstance(CLSID_ShellLink,
Nil,
CLSCTX_INPROC_SERVER,
IID_IShellLinkA,
psl);
If (SUCCEEDED(Hres)) Then
Begin
psl.SetPath(lpszPathObj);
psl.SetDescription(lpszDesc);
Hres:=psl.QueryInterface(IPersistFile,ppf);
if (SUCCEEDED(Hres)) Then
Begin
MultiByteToWideChar(CP_ACP,
0,
lpszPathLink,
-1,
wsz,
MAX_PATH);
Hres:=ppf.Save(wsz, TRUE);
End;
End;
FreeMem(Wsz,Max_Path*2);
{
CoUnInitialize;
}
Result:=Hres;
End;
Procedure HandleErr(HRes:HResult);
Begin
End;
Function ReadShortCut_Lnk(MyHandle:hWnd;LinkNameStr:String;Var
ActualNameStr,DescriptionStr:String;Var ReLink:Byte;Var
OldBadName:String;ForceReLink:Boolean):HResult;
Var
psl:IShellLink;
ppf:IPersistFile;
HRes:HRESULT;
szGotPath:PChar;
szDescription:PChar;
WFD:WIN32_FIND_DATA;
wsz:PWideChar; {Max_Path}
LinkName,ActualName:Array[0..Max_Path] Of Char;
Begin
{
{ ReLink = 0 It was resolved successfully simply
{ ReLink = 1 It was resolved via user interface
{ ReLink = 2 It was NOT resolved
}
ReLink:=0;
ActualName[0]:=#0;
OldBadName:='';
StrPCopy(LinkName,LinkNameStr);
GetMem(Wsz,Max_Path*2);
GetMem(szGotPath,MAX_PATH);
GetMem(szDescription,MAX_PATH);
{
CoInitialize(Nil);
}
Hres:=CoCreateInstance(CLSID_ShellLink,
Nil,
CLSCTX_INPROC_SERVER,
IID_IShellLinkA,
psl);
If (SUCCEEDED(Hres)) Then
Begin
Hres:=psl.QueryInterface(IPersistFile,ppf);
If (SUCCEEDED(Hres)) Then
Begin
MultiByteToWideChar(CP_ACP,
0,
LinkName,
-1,
wsz,
MAX_PATH);
Hres:=ppf.Load(wsz, STGM_READ);
If (SUCCEEDED(Hres)) Then
Begin
If ForceReLink Then
Begin
HRes:=psl.GetPath(szGotPath,
MAX_PATH,
wfd,
{SLGP_SHORTPATH}
SLGP_RAWPATH );
If HRes=0 Then
OldBadName:=szGotPath;
Hres:=psl.Resolve(MyHandle, SLR_NO_UI);
If HRes<>0 Then
Begin
ReLink:=2;
Hres:=psl.Resolve(MyHandle,
SLR_UPDATE{SLR_NO_UI}{SLR_ANY_MATCH});
If HRes=0 Then
ReLink:=1;
End;
End;
If (SUCCEEDED(Hres)) Then
Begin
Hres:=psl.GetPath(szGotPath,
MAX_PATH,
wfd,
{SLGP_SHORTPATH}
SLGP_RAWPATH );
If ( NOT SUCCEEDED(Hres)) Then
HandleErr(Hres);
Hres:=psl.GetDescription(szDescription,
MAX_PATH);
If (NOT SUCCEEDED(Hres)) Then
HandleErr(Hres);
LStrCpy(ActualName, szGotPath);
End;
End;
End;
End;
{
CoUnInitialize;
}
ActualNameStr:=ActualName;
DescriptionStr:=szDescription;
FreeMem(szDescription,MAX_PATH);
FreeMem(szGotPath,MAX_PATH);
FreeMem(Wsz,Max_Path*2);
Result:=Hres;
End;
Function
UpDateShortCut_Lnk(MyHandle:hWnd;LinkNameStr:String;OldPathStr,NewPathStr:String):HResult;
Var
psl:IShellLink;
ppf:IPersistFile;
HRes:HRESULT;
szGotPath:PChar;
WFD:WIN32_FIND_DATA;
wsz:PWideChar; {Max_Path}
LinkName,ActualName:Array[0..Max_Path] Of Char;
lpszPathObj:Array[0..Max_Path] Of Char;
S1:String;
Begin
ActualName[0]:=#0;
StrPCopy(LinkName,LinkNameStr);
GetMem(Wsz,Max_Path*2);
GetMem(szGotPath,MAX_PATH);
{
CoInitialize(Nil);
}
Hres:=CoCreateInstance(CLSID_ShellLink,
Nil,
CLSCTX_INPROC_SERVER,
IID_IShellLinkA,
psl);
If (SUCCEEDED(Hres)) Then
Begin
Hres:=psl.QueryInterface(IPersistFile,ppf);
If (SUCCEEDED(Hres)) Then
Begin
MultiByteToWideChar(CP_ACP,
0,
LinkName,
-1,
wsz,
MAX_PATH);
Hres:=ppf.Load(wsz, STGM_READ);
If (SUCCEEDED(Hres)) Then
Begin
Hres:=psl.GetPath(szGotPath,
MAX_PATH,
wfd,
{SLGP_SHORTPATH}
SLGP_RAWPATH );
If ( NOT SUCCEEDED(Hres)) Then
HandleErr(Hres);
S1:=szGotPath;
S1:=UpperCase(S1);
If S1=UpperCase(OldPathStr) Then
Begin
StrPCopy(lpszPathObj,NewPathStr);
psl.SetPath(lpszPathObj);
Hres:=ppf.Save(wsz, True);
End;
End;
End;
End;
{
CoUnInitialize;
}
FreeMem(szGotPath,MAX_PATH);
FreeMem(Wsz,Max_Path*2);
Result:=Hres;
End;
============================================