LsaOpenPolicy is throwing exception in my code. Why?

I got the following code from a newsgroup posting. Strangely, it isn't working for me in Delphi 2010; An exception is being thrown at the LsaOpenPolicy function call:

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;

Original posting may be found at Google Groups archive:

From: "andrew"

Newsgroups: borland.public.delphi.winapi

Subject: NetUserAdd and assigning user rights

Date: Tue, 25 Sep 2001 10:08:35 +1000

Thanks in advance for any answers.

According to the MSDN docs you should not use an LSA_UNICODE_STRING with the Buffer set to nil but pass nil instead: LsaOpenPolicy(nil, ...

/EDIT: The code below works fine for me using Jedi Apilib so I think something might be wrong with your definition (maybe calling convention?), so please add this to your code. Also you are specifying maximum buffer size of 256 in the LSA_UNICODE_STRING's which is incorrect, in the first case the maximum buffer is 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;

Fixed/changed function, tested on Win7 under D2009 (but should work on older/newer too). Of course app. must be running with admin rights.

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;