How to create shortcut in Delphi
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; {unit used by this function} {Function description:} {The first parameter is a file to create a shortcut, this is required; all others are optional parameters} {The second parameter is the shortcut name, the file name of parameter one is used by default} {The third parameter specifies the destination folder, and the default destination is desktop; if there is a fourth parameter, this parameter will be ignored} {The fourth parameter is to specify the destination folder by a constant; the series of constants are defined in the ShlObj unit, starting with CSIDL_} 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 ; {End of CreateShortcut function} {Test 1: Make the current program a shortcut 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: Create a shortcut under C: \} procedure TForm1.Button3Click (Sender: TObject); begin CreateShortcut (Application.ExeName,'', 'C: \'); end ; {Test 3: Create a shortcut in the program folder of the Start menu} procedure TForm1.Button4Click (Sender: TObject); begin CreateShortcut (Application.ExeName,'', '', CSIDL_PROGRAMS); end ; end .