Автор: Xavier Pacheco

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 = '\Software\Microsoft\Windows\CurrentVersion\' +
   'Explorer\Shell 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\notepad.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.