Создать ярлык на рабочем столе

unit
 Main;

interface


uses

  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls;

type

  TForm1 = class
(TForm)
    Button1: TButton;
    Label1: TLabel;
    procedure
 Button1Click(Sender: TObject);
  private

    { Private declarations }
  public

    { Public declarations }
  end
;

var

  Form1: TForm1;

implementation


{$R *.DFM}

uses
 ComObj, ActiveX, ShlObj, Registry;

const

  { Registry key where Folder information is kept }
  SFolderKey = 'SoftwareMicrosoftWindowsCurrentVersion' +
    'ExplorerShell Folders';

function
 GetFolderLocation(const
 FolderType: string
): string
;
{ Retrieves from registry path to folder indicated in FolderType }
begin

  with
 TRegistry.Create do

  try

    RootKey := HKEY_CURRENT_USER;
    if
 not
 OpenKey(SFolderKey, False) then

      { open key where shell folder information is kept. }
      raise
 ERegistryException.CreateFmt('Folder key "%s" not found',
        [SFolderKey]);
    { Get path for specified folder }
    Result := ReadString(FolderType);
    if
 Result = '' then

      raise
 ERegistryException.CreateFmt('"%s" item not found in registry',
        [FolderType]);
    CloseKey;
  finally

    Free;
  end
;
end
;

procedure
 MakeNotepad;
const

  // NOTE: Assumed location for Notepad:
  AppName = 'c:windows
otepad.exe';
var

  SL: IShellLink;
  PF: IPersistFile;
  LnkName: WideString;
begin

  OleCheck(CoCreateInstance(CLSID_ShellLink, nil
, CLSCTX_INPROC_SERVER,
    IShellLink, SL));
  { IShellLink implementers are required to implement IPersistFile }
  PF := SL as
 IPersistFile;
  OleCheck(SL.SetPath(PChar(AppName))); // set link path to proper file
  { create a path location and filename for link file }
  LnkName := GetFolderLocation('Desktop') + '' +
    ChangeFileExt(ExtractFileName(AppName), '.lnk');
  PF.Save(PWideChar(LnkName), True); // save link file
end
;

procedure
 TForm1.Button1Click(Sender: TObject);
begin

  MakeNotepad;
end
;

end
.

Другое по теме:

• Создать ярлык объекта в любой папке
• Создание ярлыков на рабочем столе, старт меню, панели быстрого запуска
• Создание hardlink и symbolic link