delphi – 如何在Windows桌面上创建文件快捷方式(* .lnk文件)？

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;

上面的代码在Delphi中导致很多错误,不能运行两次……

有任何想法吗 ？

顺便说一句.来源不是我的,它是从网上的地方拿起来的.

解决方法

我会这样做,例如这条路

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;

原文地址：https://www.jb51.cc/delphi/102309.html