LsaAddAccountRights не работает для меня

Question

Использование: Delphi 2010 и JEDI Windows API и JWSCL

Я пытаюсь назначить пользователю привилегию входа в систему как службу, используя функцию LsaAddAccountRights, но она не работает, т.е.после возврата из функции проверка в редакторе групповой политики показывает, что у пользователя все еще нет вышеуказанной привилегии.

Я запускаю приложение на Windows XP.

Был бы рад, если бы кто-то мог указать, что не так в моем коде:

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, JwaWindows, JwsclSid;

type
  TForm1 = class(TForm)
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

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;
  lPrivilegeWStr: String;
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 := 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 := PChar(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 TForm1.Button1Click(Sender: TObject);
begin
  AddPrivilegeToAccount('Sam', 'SeServiceLogonRight');
end;

end.

Заранее спасибо.

Answer 1

Чтобы иметь возможность использовать LsaAddAccountRights , вы должны открыть дескриптор политики с дополнительным флагом POLICY_CREATE_ACCOUNT (POLICY_CREATE_ACCOUNT | POLICY_LOOKUP_NAMES) в LsaOpenPolicy или использовать MAXIMUM_ALLOWED вместо обоих флагов.