function GetDesktopFolder: string;
var
buf: array[0..MAX_PATH] of Char;
pidList: PItemIDList;
begin
Result := StrNoDesktopFolderFo;
SHGetSpecialFolderLocation(Application.Handle,CSIDL_DESKTOP,pidList);
if (pidList <> nil) then
if (SHGetPathFromIDList(pidList,buf)) then
Result := buf;
end;
procedure p;
var
i: Integer;
IObject: IUnknown;
ISLink: IShellLink;
IPFile: IPersistFile;
PIDL: PItemIDList;
InFolder: array[0..MAX_PATH] of Char;
TargetName: string;
LinkName: string;
begin
TargetName := 'c:\folder\exeFile.exe';//hardcoded example
IObject := CreateComObject(CLSID_ShellLink) ;
ISLink := IObject as IShellLink;
IPFile := IObject as IPersistFile;
with ISLink do
begin
SetDescription('what ever');
SetPath(pChar(TargetName)) ;
SetWorkingDirectory(pChar(ExtractFilePath(TargetName))) ;
end;
SHGetSpecialFolderLocation(0,CSIDL_DESKTOPDIRECTORY,PIDL) ;
SHGetPathFromIDList(PIDL,InFolder) ;
LinkName := getDesktopFolder+'\';
i := ;
LinkName:= linkname+ExtractFileName(TargetName)+'.lnk';
if LinkName = StrNoDesktopFolderFo then
Exit;
if not FileExists(LinkName) then
IPFile.Save(PWChar(LinkName),False);
Application.Terminate;
end;
有任何想法吗 ？
顺便说一句.来源不是我的,它是从网上的地方拿起来的.
解决方法
我会这样做,例如这条路
uses
ShlObj,ComObj,ActiveX;
function GetDesktopFolder: string;
var
PIDList: PItemIDList;
Buffer: array [0..MAX_PATH-1] of Char;
begin
Result := '';
SHGetSpecialFolderLocation(Application.Handle,PIDList);
if Assigned(PIDList) then
if SHGetPathFromIDList(PIDList,Buffer) then
Result := Buffer;
end;
function CreateDesktopShellLink(const TargetName: string): Boolean;
var
IObject: IUnknown;
ISLink: IShellLink;
IPFile: IPersistFile;
PIDL: PItemIDList;
LinkName: string;
InFolder: array [0..MAX_PATH-1] of Char;
begin
Result := False;
IObject := CreateComObject(CLSID_ShellLink);
ISLink := IObject as IShellLink;
IPFile := IObject as IPersistFile;
with ISLink do
begin
SetDescription('Description ...');
SetPath(PChar(TargetName));
SetWorkingDirectory(PChar(ExtractFilePath(TargetName)));
end;
SHGetSpecialFolderLocation(0,PIDL);
SHGetPathFromIDList(PIDL,InFolder) ;
LinkName := IncludeTrailingBackslash(GetDesktopFolder);
LinkName := LinkName + ExtractFileName(TargetName) + '.lnk';
if not FileExists(LinkName) then
if IPFile.Save(PWideChar(LinkName),False) = S_OK then
Result := True;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
if CreateDesktopShellLink('C:\Folder\ExeFile.exe') then
ShowMessage('Link has been created ...');
end;