LsaOpenPolicy вызывает исключение в моем коде. Зачем?

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:

От: "Андрей"

Телеконференция: borland.public.delphi.winapi

Тема: NetUserAdd и назначение пользователя права

Дата: вт, 25 сентября 2001 г. 10:08:35 + 1000

Заранее спасибо за любые ответы.

Answer 1

Исправлена ​​/ изменена функция, протестирована на Win7 под D2009 (но также должна работать на старых / новых).Конечно приложение.должен быть запущен с правами администратора.

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;

Answer 2

В соответствии с документами MSDN не следует использовать LSA_UNICODE_STRING с установленным для буфера значением nil, но вместо этого передавать nil: LsaOpenPolicy (nil, ...

/ EDIT: код нижеу меня хорошо работает с использованием Jedi Apilib, так что я думаю, что что-то может быть не так с вашим определением (возможно, соглашение о вызовах?), поэтому, пожалуйста, добавьте это в свой код. Также вы указываете максимальный размер буфера 256 в LSA_UNICODE_STRING, что неверно, вВ первом случае максимальный размер буфера равен 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;