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

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