unit Unit1;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
activex, comobj, shlobj, StdCtrls;
type
TForm1 =
class(TForm)
Button1: TButton;
procedure Button1Click(Sender: TObject);
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:
procedure TForm1.Button1Click(Sender: TObject);
begin
if CreateLink('
C:\Programme\Borland\Delphi6\Projects\system\winxpbeenden\ausschalten.exe', '
C:\projekt_verknüpfung.exe', '
Verknüpfung')
then
MessageDlg('
Verknüpfung angelegt', mtInformation, [mbOk], 0);
end;
end.