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 );
if DestFileName = '' then
wFileName := ChangeFileExt(info . FileName , ' lnk ' );
result := succeeded(pFile . Save(pwchar(wFileName) , false));
end;
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 );
if DestFileName = '' 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;
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;