Вверх ↑
Ответов: 233
Рейтинг: 12
#1: 2021-10-11 15:54:36 ЛС | профиль | цитата
Netspirit, Подскажи пожалуйста, нестандартный компонент по получению прав Админа при компиляции x64 ругается на

hiAdminAppEx.pas(48,66) Error: Call by var for arg no. 3 has to match exactly: Got "LongWord" expected "QWord"
hiAdminAppEx.pas(136) Fatal: There were 1 errors compiling module, stopping

Как это исправить?

unit hiAdminAppEx;

// version: 1.6 
// Date:    25.03.2017

interface

uses Kol,Share,Debug,Windows,ShellAPI;

type
  THIAdminAppEx = class(TDebug)
   private
   public
    _prop_AppletClose:boolean;

    _event_onError:THI_Event;
    _event_onNoAdmin:THI_Event;
    _event_onYesAdmin:THI_Event;

    procedure _work_doCheckPrivilege(var _Data:TData; Index:word);
    procedure _work_doElevatePrivilege(var _Data:TData; Index:word);
    procedure _var_IsElevated(var _Data:TData; Index:Word);
  end;

implementation

function GetWinVer: Integer;
var OsVer: OSVERSIONINFO;
begin
   OsVer.dwOSVersionInfoSize:= SizeOf(OSVERSIONINFO);
   GetVersionEx(OsVer);
   Result:= OsVer.dwMajorVersion;
end;

function isAdmin: Boolean;
const
  SECURITY_BUILTIN_DOMAIN_RID = $00000020;
  DOMAIN_ALIAS_RID_ADMINS = $00000220;
  siaNtAuthority: TSIDIdentifierAuthority = (Value: (0, 0, 0, 0, 0, 5));
var
  hAccessToken: Cardinal;
  ptgGroups: PTokenGroups;
  dwInfoBufferSize: DWORD;
  psidAdmins: PSID;
  i: Integer;
begin
  Result:= false;
  if OpenProcessToken(GetCurrentProcess, TOKEN_READ, hAccessToken) then begin
    ptgGroups:= GetMemory(1024);
    try
      if GetTokenInformation(hAccessToken,
                             TokenGroups,
                             ptgGroups,
                             1024,
                             dwInfoBufferSize) then begin

        if AllocateAndInitializeSid(siaNtAuthority,
                                    2,
                                    SECURITY_BUILTIN_DOMAIN_RID,
                                    DOMAIN_ALIAS_RID_ADMINS,
                                    0, 0, 0, 0, 0, 0,
                                    psidAdmins) then
        try
          for i:= 0 to ptgGroups^.GroupCount - 1 do
            if EqualSid(psidAdmins, ptgGroups^.Groups[i].Sid) then begin
              Result:= True;
              Break;
            end;
        finally
          FreeSid(psidAdmins);
        end;
      end;
    finally
      FreeMemory(ptgGroups);
    end;
  end;
end;

function IsElevated: Boolean;
const
  TokenElevation = TTokenInformationClass(20);
type
  TOKEN_ELEVATION = record
    TokenIsElevated: DWORD;
  end;
var
  TokenHandle: THandle;
  ResultLength: Cardinal;
  ATokenElevation: TOKEN_ELEVATION;
begin
  if GetWinVer >= 6  then
  begin
    TokenHandle := 0;
    if OpenProcessToken(GetCurrentProcess, TOKEN_QUERY, TokenHandle) then
    begin
      try
        ResultLength := 0;
        if GetTokenInformation(TokenHandle, TokenElevation, @ATokenElevation, SizeOf(ATokenElevation), ResultLength) then
          Result := ATokenElevation.TokenIsElevated <> 0
        else
          Result := False;
      finally
        CloseHandle(TokenHandle);
      end;
    end
    else
      Result := False;
  end
  else
    Result := isAdmin;
end;

procedure THIAdminAppEx._work_doCheckPrivilege;
begin
  if IsElevated then  _hi_onEvent(_event_onYesAdmin) else _hi_onEvent(_event_onNoAdmin);
end;

procedure THIAdminAppEx._work_doElevatePrivilege;
begin
  if not IsElevated then
  begin
    if ShellExecute(0,'runas',PChar(ParamStr(0)),nil,nil,SW_SHOWNORMAL) <= 32 then
      if GetLastError <> 1223 then
        _hi_onEvent(_event_onError, 'Error: # ' + Int2Str(GetLastError) + #13 +
                    SysErrorMessage(GetLastError));
    if _prop_AppletClose then Applet.Close;
  end;
end;

procedure THIAdminAppEx._var_IsElevated;
begin
  dtInteger(_Data,Integer(IsElevated));
end;

end.

UPD Разобрался! Если кому пригодится:


  hAccessToken: Cardinal;

заменить на

  hAccessToken: {$ifdef FPC64} QWord; {$else} Cardinal; {$endif}
карма: 2

0
Редактировалось 3 раз(а), последний 2021-10-11 17:35:45