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

Posted 2020-06-18 朝闻道

{=================================================================
功 能:
创建 桌面、发送到...、快速启动栏、开始菜单、程序菜单、右键菜单 快捷方式
参 数:
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;

 http://www.cnblogs.com/shangdawei/p/4518740.html