proceudre TForm1.Button1Click(Sender:TObject);
var
AnObj:IUnknown;
ShLink:IShellLink;
PFile:IPersistFile;
FileName:String;
WFileName:WideString;
begin
//access the two interface of the object
AnObj:=CreateComObject(CLSID_ShellLink);
ShLink:=AnObj as IShellLink;
PFile:=AnObj as IPersistFile;
//get the name of the application file
FileName:=ParamStr(0);
//set the link properties
ShLink.SetPath(PChar(FileName));
ShLink.SetWorkingDirectory(PChar(ExtractFilePath(FileName)));
//save the file,using a WideString!
WFileName:=ExtractFilePath(FileName)+Edit1.Text+'.lnk';//将快捷方式文件保存在本程序所在目录
PFile.Save(PWChar(WFileName),False);
end;
////////////////////////////////////////////////////////////////////////////////
// - Tip 9 - Create a shortcut link on the desktop
//
// (sample call)
//
///////////////////////////////////////////////////////////////////////////////
procedure TMain.CreateLinkBtnClick(Sender: TObject);
const
ksAppName = 'c:\Win95\Notepad.exe' ;
ksCmdLineArgs = 'c:\Borland\Delphi3\Readme.txt' ;
ksLinkFilename = 'c:\temp\Delphix.lnk' ;
ksLinkDesc = 'My Cool Link' ;
var
bResult : boolean ;
begin
bResult := CreateLink( ksAppName, // App Name
ksCmdLineArgs, // Cmd line
ksLinkFilename, // link name
ksLinkDesc // Description
) ;
if ( bResult = false ) then
ShowMessage ('Error Creating the Link' ) ;
end;
////////////////////////////////////////////////////////////////////////////////
// Tip 10 - actual code which implements creating link.
// - Notes: IUnknown, IShellLink and IPersistFile are documented in
// the ShlObj unit.
//
////////////////////////////////////////////////////////////////////////////////
function CreateLink( AsAppName : String ; AsCmdLine : string ;
AsShortcutName : string ;
AsDescription : string ) : boolean ;
const
ksExplorerKey = 'Software\MicroSoft\Windows\CurrentVersion\Explorer' ;
var
IfUnknown : IUnknown ;
IfShellLnk : IShellLink ;
IfPersistFile : IPersistFile ;
sFileName : String ;
sFilePath : string ;
sLnkExt : string ;
sDirectory : String ;
WsFileName : WideString ;
Reg : TRegIniFile ;
begin
result := true ;
// create a com object
IfUnknown := CreateComObject(CLSID_ShellLink);
// cast the IUnknown interface to a IShellLink
IfShellLnk := IfUnknown as IShellLink;
// cast the IUnknown interface to a IPersistFile
IfPersistFile := IfUnknown as IPersistFile;
// using the Interface to the Shell link call some of
// it's methods.
with IfShellLnk do
begin
setArguments( PChar(AsCmdLine) ) ;
setPath( PChar(sFileName) ) ;
setWorkingDirectory( PChar(sFilePath) ) ;
// setDescription( PChar(AsDescription) ) ;
end ;
// we need to know where the desktop is located. Although you
// can simply 'hardcode' this. On another users machine it might
// not be the same. If you use profiles, the desktop might be
// located somewhere else... so we'll trust the registry to
// tell us.
Reg := TRegIniFile.Create( ksExplorerKey ) ;
sDirectory := Reg.ReadString('Shell Folders','Desktop','');
// a wide character is required
sLnkExt := ExtractFileExt(AsShortcutName) ;
if ( Uppercase(sLnkExt) = '.LNK' ) then
begin
// assume .lnk included
// need a wide string
WsFileName := sDirectory + '\' +
ExtractFileName(AsShortcutName) ;
// this saves it to the desktop
IfPersistFile.Save(PWChar(WsFileName),False);
end
else
result := false ;