转dfw
我的程序,自己修改一下就可以了
Uses
  comobj,ShlObj,activex,FileCtrl//快捷方式(桌面,开始按钮)
//filename 文件名  filedesc 文件描述
Procedure MakeLink(Filename:string;FileDesc:string;leixing:integer);
var
  tmpObject : IUnknown;
  tmpSLink : IShellLink;
  tmpPFile : IPersistFile;
  PIDL : PItemIDList;
  StartupDirectory : array[0..MAX_PATH] of Char;
  LinkFilename : WideString;
  bianliang,Path:string;
begin
  bianliang:='\'+FileDesc+'.lnk';
  tmpObject := CreateComObject(CLSID_ShellLink);//创建建立快捷方式的外壳扩展
  tmpSLink := tmpObject as IShellLink;          //取得接口
  tmpPFile := tmpObject as IPersistFile;        //用来储存*.lnk文件的接口
  tmpSLink.SetPath(pChar(FileName));            //设定 filename 所在路径
  tmpSLink.SetWorkingDirectory(pChar(ExtractFilePath(FileName)));    //设定工作目录
//创建桌面快捷方式
  if leixing=1 then
    begin
      SHGetSpecialFolderLocation(0,CSIDL_DESKTOPDIRECTORY,PIDL);//获得桌面的Itemidlist
      Fillchar(startupdirectory,Max_Path+1,0);
      SHGetPathFromIDList(PIDL,StartupDirectory);               //获得路径
      LinkFilename := StartupDirectory + bianliang;
      WriteToUnstallFile(LinkFilename,2);
      tmpPFile.Save(pWChar(LinkFilename),FALSE);                //保存*.lnk文件
    End
  else
    begin
//创建开始按钮中的 program 快捷方式
      SHGetSpecialFolderLocation(0,  CSIDL_PROGRAMS,PIDL);      //获得开始按钮中的program的Itemidlist
      Fillchar(startupdirectory,Max_Path+1,0);
      SHGetPathFromIDList(PIDL,StartupDirectory);               //获得路径
      Path:=StartupDirectory+'\港澳资讯';
      If not DirectoryExists(Path) then
        begin
          MkDir(Path);
          WriteToUnstallFile(Path,1);
        end;
      Path:=Path+'\'+ChanPinName;
      If not DirectoryExists(path) then
        begin
          MkDir(Path);
          WriteToUnstallFile(Path,1);
        end;
      LinkFilename := path + bianliang;
      WriteToUnstallFile(LinkFilename,2);
      tmpPFile.Save(pWChar(LinkFilename),FALSE);                //保存*.lnk文件
    End;
end;