uses
  ...Registry, ShlObj, ActiveX, ComObj, FileUtil;

......

function CreateShortcut(const ShortcutDir, CmdLine, Param, WorkDir,DirName: string;
   LinkFile:String): Boolean;
var
  MyObject  : IUnknown;

  MySLink   : IShellLink;
  MyPFile   : IPersistFile;
  WideFile  : WideString;
  Directory, TempStr: String;
  Reg:TRegistry;
begin
  Result:=False;Directory:='';
  If (ShortcutDir='Desktop') or (ShortcutDir='Favorites') or
     (ShortcutDir='Programs') or (ShortcutDir='SendTo') or
     (ShortcutDir='Start Menu') or (ShortcutDir='Startup') then
    begin
      Reg:=TRegistry.Create;
      Reg.OpenKey('Software\MicroSoft\Windows\CurrentVersion\Explorer\Shell 
Folders',False);

      Directory := Reg.ReadString(ShortcutDir);
      Reg.Free;
      If not(DirName='') then
        Directory:=Directory+'\'+DirName;
    end;
  If DirExists(ShortcutDir)  then
    Directory:=ShortcutDir
  else
    If Directory='' then  Exit;
  If not(FileExists(CmdLine)) and not
(DirExists(CmdLine)) then Exit;
  If linkFile='' then Exit;
  TempStr:=linkFile;

  If Length(linkFile)> 4  then
    Delete(TempStr, 1 ,Length(TempStr)- 3 );
  If not(AnsiUpperCase(TempStr)='LNK') then
    linkFile:=linkFile+'.lnk';
  MyObject := CreateComObject(CLSID_ShellLink);
  MySLink := MyObject as IShellLink;
  MyPFile := MyObject as IPersistFile;
  with MySLink do
    begin
      SetPath(PChar(CmdLine));
      SetArguments(PChar(Param));
      SetWorkingDirectory(PChar(WorkDir));
    end;

  if Directory[Length(Directory)]='\' then
    WideFile := Directory+LinkFile
  else
    WideFile := Directory+'\'+LinkFile;
  if MyPFile.Save(PWChar(WideFile), False)= S_OK then
    Result:=True;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  s:=ExtractFilePath(Edit1.Text);
  Delete(s,Length(s), 1 );
  CreateShortcut( 'Programs', 'C:\my.txt', '', 'C:\', '', 'my');
end;