IShellLink-Problem

[CalganX]

Nicht großartig verändert:

Delphi-Quellcode:

function CreateShortcut(const sTargetPath: string;
                          const sParams: string;
                          const sOutput: string;
                          const sExecPath: string): boolean;
const
  IID_IPersistFile: TGUID = '{0000010b-0000-0000-C000-000000000046}';

var
  slShellLink    : IShellLink;
  pfPersistFile  : IPersistFile;
  wszShortCut    : PWideChar;
  hRes           : HResult;
  sShortCut      : string;
  dwLen          : DWORD;

begin
  Result := false;

  hRes := CoCreateInstance(CLSID_ShellLink, nil, CLSCTX_INPROC_SERVER, IID_IShellLinkA, slShellLink);
  if hRes <> S_OK then begin
    exit;
  end;
  slShellLink.SetPath(PChar(sTargetPath));
  slShellLink.SetArguments(PChar(sParams));
  hRes := slShellLink.QueryInterface(IID_IPersistFile,pfPersistFile);
  if hRes <> S_OK then begin
    exit;
  end;
  dwLen := (MAX_PATH+1)*2;
  wszShortcut := AllocMem(dwLen);
  try
    sShortCut := sOutput;
    StringToWideChar(sShortCut,wszShortCut,dwLen);
    hRes := pfPersistFile.Save(wszShortCut, TRUE);
  finally
    FreeMem(wszShortCut,dwLen);
  end;
  Result := (hRes = S_OK);
end;

Chris