How do I create shortcuts on the system.

unit ShellLink;
 // shortcut creation object.  Handles shell shortcuts (*.LNK) and
 // web shortcuts (*.URL).  Written by Glenn9999 at Tek-tips.com
 // free for use and distribution with this comment left in place
interface
uses
  forms, SysUtils, ShlObj, ActiveX, ComObj, Windows, Registry, inifiles,
  graphics, classes, shellapi, commctrl, comctrls, menus;

const
  CSIDL_COMMON_ADMINTOOLS = $002f; // All Users\Start Menu\Programs\Administrative Tools
  CSIDL_ADMINTOOLS = $0030; // <user name>\Start Menu\Programs\Administrative Tools

type
  TCSIDLType = (ciNone, ciDesktop, ciPrograms, ciStartup, ciStartMenu,
     ciAdminTools, ciCommonDesktop, ciCommonPrograms, ciCommonStartup,
     ciCommonStartMenu, ciCommonAdminTools, ciRecent);
  TShowType = (cwNormal, cwMaximized, cwMinimized);
  TBaseShortCut = class(TComponent)
    private
      FHotKey: Word;
      FHotKeyCtrl: THotKey;
      FFileName: string;
      FLocation: TCSIDLType;
      FIconPath: String;
      fIconIndex: Integer;
      FIcon: TIcon;

      procedure HotKeyToShortCut(hotkey: Word; var HKeyCtrl: THotKey);
      procedure ShortCutToHotKey(HKeyCtrl: THotKey; var hotkey: Word);
      function GetLocationFolder: string;
      function CvtCLSIDType(cstype: TCSIDLType): integer;
    public
      procedure ClearValues;
      Constructor Create(AOwner: TComponent); override;
      destructor Destroy; override;
    published
      // FileName for the shortcut file.
      property FileName: string read FFileName write FFileName;
      // special location for the shortcut file.
      property Location: TCSIDLType read FLocation write FLocation;
      // readonly, has the Icon image referenced if it is available
      property Icon: TIcon read FIcon;
      // if specified, the file path to the icon for the shortcut
      property IconPath: String read FIconPath write FIconPath;
      // if IconPath is specified, the index for the icon in question
      property IconIndex: integer read fIconIndex write fIconIndex;
      // hotkey defined for the shortcut file.
      property HotKey: THotKey read FHotKeyCtrl write FHotKeyCtrl;
  end;
  TWebShortcut = class(TBaseShortcut)
    private
      FURL: string;
    public
      procedure LoadInternetShortCut;
      procedure SaveInternetShortCut;
    published
     // url value to save for internet shortcuts
      property URL: String read FUrl write FUrl;
  end;

  TWin32ShortCut = class(TBaseShortcut)
    private
      FShellLink: IShellLink;
      FPersistFile: IPersistFile;
      FAppPath: String;
      FRelativePath: String;
      FPIDL: PItemIDList;
      FWorkDirectory: String;
      FArguments: String;
      FDescription: String;
      FShowCmd: TShowType;

      function CvtShowType(showtype: TShowType): integer;
      function CvtTShowType(showtype: integer): TShowType;
    public
      Constructor Create(AOwner: TComponent); override;
      procedure ClearValues;
      procedure LoadShortCut;
      procedure SaveShortCut;
      procedure SaveProgramGroup;
      procedure ResolveShortCut;
    published
      // path for the application or data file the shortcut references.
      property AppPath: string read FAppPath write FAppPath;
      // relative path in relation to AppPath
      property RelativePath: string read FRelativePath write FRelativePath;
      // PItemIDList value for file referenced in AppPath
      property ItemIDList: PItemIDList read FPIdl write FPIdl;
      // Working Directory ("Start In")
      property WorkDir: string read FWorkDirectory write FWorkDirectory;
      // Arguments to pass for AppPath
      property Arguments: string read FArguments write FArguments;
      // shortcut description
      property Description: string read FDescription write FDescription;
      // window state for the started program.
      property ShowCmd: TShowType read FShowCmd write FShowCmd;
    end;

implementation

constructor TBaseShortCut.Create;
// create icon and hotkey controls
begin
  inherited;

  FIcon := TIcon.Create;
  FHotKeyCtrl := THotKey.CreateParented(Application.Handle);
end;

destructor TBaseShortCut.Destroy;
// free icon and hotkey control
begin
  FIcon.Free;
  FHotKeyCtrl.Free;
  inherited;
end;

procedure TBaseShortCut.HotKeyToShortCut(hotkey: Word; var HKeyCtrl: THotKey);
// convert HotKey value from shortcuts to Hotkey value compatible with THotKey
var
  Shift: TShiftState;
  hlb: byte;
begin
  hlb := WordRec(hotkey).hi;
  Shift := [];
  if (hlb and HOTKEYF_SHIFT) <> 0 then
    Shift := Shift + [ssShift];
  if (hlb and HOTKEYF_CONTROL) <> 0 then
    Shift := Shift + [ssCtrl];
  if (hlb and HOTKEYF_ALT) <> 0 then
    Shift := Shift + [ssAlt];
  HotKey := HotKey and $00FF;
  HKeyCtrl.HotKey := ShortCut(HotKey, Shift);
end;

procedure TBaseShortCut.ShortCutToHotKey(HKeyCtrl: THotKey; var hotkey: Word);
// convert THotkey compatible Hotkey to shortcut hotkey.
var
  Key: Word;
  shb: Byte;
  Shift: TShiftState;
begin
  ShortCutToKey(HKeyCtrl.HotKey, Key, Shift);
  shb := 0;
  if ssShift in Shift then
    shb := shb + HOTKEYF_SHIFT;
  if ssCtrl in Shift then
    shb := shb + HOTKEYF_CONTROL;
  if ssAlt in Shift then
    shb := shb + HOTKEYF_ALT;
  hotkey := (shb shl 8) or key;
end;

function TBaseShortCut.GetLocationFolder: string;
// takes special folder location and filename given and returns proper path.
var
  pIdl: PItemIDList;
  hPath: PChar;
begin
  hPath := StrAlloc(max_path);
  if SHGetSpecialFolderLocation(0, cvtCLSIDType(FLocation), pidl) = 0 then
     SHGetPathFromIDList(pIdl, hPath);
  SetLastError(0);
  if FLocation = ciNone then
    Result := FFileName
  else
    Result := String(hPath) + '\' + FFileName;
  StrDispose(hPath);
end;

function TBaseShortCut.CvtCLSIDType(cstype: TCSIDLType): integer;
// convert TCSIDLType type representing special folder location to the CSIDL constants.
begin
  case cstype of
    ciNone: Result := -1;
    ciDesktop: Result := CSIDL_DESKTOP;
    ciPrograms: Result := CSIDL_PROGRAMS;
    ciStartup: Result := CSIDL_STARTUP;
    ciStartMenu: Result := CSIDL_STARTMENU;
    ciAdminTools: Result := CSIDL_ADMINTOOLS;
    ciCommonDesktop: Result := CSIDL_COMMON_DESKTOPDIRECTORY;
    ciCommonPrograms: Result := CSIDL_COMMON_PROGRAMS;
    ciCommonStartup: Result := CSIDL_COMMON_STARTUP;
    ciCommonStartMenu: Result := CSIDL_COMMON_STARTMENU;
    ciCommonAdminTools: Result := CSIDL_COMMON_ADMINTOOLS;
    ciRecent: Result := CSIDL_RECENT;
  else
    Result := CSIDL_DESKTOP;
  end;
end;

procedure TBaseShortCut.ClearValues;
// clear parameter values for creating short cuts.
begin
  FHotkey := 0;
  HotKeyToShortCut(FHotKey, FHotKeyCtrl);
  FIconPath := '';
  fIconIndex := 0;
  FIcon.Free;
  FIcon := TIcon.Create;
end;

constructor TWin32ShortCut.Create;
// create overriden, create FShellLink, FPersistFile
begin
  inherited;
  CoCreateInstance(CLSID_ShellLink, nil, CLSCTX_INPROC_SERVER, IShellLink, FShellLink);
  FPersistFile := FShellLink as IPersistFile;
end;

procedure TWin32ShortCut.ClearValues;
// clear parameter values for creating short cuts.
begin
  inherited;
  FAppPath := '';
  FRelativePath := '';
  FPIDL := nil;
  FWorkDirectory := '';
  FArguments := '';
  FDescription := '';
  FShowCmd := cwNormal;
end;

function TWin32ShortCut.CvtShowType(showtype: TShowType): integer;
// convert TShowType to window display constant.
begin
  case showtype of
    cwNormal: Result := SW_SHOWNORMAL;
    cwMaximized: Result := SW_SHOWMAXIMIZED;
    cwMinimized: Result := SW_SHOWMINIMIZED;
  else
    Result := SW_SHOWNORMAL;
  end;
end;

function TWin32ShortCut.CvtTShowType(showtype: integer): TShowType;
// convert window display constant to TShowType.
begin
  case showtype of
    SW_SHOWNORMAL: Result := cwNormal;
    SW_SHOWMAXIMIZED: Result := cwMaximized;
    SW_SHOWMINIMIZED: Result := cwMinimized;
  else
    Result := cwNormal;
  end;
end;

procedure TWin32ShortCut.ResolveShortCut;
// resolves a shortcut and saves to file if AppPath value needs fixed.
begin
  FShellLink.Resolve(Application.Handle, SLR_UPDATE);
  LoadShortCut;
end;

procedure TWin32ShortCut.LoadShortCut;
// loads a regular shortcut file (*.LNK) into the object based on FileName and Location.
var
  FP: array[0..MAX_PATH * 2] of Char;
  pfd: TWin32FindDataA;
  LnkName: WideString;
  showval: integer;
  psfi: TSHFileInfo;
begin
  ClearValues;
  LnkName := WideString(GetLocationFolder);
  FPersistFile.Load(PWideChar(LnkName), 0);

  FillChar(FP, Sizeof(FP), 0);
  FShellLink.GetPath(FP, Sizeof(FP), pfd, 0);
  FAppPath := String(FP);

  FShellLink.GetIDList(Fpidl);

  FillChar(FP, Sizeof(FP), 0);
  FShellLink.GetWorkingDirectory(FP, Sizeof(FP));
  FWorkDirectory := String(FP);

  FillChar(FP, Sizeof(FP), 0);
  FShellLink.GetArguments(FP, Sizeof(FP));
  FArguments := String(FP);

  FillChar(FP, Sizeof(FP), 0);
  FShellLink.GetDescription(FP, Sizeof(FP));
  FDescription := String(FP);

  FShellLink.GetShowCmd(showval);
  FShowCmd := cvtTShowType(showval);

  FShellLink.GetHotkey(FHotKey);
  HotKeyToShortCut(FHotKey, FHotKeyCtrl);


  FillChar(FP, Sizeof(FP), 0);
  FShellLink.GetIconLocation(FP, Sizeof(FP), FIconIndex);
  FIconPath := String(FP);
  // based on icon information tries to load the icon itself into Icon type.
  if FIconPath = '' then  // regular explorer association.
    begin
      SHGetFileInfo(PChar(FAppPath), 0, psfi, sizeof(psfi), SHGFI_ICON);
      FIcon.Handle := psfi.hIcon;
    end
  else                    // specified in file, go get it.
    FIcon.Handle := ExtractIcon(hInstance, PChar(FIconPath), FIconIndex);
end;

procedure TWin32ShortCut.SaveShortCut;
// saves shortcut (*.LNK) to location specified by Filename & Location properties.
var
  LnkName: WideString;
  IDesktopFolder: IShellFolder;
  Dummy: Longint;
begin
  with FShellLink do
    begin
      SetPath(PChar(FAppPath));
      SetRelativePath(PChar(FRelativePath), 0);
      if FWorkDirectory = '' then   // save AppPath file path if not already defined
        FWorkDirectory := ExtractFilePath(FAppPath);
      SetWorkingDirectory(PChar(FWorkDirectory));
      SetArguments(Pchar(FArguments));
      SetDescription(PChar(FDescription));
      SetShowCmd(cvtShowType(FShowCmd));
      ShortCutToHotKey(FHotKeyCtrl, FHotKey);
      SetHotKey(FHotKey);
    end;
 // get IDList value for file in AppPath if not present since it breaks things
 // for file associations (wrong display icon for the LNK) if you don't specify it.
  if FPidl = nil then
    begin
      SHGetDesktopFolder(IDesktopFolder);
      LnkName := WideString(FAppPath);
      IDesktopFolder.ParseDisplayName(0, nil, PWideChar(LnkName), Dummy,
            fPIDL, Dummy);
    end;
  FShellLink.SetIDList(fpidl);
  FShellLink.SetIconLocation(PChar(FIconPath), FIconIndex);
  // force proper extension.  Intended as a safety measure.
  FFileName := ChangeFileExt(FFileName, '.LNK');
  LnkName := WideString(GetLocationfolder);
  FPersistFile.Save(PWideChar(LnkName), True);
end;

procedure TWin32ShortCut.SaveProgramGroup;
// makes a program group (directory) named FileName based on Location specifier.
// also specifies a display icon if those values are present.
var
  ifile: TIniFile;
  GroupPath: String;
begin
  // create the folder.
  GroupPath := GetLocationFolder;
  CreateDirectory(PChar(GroupPath), nil);
  { now specify the display icon.  This requires writing a file named desktop.ini
    with system/hidden attributes, and specifying a system attribute for the
    folder value }
  DeleteFile(PChar(GroupPath + '\desktop.ini'));
  ifile := TiniFile.Create(GroupPath + '\desktop.ini');
  try
    ifile.WriteString('.ShellClassInfo', 'IconFile', FIconPath);
    ifile.WriteInteger('.ShellClassInfo', 'IconIndex', FIconIndex);
    iFile.WriteString('.ShellClassInfo', 'InfoTip', FFileName);
  finally
    ifile.Free;
  end;
  SetFileAttributes(PChar(GroupPath), FILE_ATTRIBUTE_SYSTEM);
  SetFileAttributes(PChar(GroupPath + '\desktop.ini'),
          FILE_ATTRIBUTE_SYSTEM or FILE_ATTRIBUTE_HIDDEN);
end;

procedure TWebShortCut.LoadInternetShortCut;
// Loads information for internet shortcut (*.URL) from FileName and Location.
  var
    inifile: TIniFile;
    psfi: TSHFileInfo;
  begin
    ClearValues;
    iniFile := TIniFile.Create(GetLocationFolder);
    try
      fURL := iniFile.ReadString('InternetShortcut', 'URL', '');
      fHotKey := iniFile.ReadInteger('InternetShortcut', 'Hotkey', 0);
      HotKeyToShortCut(FHotKey, FHotKeyCtrl);
      fIconPath := iniFile.ReadString('InternetShortcut', 'IconFile', '');
      fIconIndex := iniFile.ReadInteger('InternetShortcut', 'IconIndex', 0);
    finally
      inifile.free;
    end;
    // load icon into TIcon if one is available.
    if FIconPath = '' then
      begin
        SHGetFileInfo(PChar(fURL), 0, psfi, sizeof(psfi), SHGFI_ICON);
        FIcon.Handle := psfi.hIcon;
      end
    else
      FIcon.Handle := ExtractIcon(hInstance, PChar(FIconPath), FIconIndex);
  end;

procedure TWebShortCut.SaveInternetShortCut;
// saves information to Internet ShortCut (*.URL) consistent with FileName
// and Location
  var
    inifile: TIniFile;
    FName: String;
  begin
    FName := GetLocationFolder;
    // force file name to proper extension and delete old file name if exists
    FName := ChangeFileExt(FName, '.URL');
    DeleteFile(PChar(FName));
    iniFile := TIniFile.Create(FName);
    try
      iniFile.WriteString('InternetShortcut', 'URL', fURL);
      iniFile.WriteString('InternetShortcut', 'IDList', '');
      ShortCutToHotKey(FHotKeyCtrl, FHotKey);
      iniFile.WriteInteger('InternetShortcut', 'Hotkey', FHotKey);
      if FIconPath <> '' then
        begin
          iniFile.WriteString('InternetShortcut', 'IconFile', FIconPath);
          iniFile.WriteInteger('InternetShortcut', 'IconIndex', FIconIndex);
        end;
    finally
      iniFile.Free;
    end;
  end;
end.

procedure TForm1.Button4Click(Sender: TObject);
begin
  SCut.ClearValues;
  // create program group, icon path and index indicate what icon to use,
  // leave those blank to use the default icon.
  SCut.IconPath := ParamStr(0);
  Scut.IconIndex := 0;
  // special location for the program group.  FileName is pathed from that point
  SCut.Location := ciPrograms;
  SCut.FileName := 'MyProgramGroup';
  SCut.SaveProgramGroup;
  // create LNK for the program on the same path as the program group.
  SCut.AppPath := ParamStr(0);  // thing that is run.
  SCut.Location := ciPrograms;  // special location
  SCut.FileName := 'MyProgramGroup\Project1'; // path and name, LNK automatically appended if not already present.
  SCut.SaveShortCut;
end;

procedure TForm1.Button8Click(Sender: TObject);
begin
  SCut.ClearValues;
  SCut.URL := 'http://tek-tips.com/';
  SCut.Location := ciDesktop;
  SCut.FileName := 'tek-tips.url';
  SCut.SaveInternetShortCut;
end;

procedure TForm1.Button6Click(Sender: TObject);
begin
  if OpenDialog1.Execute then
    begin
      SCut.Location := ciNone;  // no special location, Filename treated as full path.
      SCut.FileName := OpenDialog1.FileName;
      SCut.LoadShortCut;
      HotKey1.HotKey := SCut.HotKey.HotKey; // hotkey control used in object, display it on another hotkey control on the form.
      Memo1.Clear;
      Memo1.Lines.Add('AppPath: ' + SCut.AppPath);
      Memo1.Lines.Add('WorkDir: ' + SCut.WorkDir);
      Memo1.Lines.Add('Arguments: ' + SCut.Arguments);
      Memo1.Lines.Add('Description: ' + SCut.Description);
      case SCut.showCmd of
        cwNormal: Memo1.Lines.Add('ShowCMD: Normal');
        cwMaximized: Memo1.Lines.Add('ShowCMD: Maximized');
        cwMinimized: Memo1.Lines.Add('ShowCMD: Minimized');
      end;
      Memo1.Lines.Add('Icon Path: ' + SCut.IconPath);
      Memo1.Lines.Add('Icon Index: ' + IntToStr(SCut.IconIndex));
      Memo1.Lines.Add('Shortcut: ' + ShortCutToText(Scut.HotKey.Hotkey));
      Image1.Picture.Assign(SCut.Icon);
    end;
end;