Title: How to create a shortcut in the Startmenu, on the Desktop,
uses
Registry,
ActiveX,
ComObj,
ShlObj;
type
ShortcutType = (_DESKTOP, _QUICKLAUNCH, _SENDTO, _STARTMENU, _OTHERFOLDER);
function CreateShortcut(SourceFileName: string; // the file the shortcut points to
Location: ShortcutType; // shortcut location
SubFolder, // subfolder of location
WorkingDir, // working directory property of the shortcut
Parameters,
Description: string): // description property of the shortcut
string;
const
SHELL_FOLDERS_ROOT = 'Software\MicroSoft\Windows\CurrentVersion\Explorer';
QUICK_LAUNCH_ROOT = 'Software\MicroSoft\Windows\CurrentVersion\GrpConv';
var
MyObject: IUnknown;
MySLink: IShellLink;
MyPFile: IPersistFile;
Directory, LinkName: string;
WFileName: WideString;
Reg: TRegIniFile;
begin
MyObject := CreateComObject(CLSID_ShellLink);
MySLink := MyObject as IShellLink;
MyPFile := MyObject as IPersistFile;
MySLink.SetPath(PChar(SourceFileName));
MySLink.SetArguments(PChar(Parameters));
MySLink.SetDescription(PChar(Description));
LinkName := ChangeFileExt(SourceFileName, '.lnk');
LinkName := ExtractFileName(LinkName);
// Quicklauch
if Location = _QUICKLAUNCH then
begin
Reg := TRegIniFile.Create(QUICK_LAUNCH_ROOT);
try
Directory := Reg.ReadString('MapGroups', 'Quick Launch', '');
finally
Reg.Free;
end;
end
else
// Other locations
begin
Reg := TRegIniFile.Create(SHELL_FOLDERS_ROOT);
try
case Location of
_OTHERFOLDER : Directory := SubFolder;
_DESKTOP : Directory := Reg.ReadString('Shell Folders', 'Desktop', '');
_STARTMENU : Directory := Reg.ReadString('Shell Folders', 'Start Menu', '');
_SENDTO : Directory := Reg.ReadString('Shell Folders', 'SendTo', '');
end;
finally
Reg.Free;
end;
end;
if Directory '' then
begin
if (SubFolder '') and (Location _OTHERFOLDER) then
WFileName := Directory + '\' + SubFolder + '\' + LinkName
else
WFileName := Directory + '\' + LinkName;
if WorkingDir = '' then
MySLink.SetWorkingDirectory(PChar(ExtractFilePath(SourceFileName)))
else
MySLink.SetWorkingDirectory(PChar(WorkingDir));
MyPFile.Save(PWChar(WFileName), False);
Result := WFileName;
end;
end;
function GetProgramDir: string;
var
reg: TRegistry;
begin
reg := TRegistry.Create;
try
reg.RootKey := HKEY_CURRENT_USER;
reg.OpenKey('Software\Microsoft\Windows\CurrentVersion\Explorer\Shell Folders', False);
Result := reg.ReadString('Programs');
reg.CloseKey;
finally
reg.Free;
end;
end;
Usage Example:
procedure TForm1.Button1Click(Sender: TObject);
const
PROGR = 'c:\YourProgram.exe';
var
resPath: string;
begin
//Create a Shortcut in the Quckick launch toolbar
CreateShortcut(PROGR, _QUICKLAUNCH, '','','','Description');
//Create a Shortcut on the Desktop
CreateShortcut(PROGR, _DESKTOP, '','','','Description');
//Create a Shortcut in the Startmenu /"Programs"-Folder
resPath := CreateShortcut(PROGR, _OTHERFOLDER, GetProgramDir,'','','Description');
if resPath '' then
begin
ShowMessage('Shortcut Successfully created in: ' + resPath);
end;
end;