unit Unit1;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
activex, comobj, shlobj, StdCtrls;
type
TForm1 = class(TForm)
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
function CreateLink(lpszPathObj,lpszPathLink,
lpszDesc: string):Boolean;
var
psl: IShellLink;
ppf: IPersistFile;
const
IID_IPersistFile:
TGUID = (D1:$0000010B;
D2:$0000;
D3:$0000;
D4:($C0,$00,$00,$00,$00,$00,$00,$46));
begin
result := False;
if SUCCEEDED(CoCreateInstance(CLSID_ShellLink,
nil,
CLSCTX_INPROC_SERVER,
IID_IShellLinkA,
psl)) then
begin
psl.SetPath(PChar(lpszPathObj));
psl.SetDescription(PChar(lpszDesc));
if SUCCEEDED(psl.QueryInterface(IID_IPersistFile,
ppf)) then
begin
ppf.Save(StringToOLEStr(lpszPathLink),TRUE);
Result := true;
ppf._Release; //---> Runtime-Error wenn aktiv
end;
end;
psl._Release; // ---> Runtime-Error wenn aktiv
end;
//Aufruf:
if CreateLink('d:\Datei.exe', 'c:\Verknüpfung.exe', 'Verknüpfung') then
MessageDlg('Verknüpfung angelegt', mtInformation, [mbOk], 0);
end.