creating a Shortcut to a file

Icon Shortcut Verknüpfung anlegen

You can try the code below – maybe you needed CoInitialize?
The code works fine for me on NT and 98, using Delphi4.

[code lang=”delphi”]{
function CreateAShortcut(aTarget,startDir,aCaption,aGroup: string;
aLoc: TShortcut; silent: Boolean): Boolean;

HISTORY: Original version by
======== – Jon E. Scott
web: http://members.xoom.com/jescott (“Delphi Code Tips”)
email: jescott@xoommail.com

Some improvements and comments 1999-06-18 by
Bjorn Mossberg: mossberg@mindspring.com

PURPOSE: To create a shortcut on the desktop, start menu,
======== in a program group, in the SendTo folder,
or in the SysTray region.

REQUIRES:
=========
uses ShlObj, ComObj, Registry, ActiveX; // and others

type
TShortcut = (sc_Desktop, sc_QuickLaunch, sc_SendTo,
sc_Start, sc_Programs);

PARAMETERS:
===========

aTarget: The full path to the executable file
for which a shortcut is to be created.

startDir: String specifying the folder that is to be made
current before aTarget executes. May be blank.

aCaption: String specifying the “legend” to be written
under the icon. May be left blank, in which
case the name of the executable file minus
its extension is used.
Caution: Use only legal file characters!

aGroup: Meaningful only when aLoc=sc_Programs,
sc_Desktop, or sc_SendTo.
Specifies the name of the subfolder to
which the shortcut is to be added.
Should already exist.

aLoc: One of the values of type ShortcutType:

}
function CreateAShortcut(aTarget,startDir,aCaption,aGroup: string;
aLoc: TShortcut; silent: Boolean): Boolean;
var
anObject: IUnknown;

function SaveLinkFile(aCap,aFldr: String): Boolean;
var
aPFile: IPersistFile;
s,fName: String;
wName: WideString;
i: Integer;
begin
{Save a copy of the object as a link file.
Try up to 3 times, using tails ” (2)” and ” (3)”.}
Result := False;
aPFile := anObject as IPersistFile;
s := EmptyStr;
for i:=1 to 3 do begin
fName := aCap + s + ‘.lnk’;
wName := MergedPath(aFldr,fName);
Result := S_OK=aPFile.Save(PWChar(wName), False);
if Result then Break;
s := Format(‘ (%d)’,[i]);
end;
end;

function MergedPath(rootDir,subDir: String): String;
var
n: Integer;
begin
n := Length(rootDir);
if n=0 then Result := subDir
else begin
if rootDir[n]=’\’ then Delete(rootDir,n,1);
n := Length(subDir);
if n=0 then Result := rootDir
else begin
if subDir[1]=’\’ then Delete(subDir,1,1);
Result := rootDir + ‘\’ + subDir;
end;
end;
end;

const
BaseKey = ‘Software\MicroSoft\Windows\CurrentVersion’;
Shell_Folders = ‘Shell Folders’;
VDesktop = ‘Desktop’;
ProgramMenu = ‘”Start | Programs” menu’;
var
aDir,aVar: String;
aDesc: String;
dskTop: String;
s,msg: String;
begin
Result := False;
if NOT (CoInitialize(nil) in [S_OK,S_FALSE]) then begin
ShowMessage(‘Could not initialize OLE COM Library’);
Exit;
end;

{Create an object that can be used as a shortcut
and later saved as a customized ???.lnk file.}
anObject := CreateComObject(CLSID_ShellLink);
try
with anObject as IShellLink do begin
{Write in “Target” in the link file:
The full path of the executable file}
SetPath(PChar(aTarget));

{If supplied, write in “Start In” in the link file:
The folder to be made current before executing “Target”.}
if (Length(startDir)>0) AND DirectoryExists(startDir) then
SetWorkingDirectory(PChar(startDir));
end;

{If aCaption is supplied we use that as the caption
under the icon representing the shortcut.
Otherwise we simply strip the extension
from the name of the target file.
NOTE: The name of the link file is “aCaption.lnk”. }
if Length(aCaption)=0 then
aCaption := ExtractFileName(aTarget);
aCaption := ReplaceAll(aCaption,’/’,’-‘); {May need other fixing.}
aCaption := ChangeFileExt(aCaption, EmptyStr);

aVar := EmptyStr;
aDesc := EmptyStr;
case aLoc of
sc_Start: aVar := ‘Start Menu’;
sc_Programs: begin
aVar := ‘Programs’;
aDesc := ProgramMenu;
end;
sc_SendTo: begin
aVar := ‘SendTo’;
aDesc := aVar + ‘ menu’;
end;
sc_QuickLaunch:
with TRegIniFile.Create(BaseKey+’\GrpConv’) do try
aVar := ‘Quick Launch’; {Need aVar for msg later}
aDir := ReadString(‘MapGroups’,aVar,EmptyStr);
aDesc := aVar + ‘ (SysTray) area’;
finally
Free;
end;
else
aVar := VDesktop; {Default}
end;
if Length(aDesc)=0 then
aDesc := aVar;

with TRegIniFile.Create(BaseKey+’\Explorer’) do try
{Always get the path to the Desktop as a fallback.}
dskTop := ReadString(Shell_Folders,VDesktop,EmptyStr);
if Length(aDir)=0 then begin
{Here for all cases except _QUICKLAUNCH}
if Length(aVar)>0 then {Paranoid check}
aDir := ReadString(Shell_Folders,aVar,EmptyStr);
if Length(aDir)=0 then {Should never happen, but …}
aDir := dskTop;
end;
finally
Free;
end;

if Length(aDir)=0 then
{Hard to imagine that we’ll ever be here.}
ShowMessage(‘Could not determine where to create new shortcut!’)
else begin
msg := Format(‘Added shortcut “%s” to the %s’,[aCaption,aDesc]);
{Subfolders do not make sense for the SysTray or StartMenu.}
if (Length(aGroup)>0) AND
(aLoc in [sc_Desktop,sc_SendTo,sc_Programs]) then
begin
{The caller is suggesting a subfolder which
we hope exists. Use it only if it does!}
s := MergedPath(aDir,aGroup);
if DirectoryExists(s) then begin
aDir := s;
AppendStr(msg,Format(‘ in the subfolder “%s”‘,[aGroup]));
end else
msg := Format(‘”%s” is not a subfolder of the %s.’
+’ Added the shortcut directly instead.’,[aGroup,aDesc]);
end;

{Save a copy of the object as a link file.
Try up to 3 times, using tails ” (2)” and ” (3)”.}
Result := SaveLinkFile(aCaption,aDir);

if NOT Result then
msg := ‘Could not create shortcut to ‘ + aTarget;
if NOT Result OR NOT silent then
ShowMessage(msg);

if (Length(dskTop)>0) AND (aDir<>dskTop) AND
{Since the dskTop folder is well defined, and not the
one we just added the shortcut to, we offer to add a
copy of the shortcut to the Desktop as well.
We do this whether we failed above or not.}
(mrYes=MessageDlg(‘Would you like to add a copy’+
‘ of the shortcut to the desktop?’,
mtConfirmation,[mbYes,mbNo],0)) then
begin
{Don’t reset Result unless we are successful!}
msg := ‘esktop shortcut to ‘+aTarget;
if SaveLinkFile(aCaption,dskTop) then begin
Result := True;
msg := ‘D’+msg+’ successfully created!’;
end else
msg := ‘Could not create d’+msg;
if NOT Result OR NOT silent then
ShowMessage(msg);
end;
end;
finally
// TComObject(anObject).Free; {Cannot do this! Memory leak???}
CoUninitialize;
end;
end;
[/code]

[tags]Delphi, System, Files[/tags]