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

{=================================================================


功 能:


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


参 数:


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;