// Shows how to create Shell Link
unit SL_Unit;
interface
uses
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
OLE2, ShlObj, StdCtrls;
type
TForm1 = class(TForm)
Button1: TButton;
Edit1: TEdit;
procedure Button1Click(Sender: TObject);
procedure Abort(Text : String);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.DFM}
procedure TForm1.Button1Click(Sender: TObject);
var
sPath : Array[0..MAX_PATH] of Char;
Path : String;
HRes : HRESULT; // OLE-Operation Result
SL : IShellLink; // Interface for ShellLink
PF : IPersistFile; // Interface for PersistentFile
begin
GetWindowsDirectory(sPath, MAX_PATH);
Path := StrPas(sPath);
Path := Path + '\DESKTOP\';
Edit1.Text := Path;
CoInitialize(Nil);
HRes := COCreateInstance(CLSID_ShellLink, Nil, CLSCTX_INPROC_SERVER,
IID_IShellLink, SL);
If Succeeded(HRes) Then
Begin
HRes := SL.QueryInterface(IID_IPersistFile, PF);
If Succeeded(HRes) Then
Begin
HRes := SL.SetPath('d:\windows\notepad.exe');
If Not(Succeeded(HRes)) Then Abort('Error ShellLink.SetPath');
HRes := SL.SetArguments('c:\autoexec.bat');
If Not(Succeeded(HRes)) Then Abort('Error ShellLink.SetArguments');
HRes := SL.SetDescription('Shell Link Demo');
If Not(Succeeded(HRes)) Then Abort ('Error ShellLink.SetDesc');
HRes := PF.Save('d:\windows\desktop\linkdemo.lnk', True);
If Not(Succeeded(HRes)) Then Abort('Error PersistFile.Save');
PF.Release;
SL.Release;
End Else Abort('Error PersistFile');
End Else Abort('Error ShellLink');
end;
procedure TForm1.Abort;
begin
MessageDlg(Text, mtError, [mbOk], 0);
Close;
end;
end.
|