1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:

function CreateLink(const AFilename, ALNKFilename, ADescription, AArgument: string) : Boolean;
var
  psl : IShellLink;
  ppf : IPersistFile;
  wsz : PWideChar;
begin
  result:=false;
  if SUCCEEDED(CoCreateInstance(CLSID_ShellLink, nil,
  CLSCTX_inPROC_SERVER, IID_IShellLinkA, psl)) then
  begin
    psl.SetPath(PChar(AFilename));
    psl.SetDescription(PChar(ADescription));
    psl.SetWorkingDirectory(PChar(ExtractFilePath(AFilename)));
    psl.SetArguments(PChar(AArgument));
    if SUCCEEDED(psl.QueryInterface(IPersistFile, ppf)) then
    begin
      GetMem(wsz, MAX_PATH*2);
      try
        MultiByteToWideChar(CP_ACP, 0, PChar(ALNKFilename), -1, wsz, MAX_PATH);
        ppf.Save(wsz, true);
        result:=true;
      finally
        FreeMem(wsz, MAX_PATH*2);
      end;
    end;
  end;
end;					

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:

procedure TForm1.OnCreate(Sender: TObject);
var
  i: Integer;
begin
  for i := 0 to ParamCount -1 do
  begin
    if ParamStr(i) = '-deinParameter' then
      Button.Click;
  end;
end;					

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:

function TMPopup.CreateDesktopLink(strArgument : String;strName : String) : Boolean;

const
  IID_IPersistFile: TGUID = '{0000010b-0000-0000-C000-000000000046}';

var
  slShellLink    : IShellLink;   // ShellLink Interface
  pfPersistFile  : IPersistFile; // Shortcut (Link) Permanent speichern
  wszShortCut    : PWideChar;    // Buffer für den Shortcutnamen
  hRes           : HResult;      // Für Zwischenergebnisse
  sShortCut      : string;       // So heisst dann der Shortcut
  dwLen          : DWORD;
  strIconPath    : Widestring;
  pszIcon        : PChar;

begin
  Result := false;
  // COM Object der Klasse ShellLink erzeugen
  hRes := CoCreateInstance(CLSID_ShellLink,      // ID von ShellLink (Typ TGUID)
                           nil,
                           CLSCTX_INPROC_SERVER,
                           IID_IShellLinkA,      // Referenz auf die Funktion
                           slShellLink);         // Pointer auf IShellLink Interface
  if hRes <> S_OK then
  begin
    exit;
  end;
  slShellLink.SetPath(PChar(Paramstr(0)));
  slShellLink.SetArguments(Pchar(strArgument));
  strIconPath :=  ExtractFilePath(Paramstr(0))+'fluid-bit.ico';

  if fileExists(striconPath) then
  Begin
    pszIcon := strAlloc(MAX_PATH);
    try
      strpCopy(pszIcon,strIconPath);
      slShellLink.SetIconLocation(pszIcon,0);
    finally
      strDispose(PszIcon);
    end;
  end;
                           // Auf diese Datei geht der Link
  hRes := slShellLink.QueryInterface(IID_IPersistFile,pfPersistFile); // Pointer auf IPersist holen
  if hRes <> S_OK then
  begin
    exit;
  end;
  dwLen := (MAX_PATH+1)*2;
  wszShortcut := AllocMem(dwLen);
  try
    sShortCut := ChangeFileExt(strName,'.LNK');
    sShortCut := szDesktopFolder + '\' + ExtractFileName(sShortCut);
    StringToWideChar(sShortCut,wszShortCut,dwLen);
    hRes := pfPersistFile.Save(wszShortCut, TRUE); // Jetzt noch den Link speichern
  finally
    FreeMem(wszShortCut,dwLen);   // und den Platz wieder freigeben
  end;
  Result := (hRes = S_OK);
end;