Question

我从新闻组发布了以下代码。奇怪的是，它在Delphi 2010中对我不起作用;在LsaOpenPolicy函数调用中抛出异常：

function AddLogonAsAService(ID: pchar): boolean;
const
  Right: PChar = 'SeServiceLogonRight';
var
  FResult: NTSTATUS;
  //szSystemName: LPTSTR;
  FObjectAttributes: TLSAObjectAttributes;
  FPolicyHandle: LSA_HANDLE;
  Server, Privilege: TLSAUnicodeString;
  FSID: PSID;
  cbSid: DWORD;
  ReferencedDomain: LPTSTR;
  cchReferencedDomain: DWORD;
  peUse: SID_NAME_USE;
  PrivilegeString: String;
begin
  Result := false;

  try
    ZeroMemory(@FObjectAttributes, sizeof(FObjectAttributes));

    Server.Buffer := nil;
    Server.Length := 0;
    Server.MaximumLength := 256;

    PrivilegeString := Right; //or some other privilege

    Privilege.Buffer := PChar(PrivilegeString);
    Privilege.Length := 38;
    Privilege.MaximumLength := 256;

    FResult := LsaOpenPolicy(
      @Server, //this machine, because the Buffer is NIL
      @FObjectAttributes,
      POLICY_ALL_ACCESS,
      FPolicyHandle);

    if FResult = STATUS_SUCCESS then begin
      cbSid := 128;
      cchReferencedDomain := 16;
      GetMem(FSID, cbSid);
        //FSID:=PSID(HeapAlloc(GetProcessHeap(), 0, cbSid));
      GetMem(ReferencedDomain, cchReferencedDomain);
        //ReferencedDomain := LPTSTR(HeapAlloc(GetProcessHeap(), 0, cchReferencedDomain * sizeof(ReferencedDomain^)));

      if LookupAccountName(nil, ID, FSID, cbSid, ReferencedDomain,
        cchReferencedDomain, peUse) then begin
        FResult := LsaAddAccountRights(FPolicyHandle, FSID, @Privilege, 1);
        Result := FResult = STATUS_SUCCESS;
      end;

      FreeMem(FSID, cbSid);
      FreeMem(ReferencedDomain, cchReferencedDomain);
    end;
  except
    Result := false;
  end;

end;

可以在Google网上论坛存档中找到原始发布内容：

来自：“andrew”

新闻组：   borland.public.delphi.winapi

主题：NetUserAdd和分配用户   权利

日期：星期二，2001年9月25日10:08:35 +1000

提前感谢您的任何答案。

Answer 1

根据MSDN文档，你不应该使用LSA_UNICODE_STRING，将Buffer设置为nil，而是传递nil：LsaOpenPolicy（nil，...

<强> /编辑：下面的代码对我使用Jedi Apilib很好，所以我觉得你的定义可能有问题（可能是调用约定？），所以请把它添加到你的代码中。此外，您在LSA_UNICODE_STRING中指定的最大缓冲区大小为256，这是不正确的，在第一种情况下，最大缓冲区为0。

uses
  JwaWinType, JwaNtSecApi;

procedure TForm1.Button1Click(Sender: TObject);
var
  ObjectAttribs: LSA_OBJECT_ATTRIBUTES;
  PolicyHandle: LSA_HANDLE;
  nts: NTSTATUS;
begin
  ZeroMemory(@ObjectAttribs, SizeOf(ObjectAttribs));
  nts := LsaOpenPolicy(nil, ObjectAttribs, POLICY_ALL_ACCESS, PolicyHandle);
  Memo1.Lines.Add(Format('nts=%.8x', [nts]));
end;

Answer 2

固定/更改功能，在D2009下在Win7上测试（但也适用于旧版/更新版）。当然app。必须以管理员权限运行。

uses
  JwaWinNT, JwaWinType, JwaNtStatus, JwaNtSecApi, JwaLmCons;

function AddPrivilegeToAccount(AAccountName, APrivilege: String): DWORD;
var
  lStatus: TNTStatus;
  lObjectAttributes: TLsaObjectAttributes;
  lPolicyHandle: TLsaHandle;
  lPrivilege: TLsaUnicodeString;
  lSid: PSID;
  lSidLen: DWORD;
  lTmpDomain: String;
  lTmpDomainLen: DWORD;
  lTmpSidNameUse: TSidNameUse;
{$IFDEF UNICODE}
  lPrivilegeWStr: String;
{$ELSE}
  lPrivilegeWStr: WideString;
{$ENDIF}
begin
  ZeroMemory(@lObjectAttributes, SizeOf(lObjectAttributes));
  lStatus := LsaOpenPolicy(nil, lObjectAttributes, POLICY_LOOKUP_NAMES, lPolicyHandle);

  if lStatus <> STATUS_SUCCESS then
  begin
    Result := LsaNtStatusToWinError(lStatus);
    Exit;
  end;

  try
    lTmpDomainLen := JwaLmCons.DNLEN; // In 'clear code' this should be get by LookupAccountName
    SetLength(lTmpDomain, lTmpDomainLen);

    lSidLen := SECURITY_MAX_SID_SIZE;
    GetMem(lSid, lSidLen);
    try
      if LookupAccountName(nil, PChar(AAccountName), lSid, lSidLen, PChar(lTmpDomain),
        lTmpDomainLen, lTmpSidNameUse) then
      begin
        lPrivilegeWStr := APrivilege;

        lPrivilege.Buffer := PWideChar(lPrivilegeWStr);
        lPrivilege.Length := Length(lPrivilegeWStr) * SizeOf(Char);
        lPrivilege.MaximumLength := lPrivilege.Length;

        lStatus := LsaAddAccountRights(lPolicyHandle, lSid, @lPrivilege, 1);
        Result := LsaNtStatusToWinError(lStatus);
      end else
        Result := GetLastError;
    finally
      FreeMem(lSid);
    end;
  finally
    LsaClose(lPolicyHandle);
  end;
end;

procedure TForm2.Button1Click(Sender: TObject);
var
  lStatus: DWORD;
begin
  lStatus := AddPrivilegeToAccount('Administrators'{or any account/group name}, 'SeServiceLogonRight');
  if lStatus = ERROR_SUCCESS then
    Caption := 'OK'
  else
    Caption := SysErrorMessage(lStatus);
end;

LsaOpenPolicy在我的代码中抛出异常。为什么？

2 个答案: