么意思博客

自己写的程序，有时需要去迎合用户。我们不得不做些改变，使用户使用我们的软件更加方便。 下面就是创建快捷方式的代 […]

自己写的程序，有时需要去迎合用户。我们不得不做些改变，使用户使用我们的软件更加方便。
下面就是创建快捷方式的代码：

uses ShlObj, ActiveX, ComObj;

function CreateShortcut(Exe:string; Lnk:string = ''; Dir:string = ''; ID:Integer = -1):Boolean;
var
IObj: IUnknown;
ILnk: IShellLink;
IPFile: IPersistFile;
PIDL: PItemIDList;
InFolder: array[0..MAX_PATH] of Char;
LinkFileName: WideString;
begin
Result := False;
if not FileExists(Exe) then Exit;
if Lnk = '' then Lnk := ChangeFileExt(ExtractFileName(Exe), '');
IObj := CreateComObject(CLSID_ShellLink);
ILnk := IObj as IShellLink;
ILnk.SetPath(PChar(Exe));
ILnk.SetWorkingDirectory(PChar(ExtractFilePath(Exe)));
if (Dir = '') and (ID = -1) then ID := CSIDL_DESKTOP;
if ID > -1 then
begin
SHGetSpecialFolderLocation(0, ID, PIDL);
SHGetPathFromIDList(PIDL, InFolder);
LinkFileName := Format('%s\%s.lnk', [InFolder, Lnk]);
end else
begin
Dir := ExcludeTrailingPathDelimiter(Dir);
if not DirectoryExists(Dir) then Exit;
LinkFileName := Format('%s\%s.lnk', [Dir, Lnk]);
end;
IPFile := IObj as IPersistFile;
if IPFile.Save(PWideChar(LinkFileName), False) = 0 then Result := True;
end; {CreateShortcut 函数结束}

使用方法：

{测试 1: 把当前程序在桌面上建立快捷方式} 
procedure TForm1.Button1Click(Sender: TObject); 
begin 
CreateShortcut(Application.ExeName); 
end; 

{测试 2: 在桌面上建立快捷方式, 同时指定快捷方式名称} 
procedure TForm1.Button2Click(Sender: TObject); 
begin 
CreateShortcut(Application.ExeName, 'NewLinkName'); 
end; 

{测试 3: 在 C:\ 下建立快捷方式} 
procedure TForm1.Button3Click(Sender: TObject); 
begin 
CreateShortcut(Application.ExeName, '', 'C:\'); 
end; 

{测试 3: 在开始菜单的程序文件夹下建立快捷方式} 
procedure TForm1.Button4Click(Sender: TObject); 
begin 
CreateShortcut(Application.ExeName, '', '', CSIDL_PROGRAMS); 
end;