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 .