usesShellAPI , ShlObj , ActiveX , ComObj;constCCH_MAXNAME = 255 ;LNK_RUN_MIN = 7 ;LNK_RUN_MAX = 3 ;LNK_RUN_NORMAL = 1 ;typeLINK_FILE_INFO = recordFileName : array[ 0 .. MAX_PATH]ofchar;WorkDirectory : array[ 0 .. MAX_PATH]ofchar;IconLocation : array[ 0 .. MAX_PATH]ofchar;IconIndex : integer;Arguments : array[ 0 .. MAX_PATH]ofchar;Description : array[ 0 .. CCH_MAXNAME]ofchar;ItemIDList : PItemIDList;RelativePath : array[ 0 .. 255 ]ofchar;ShowState : integer;HotKey : word;end;functionCreateLinkFile(constinfo : LINK_FILE_INFO;constDestFileName : string = '' ) : boolean;varanobj : IUnknown;shlink : IShellLink;pFile : IPersistFile;wFileName : widestring;beginwFileName := destfilename;anobj := CreateComObject(CLSID_SHELLLINK);shlink := anobjasIShellLink;pFile := anobjasIPersistFile;shlink . SetPath(info . FileName);shlink . SetWorkingDirectory(info . WorkDirectory);shlink . SetDescription(info . Description);shlink . SetArguments(info . Arguments);shlink . SetIconLocation(info . IconLocation , info . IconIndex);shlink . SetHotkey(info . HotKey);shlink . SetShowCmd(info . ShowState);shlink . SetRelativePath(info . RelativePath , 0 ); if DestFileName = '' thenwFileName := ChangeFileExt(info . FileName , ' lnk ' );result := succeeded(pFile . Save(pwchar(wFileName) , false));end; procedureTForm1.Button1Click(Sender:TObject);varrLnk:LINK_FILE_INFO;pidl:pItemIDList;pDesktop: string ;beginrLnk.FileName: = ' C:ProgramFilesInternetExplorerIEXPLORE.EXE ' ;rLnk.WorkDirectory: = ' C:ProgramFilesInternetExplorer'; rLnk.IconIndex: = 0 ; // 取桌面路径 SetLength(pDesktop, 255 );SHGetSpecialFolderLocation(Self.Handle,CSIDL_DESKTOP,pidl);SHGetPathFromIDList(pidl,PChar(pDesktop));SetLength(pDesktop,StrLen(PChar(pDesktop)));CreateLinkFile(rLnk,pDesktop + ' '+ ' I.lnk ' ); end;