怎么样用Delphi创建快捷方式

答案：
procedure CreateLink(ProgramPath, ProgramArg, LinkPath, Descr: String); var AnObj: IUnknown; ShellLink: IShellLink; AFile: IPersistFile; FileName: WideString; begin if UpperCase(ExtractFileExt(LinkPath)) 〈〉 ′.LNK′ then //检查扩展名是否正确 begin raise Exception.Create(′快捷方式的扩展名必须是 ′′LNK′′!′);/ /若不是则产生异常 end; try OleInitialize(nil);//初始化OLE库，在使用OLE函数前必须调用初始化 AnObj := CreateComObject(CLSID—ShellLink);//根据给定的ClassID生成 一个COM对象，此处是快捷方式 ShellLink := AnObj as IShellLink;//强制转换为快捷方式接口 AFile := AnObj as IPersistFile;//强制转换为文件接口 //设置快捷方式属性，此处只设置了几个常用的属性 ShellLink.SetPath(PChar(ProgramPath)); // 快捷方式的目标文件，一般 为可执行文件 ShellLink.SetArguments(PChar(ProgramArg));// 目标文件参数 ShellLink.SetWorkingDirectory(PChar(ExtractFilePath(ProgramPath))) ;//目标文件的工作目录 ShellLink.SetDescription(PChar(Descr));// 对目标文件的描述 FileName := LinkPath;//把文件名转换为WideString类型 AFile.Save(PWChar(FileName), False);//保存快捷方式 finally OleUninitialize;//关闭OLE库，此函数必须与OleInitialize成对调用 end; end; 以上编写了一个通用函数，下面我们用它来创建快捷方式。在窗体中放置一 个按钮，双击按钮写入如下代码即可： procedure TForm1.Button1Click(Sender: TObject); var tmp: array [0..MAX—PATH] of Char; WinDir: string; begin GetWindowsDirectory(tmp,MAX—PATH); WinDir:=String(tmp); if Length(WinDir) 〉 3 then WinDir:=WinDir+′\′;//得到Windows的目录 //在桌面上放置本程序的快捷方式 CreateLink(ParamStr(0),′′,WinDir+′desktop\′+Application.Tit le+′.lnk′,′Application.Title′); end;
procedure   Tmainfrm.N30Click(Sender:   TObject);   
  var   
      MyObject   :   IUnknown;   
      MySLink   :   IShellLink;   
      MyPFile   :   IPersistFile;   
      FileName   :   String;   
      Directory   :   String;   
      WFileName   :   WideString;   
      MyReg   :   TRegIniFile;   
  begin   
      MyObject   :=   CreateComObject(CLSID_ShellLink);   
      MySLink   :=   MyObject   as   IShellLink;   
      MyPFile   :=   MyObject   as   IPersistFile;   
      FileName   :=   paramstr(0);   
      with   MySLink   do   begin   
          SetPath(pchar(FileName));           //   1999.4.9,   as   bug   before!   
          SetHotkey(vk_F11);   
          SetWorkingDirectory(PChar(ExtractFilePath(FileName)));   
      end;   
      MyReg   :=   TRegIniFile.Create(   
                  'Software\MicroSoft\Windows\CurrentVersion\Explorer');   
            //   在桌面上生成快捷图标   
      Directory   :=   MyReg.ReadString('Shell   Folders','Desktop','');   
          //   在Start   Menu中加入相应的ShortCut   
        {   1:Directory   :=   MyReg.ReadString('Shell   Folders','Start   Menu','');   
          //   在'发送到'中加入相应的ShortCut   
          2:Directory   :=   MyReg.ReadString('Shell   Folders','SendTo','');   
      end;     }   
    
      WFileName   :=   Directory+'\中鑫工资管理系统   2003.lnk';   
      MyPFile.Save(PWChar(WFileName),False);   
      MyReg.free;   
      application.messagebox('成功的创建！！！','消息框',mb_ok+mb_iconinformation);   
  end;
Top
//上边的是在开始菜单，下边倒桌面:   
  procedure   Tmainfrm.M2Click(Sender:   TObject);   
  var   
      MyObject   :   IUnknown;   
      MySLink   :   IShellLink;   
      MyPFile   :   IPersistFile;   
      FileName   :   String;   
      Directory   :   String;   
      WFileName   :   WideString;   
      MyReg   :   TRegIniFile;   
  begin   
      MyObject   :=   CreateComObject(CLSID_ShellLink);   
      MySLink   :=   MyObject   as   IShellLink;   
      MyPFile   :=   MyObject   as   IPersistFile;   
      FileName   :=   paramstr(0);   
      with   MySLink   do   begin   
          SetPath(pchar(FileName));           //   1999.4.9,   as   bug   before!   
          SetHotkey(vk_F11);   
          SetWorkingDirectory(PChar(ExtractFilePath(FileName)));   
      end;   
      MyReg   :=   TRegIniFile.Create(   
                  'Software\MicroSoft\Windows\CurrentVersion\Explorer');   
            //   在桌面上生成快捷图标   
      //Directory   :=   MyReg.ReadString('Shell   Folders','Desktop','');   
          //   在Start   Menu中加入相应的ShortCut   
        Directory   :=   MyReg.ReadString('Shell   Folders','Start   Menu','');   
          //   在'发送到'中加入相应的ShortCut   
      {     2:Directory   :=   MyReg.ReadString('Shell   Folders','SendTo','');   
      end;     }   
    
      WFileName   :=   Directory+'\中鑫工资管理系统   2003.lnk';   
      MyPFile.Save(PWChar(WFileName),False);   
      MyReg.free;   
      application.messagebox('成功的创建！！！','消息框',mb_ok+mb_iconinformation);   
  end;   

上一个：用delphi编写乘法口诀表
下一个：关于delphi的几个问题