建立 桌面、發送到...、快速啓動欄、開始菜單、程序菜單、右鍵菜單 快捷方式

{================= ================== ================== ============
    功    能:
            建立 桌面、發送到...、快速啓動欄、開始菜單、程序菜單、右鍵菜單 快捷方式
    參     數:
            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;