Delphi -- 创建 桌面、发送到...、快速启动栏、开始菜单、程序菜单、右键菜 单

{=================================================================
功 能:
创建 桌面、发送到...、快速启动栏、开始菜单、程序菜单、右键菜单 快捷方式
参 数:
FileName : 快捷方式执行文件名
Description : 快捷方式描述信息
Arguements : 快捷方式执行参数
ShowName : 快捷方式显示名称
Location : 快捷方式类别
id : 需设置状态的队列号(255 为设置)
CreateOrDelete: 是创建还是删除(默认为创建 true)
返 回 值: 无
备 注:
需要引用 Registry, ShlObj, ComObj, ActiveX, RegStr 单元
=================================================================}

procedure TMainForm.CreateShortcut(FileName,Description,Arguements,ShowName:
string?
Location: ShortcutType? id: byte? CreateOrDelete: boolean=true)?
var
cObj :IUnknown?
sLink :IShellLink?
pFile :IPersistFile?
sDir,spath,key,tmp :string?
wFileName :WideString?
mReg :TRegistry?
begin
cObj :=CreateComObject(CLSID_ShellLink)? //创建COM对象
sLink :=cObj as IShellLink? //COM对象转化为IShellLink型接口
pFile :=cObj as IPersistFile? //COM对象转化为IPersistFile型接口
//获取路径
sPath :=ExtractFilePath(FileName)?
with sLink do begin
SetPath(PChar(FileName))? //设置执行文件名
SetArguments(PChar(arguements))? //设置执行参数
SetDescription(Pchar(Description))? //设置描述信息
SetWorkingDirectory(PChar(sPath))? //设置工作路径，即执行程序所在目录
end?
//获取各快捷方式的实际目录
mReg :=TRegistry.Create?
with mReg do begin
if Location=ST_CONTEXT then //添加右键菜单
begin
RootKey :=HKEY_CLASSES_ROOT?
tmp:= ‘*shell‘+ShowName?
if CreateOrDelete then
begin
if OpenKey(tmp,true) then
begin
//用writestring将设置值写入打开的主键
WriteString(‘‘,ShowName+‘(&k)‘)?
CloseKey?
end?
if OpenKey(tmp+‘command‘,true) then
begin
//command子键的内容是点击右键后选择相应项后要运行的程序；
//%1是在单击右键时选中的文件名
//WriteString(,‘c:delphimyprogram.exe+"%1"‘)?
WriteString(‘‘,FileName)?
CloseKey?
end?
end
else
DeleteKey(tmp)?
Free?
exit?
end?
RootKey :=HKEY_CURRENT_USER?
key :=REGSTR_PATH_EXPLORER? //Delphi在单元RegStr中定义的常量
tmp :=key + ‘Shell Folders‘?
OpenKey(tmp, false)?
case Location of
ST_DESKTOP: sDir :=ReadString(‘Desktop‘)?
ST_SENDTO: sDir :=ReadString(‘SendTo‘)?
ST_STARTMENU: sDir :=ReadString(‘Start Menu‘)?
ST_PROGRAMS: sDir :=ReadString(‘Programs‘)?
ST_QUICKLAUNCH:
begin
sDir :=ReadString(‘AppData‘)?
sDir :=sDir + ‘MicrosoftInternet ExplorerQuick Launch‘?
end?
end?
//生成快捷方式文件名
if ShowName=‘‘ then
begin
ShowName :=ChangeFileExt(FileName, ‘.Lnk‘)?
ShowName :=ExtractFileName(ShowName)?
end
else
ShowName:= ShowName+‘.lnk‘?
if sDir<>‘‘ then
begin
//生成快捷方式全路径名
wFileName :=sDir + ‘‘ + ShowName?
if (id<255) then
begin
if FileExists(wFileName) then
//RzCheckGroup1.ItemChecked[id]:= true?
end
else
//保存或删除生成的快捷方式文件
if CreateOrDelete then
pFile.Save(PWChar(wFileName), false)
else
DeleteFile(wFileName)?
end?
Free?
end?
end?