个快捷方式图标。但是这个自动创建桌面快捷方式的在程序中是如
何实现的呢?众所周知 在windows中要给应用程序创建一个快捷方
式 只需要你右键单击 其应用程序的图标 然后 点击创建快捷方式
,将其快捷方式 复制到桌面上就可以了。但是在程序中用代码实现
这个功能就没有那么容易了。在delphi中是如何实现这个功能呢?
在delphi中API函数为我们提供了一个叫做IShellLink的COM接口
允许我们创建快捷方式。为在桌面创建快捷方式,我们先创建一个
IShellLink对象,设置它的属性,然后把这个link保存到desktop
目录就行了。具体代码如下:首先我们创建一个过程,然后只需要
在Formcreate事件里调用这个函数就可以了
procedure CreateUlr;
...............................
procedure TFrmMain.CreateUlr;
var
ShLink: IShellLink;
PFile: IPersistFile;
FileName: string;
WFileName: WideString;
Reg: TRegIniFile;
AnObj: IUnknown;
begin
AnObj := CreateComObject(CLSID_ShellLink); //快捷方式的初始化
ShLink := AnObj as IShellLink;
PFile := AnObj as IPersistFile;
FileName := ParamStr(0);
ShLink.SetPath(PChar(FileName));
ShLink.SetWorkingDirectory(PChar(ExtractFilePath(FileName)));
ShLink.SetDescription('软件描述');//这个描述就是 当你单击右键
察看备注里的内容
Reg := TRegIniFile.Create('Software/MicroSoft/Windows/
CurrentVersion/Explorer');
WFileName := Reg.ReadString('Shell Folders', 'Desktop', '') +
'' + '软件名称' + '.lnk';
Reg.Free;
PFile.Save(PWChar(WFileName), False);
end;
因为要调用Api函数而且还涉及到注册表编成 ,所以还要引用 如下单元
‘shlObj’‘comObj’‘ActiveX’‘Registry’....
uses ActiveX,ComObj,StdCtrls,ShlObj,FileCtrl;
procedure TForm1.N2Click(Sender: TObject);
var
tmpObject : IUnknown;
tmpSLink : IShellLink;
tmpPFile : IPersistFile;
PIDL : PItemIDList;
StartupDirectory : array[0..MAX_PATH] of Char;
StartupFilename : String;
LinkFilename : WideString;
begin
//创建快捷方式到桌面
StartupFilename :=Application.ExeName;
tmpObject := CreateComObject(CLSID_ShellLink);//创建建立快捷方式的外壳扩展
tmpSLink := tmpObject as IShellLink;//取得接口
tmpPFile := tmpObject as IPersistFile;//用来储存*.lnk文件的接口
tmpSLink.SetPath(pChar(StartupFilename));//设定所在路径
tmpSLink.SetWorkingDirectory(pChar(ExtractFilePath(StartupFilename)));//设定工作目录
SHGetSpecialFolderLocation(0,CSIDL_DESKTOPDIRECTORY,PIDL);//获得桌面的Itemidlist
tmpSLink.SetDescription(’我的程序的描述);
tmpSLink.SetIconLocation(Pchar(StartupFilename),0);
SHGetPathFromIDList(PIDL,StartupDirectory);//获得桌面路径
LinkFilename := StartupDirectory + ’\我的程序.lnk’;
tmpPFile.Save(pWChar(LinkFilename),FALSE);//保存*.lnk文件
end;