注册快捷方式

【 tulaoshi.com - 编程语言 】

　　
　　procedure CreateShortcut(FileName :string; Description :string;
　　  arguements :string; Location :ShortcutType);
　　var
　　  cObj :IUnknown;
　　  sLink :IShellLink;
　　  pFile :IPersistFile;
　　  sDir :string;
　　  lName :string;
　　  spath :string;
　　  wFileName :WideString;
　　  mReg :TRegistry;
　　  key :string;
　　  tmp :string;
　　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
　　    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_QUICKLAUNCH:
　　      begin
　　        sDir :=ReadString('AppData');
　　        sDir :=sDir + 'MicrosoftInternet ExplorerQuick Launch';
　　      end;
　　    end;

　　    //生成快捷方式文件名
　　    lName :=ChangeFileExt(FileName, '.Lnk');
　　    lName :=ExtractFileName(lName);
　　    if sDir'' then
　　    begin
　　      //生成快捷方式全路径名
　　      wFileName :=sDir + '' + lName;
　　      //保存生成的快捷方式文件
　　      pFile.Save(PWChar(wFileName), false);
　　    end;

　　    Free;
　　  end;
　　end;
　　上面声明了一个过程
　　下面应用它
　　var
　　  fName :string;
　　  fDesc :string;
　　  fArgu :string;
　　begin
　　  fName :=Application.ExeName;
　　  fDesc :='Delphi 7.0 创建的快捷方式－－桌面';
　　  fArgu :='无参数';
　　  CreateShortcut(fName,fDesc,fArgu, ST_DESKTOP);
　　end;
　　procedure TForm1.SpeedButton2Click(Sender: TObject);
　　var
　　  fName :string;
　　  fDesc :string;
　　  fArgu :string;
　　begin
　　  fName :=Application.ExeName;
　　  fDesc :='Delphi 7.0 创建的快捷方式－－发送到。。。';
　　  fArgu :='无参数';
　　  CreateShortcut(fName,fDesc,fArgu, ST_SENDTO);
　　end;

　　procedure TForm1.SpeedButton3Click(Sender: TObject);
　　var
　　  fName :string;
　　  fDesc :string;
　　  fArgu :string;
　　begin
　　  fName :=Application.ExeName;
　　  fDesc :='Delphi 7.0 创建的快捷方式－－开始菜单';
　　  fArgu :='无参数';
　　  CreateShortcut(fName,fDesc,fArgu, ST_STARTMENU);

　　end;

　　procedure TForm1.SpeedButton4Click(Sender: TObject);
　　var
　　  fName :string;
　　  fDesc :string;
　　  fArgu :string;
　　begin
　　  fName :=Application.ExeName;
　　  fDesc :='Delphi 7.0 创建的快捷方式－－快速启动';
　　  fArgu :='无参数';
　　  CreateShortcut(fName,fDesc,fArgu, ST_QUICKLAUNCH);
　　end;

　　procedure TForm1.SpeedButton5Click(Sender: TObject);
　　var
　　  sName :string;
　　  sAddress :string;
　　begin
　　  sName :='P哥网';
　　  sAddress :='http://www.pggpjj.com';
　　  CreateInternetShortcut(sName, sAddress);
　　end;