Functions used to establish shortcuts in Delphi: CreateShortcut

Unit Unit1;

Interface

Uses
Windows, Messages, sysutils, variants, Classes, Graphics, Controls, Forms,
Dialogs, Stdctrls;

Type
TForm1 = Class (Tform)
Button1:tbutton;
Button2:tbutton;
Button3:tbutton;
Button4:tbutton;
Procedure Button1Click (Sender:tobject);
Procedure Button2click (Sender:tobject);
Procedure Button3click (Sender:tobject);
Procedure Button4click (Sender:tobject);
End

Var
Form1:tform1;

Implementation

{$R *.DFM}

Uses
Shlobj, ActiveX, comobj; {The cell used by the function}

{Function Description:}
{The first parameter is the file to which you want to create the shortcut, which is required; all other optional parameters}
{The second parameter is the shortcut name, and the name of the parameter one is used by default}
{The third parameter is the specified destination folder, the default is the desktop; if there is a fourth parameter, the parameter is ignored}
{The fourth parameter specifies the destination folder in a constant way; The series constants are defined in the Shlobj unit, csidl_ the beginning}
function CreateShortcut (exe:string; lnk:string = '; dir:string = '; Id:integer =-1): Boolean;
Var
Iobj:iunknown;
Ilnk:ishelllink;
Ipfile:ipersistfile;
Pidl:pitemidlist;
Infolder:array[0..max_path] of Char;
linkfilename:widestring;
Begin
Result: = False;
If not fileexists (Exe) then Exit;
If lnk = ' then lnk: = Changefileext (Extractfilename (Exe), ');

Iobj: = Createcomobject (Clsid_shelllink);
Ilnk: = Iobj as IShellLink; Ilnk.setpath (Pchar (Exe)); Ilnk.setworkingdirectory (Pchar (Extractfilepath (Exe))); if (Dir = ') and (id =-1) then ID: = Csidl_desktop;
If ID >-1 Then
Begin
SHGetSpecialFolderLocation (0, ID, pidl);
SHGetPathFromIDList (Pidl, InFolder);
linkFileName: = Format ('%s\%s.lnk ', [InFolder, Lnk]);
End Else
Begin
Dir: = Excludetrailingpathdelimiter (dir);
If not directoryexists (Dir) then Exit;
linkFileName: = Format ('%s\%s.lnk ', [Dir, Lnk]);
End

Ipfile: = Iobj as IPersistFile;
If Ipfile.save (Pwidechar (linkFileName), False) = 0 Then result: = True;
End {CreateShortcut function End}


{Test 1: Create a shortcut to the current program on the desktop}
Procedure Tform1.button1click (Sender:tobject);
Begin
CreateShortcut (Application.exename);
End

{Test 2: Create a shortcut on the desktop and specify the shortcut name}
Procedure Tform1.button2click (Sender:tobject);
Begin
CreateShortcut (application.exename, ' newlinkname ');
End

{Test 3: in C:\ Set up shortcut below}
Procedure Tform1.button3click (Sender:tobject);
Begin
CreateShortcut (Application.exename, ', ' c:\ ');
End

{Test 3: Create a shortcut under the Program folder of the Start menu}
Procedure Tform1.button4click (Sender:tobject);
Begin
CreateShortcut (Application.exename, ",", csidl_programs);
End

End.