在桌面上自动创建快捷方式

usesShellAPI,ShlObj,ActiveX,ComObj;

const
CCH_MAXNAME=255;
LNK_RUN_MIN=7;
LNK_RUN_MAX=3;
LNK_RUN_NORMAL=1;
type
LINK_FILE_INFO=record
FileName: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;
var
anobj:IUnknown;
shlink:IShellLink;
pFile:IPersistFile;
wFileName:widestring;
begin
wFileName:=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);
ifDestFileName=''then
wFileName:=ChangeFileExt(info.FileName,'lnk');
result:=succeeded(pFile.Save(pwchar(wFileName),false));
end;

procedureTForm1.Button1Click(Sender:TObject);
var
rLnk:LINK_FILE_INFO;
pidl:pItemIDList;
pDesktop:string;
begin
rLnk.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;