如何创建快捷方式(50分)

  • 主题发起人 主题发起人 zwh
  • 开始时间 开始时间
Z

zwh

Unregistered / Unconfirmed
GUEST, unregistred user!
如何在程序中实现在WINDOWS95/98的DESKTOP上创建快捷方式以及
程序组的方法。
 
win又ole接口!ishelllink;
delphi 里有Tshellobject;
 
// CreateLink - uses the shell's IShellLink and IPersistFile interfaces
// to create and store a shortcut to the specified object.
// Returns the result of calling the member functions of the interfaces.
// lpszPathObj - address of a buffer containing the path of the object
// lpszPathLink - address of a buffer containing the path where the
// shell link is to be stored
// lpszDesc - address of a buffer containing the description of the
// shell link

HRESULT CreateLink(LPCSTR lpszPathObj,
LPSTR lpszPathLink, LPSTR lpszDesc)
{
HRESULT hres;
IShellLink* psl;

// Get a pointer to the IShellLink interface.
hres = CoCreateInstance(&CLSID_ShellLink, NULL,
CLSCTX_INPROC_SERVER, &IID_IShellLink, &psl);
if (SUCCEEDED(hres)) {
IPersistFile* ppf;

// Set the path to the shortcut target, and add the
// description.
psl->lpVtbl->SetPath(psl, lpszPathObj);
psl->lpVtbl->SetDescription(psl, lpszDesc);

// Query IShellLink for the IPersistFile interface for saving the
// shortcut in persistent storage.
hres = psl->lpVtbl->QueryInterface(psl, &IID_IPersistFile,
&ppf);

if (SUCCEEDED(hres)) {
WORD wsz[MAX_PATH];

// Ensure that the string is ANSI.
MultiByteToWideChar(CP_ACP, 0, lpszPathLink, -1,
wsz, MAX_PATH);

// Save the link by calling IPersistFile::Save.
hres = ppf->lpVtbl->Save(ppf, wsz, TRUE);
ppf->lpVtbl->Release(ppf);
}
psl->lpVtbl->Release(psl);
}
return hres;
}
 
////////////////////////////////////////////////////////////////////////////////
// - 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;

sFileName := AsAppName
sFilePath := ExtractFilePath( sFileName )

// 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

Reg.Free;
end;
 
多人接受答案了。
 
后退
顶部