uses ShellAPI
,
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] of char;
WorkDirectory : array[ 0 .. MAX_PATH] of char;
IconLocation : array[ 0 .. MAX_PATH] of char;
IconIndex : integer;
Arguments : array[ 0 .. MAX_PATH] of char;
Description : array[ 0 .. CCH_MAXNAME] of char;
ItemIDList : PItemIDList;
RelativePath : array[ 0 .. 255 ] of char;
ShowState : integer;
HotKey : word;
end;
function CreateLinkFile(const info : LINK_FILE_INFO;const DestFileName : string = '' ) : boolean;
var
anobj : IUnknown;
shlink : IShellLink;
pFile : IPersistFile;
wFileName : widestring;
begin
wFileName := destfilename;
anobj := CreateComObject(CLSID_SHELLLINK);
shlink := anobj as IShellLink;
pFile := anobj as IPersistFile;
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] of char;
WorkDirectory : array[ 0 .. MAX_PATH] of char;
IconLocation : array[ 0 .. MAX_PATH] of char;
IconIndex : integer;
Arguments : array[ 0 .. MAX_PATH] of char;
Description : array[ 0 .. CCH_MAXNAME] of char;
ItemIDList : PItemIDList;
RelativePath : array[ 0 .. 255 ] of char;
ShowState : integer;
HotKey : word;
end;
function CreateLinkFile(const info : LINK_FILE_INFO;const DestFileName : string = '' ) : boolean;
var
anobj : IUnknown;
shlink : IShellLink;
pFile : IPersistFile;
wFileName : widestring;
begin
wFileName := destfilename;
anobj := CreateComObject(CLSID_SHELLLINK);
shlink := anobj as IShellLink;
pFile := anobj as IPersistFile;
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;
procedure TForm1.Button1Click(Sender: TObject);
var
rLnk : LINK_FILE_INFO;
pidl:pItemIDList;
pDesktop : string ;
begin
rLnk.FileName : = ' C:Program FilesInternet ExplorerIEXPLORE.EXE ' ;
rLnk.WorkDirectory : = ' C:Program FilesInternet Explorer';
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:Program FilesInternet ExplorerIEXPLORE.EXE ' ;
rLnk.WorkDirectory : = ' C:Program FilesInternet Explorer';
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;