LsaOpenPolicy在我的代码中引发异常。为什么？

问题描述

我从新闻组发布中获得了以下代码。奇怪的是，它在Delphi 2010中对我不起作用； LsaOpenPolicy函数调用中引发了一个异常：

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;

可以在Google网上论坛归档文件中找到原始帖子：

Original posting may be found at Google Groups archive:

新闻组：
borland.public.delphi.winapi

Newsgroups: borland.public.delphi.winapi

主题：NetUser添加并分配用户
权利

Subject: NetUserAdd and assigning user rights

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

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

预先感谢您提供任何答案。

Thanks in advance for any answers.

推荐答案

已修复/更改的功能，已在D2009上的Win7上进行了测试（但也应在较早/较新的版本上工作）。当然是app。必须使用管理员权限运行。

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;

这篇关于LsaOpenPolicy在我的代码中引发异常。为什么？的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持！