Delphi World - Получение дополнительных привилегий под НТ
Delphi World - это проект, являющийся сборником статей и малодокументированных возможностей  по программированию в среде Delphi. Здесь вы найдёте работы по следующим категориям: delphi, delfi, borland, bds, дельфи, делфи, дэльфи, дэлфи, programming, example, программирование, исходные коды, code, исходники, source, sources, сорцы, сорсы, soft, programs, программы, and, how, delphiworld, базы данных, графика, игры, интернет, сети, компоненты, классы, мультимедиа, ос, железо, программа, интерфейс, рабочий стол, синтаксис, технологии, файловая система...
Получение дополнительных привилегий под НТ

Автор: Денис
WEB-сайт: http://delphibase.endimus.com

{ **** UBPFD *********** by delphibase.endimus.com ****
>> Получение дополнительных привилегий под НТ

В принципе и так все понятно - задаеш название привилегии и
если это возможно, то система их тебе дает

Зависимости: uses Windows, SysUtils;
Автор:       Денис, LiquidStorm_HSS@yahoo.com, Lviv
Copyright:   by LiquidStorm, HomeSoftStudios(tm) aka Denis L.
Дата:        9 августа 2003 г.
***************************************************** }

unit NTPrivelegsU;
// NT Defined Privileges

interface
uses Windows, SysUtils;

const
  SE_CREATE_TOKEN_NAME = 'SeCreateTokenPrivilege';
  SE_ASSIGNPRIMARYTOKEN_NAME = 'SeAssignPrimaryTokenPrivilege';
  SE_LOCK_MEMORY_NAME = 'SeLockMemoryPrivilege';
  SE_INCREASE_QUOTA_NAME = 'SeIncreaseQuotaPrivilege';
  SE_UNSOLICITED_INPUT_NAME = 'SeUnsolicitedInputPrivilege';
  SE_MACHINE_ACCOUNT_NAME = 'SeMachineAccountPrivilege';
  SE_TCB_NAME = 'SeTcbPrivilege';
  SE_SECURITY_NAME = 'SeSecurityPrivilege';
  SE_TAKE_OWNERSHIP_NAME = 'SeTakeOwnershipPrivilege';
  SE_LOAD_DRIVER_NAME = 'SeLoadDriverPrivilege';
  SE_SYSTEM_PROFILE_NAME = 'SeSystemProfilePrivilege';
  SE_SYSTEMTIME_NAME = 'SeSystemtimePrivilege';
  SE_PROF_SINGLE_PROCESS_NAME = 'SeProfileSingleProcessPrivilege';
  SE_INC_BASE_PRIORITY_NAME = 'SeIncreaseBasePriorityPrivilege';
  SE_CREATE_PAGEFILE_NAME = 'SeCreatePagefilePrivilege';
  SE_CREATE_PERMANENT_NAME = 'SeCreatePermanentPrivilege';
  SE_BACKUP_NAME = 'SeBackupPrivilege';
  SE_RESTORE_NAME = 'SeRestorePrivilege';
  SE_SHUTDOWN_NAME = 'SeShutdownPrivilege';
  SE_DEBUG_NAME = 'SeDebugPrivilege';
  SE_AUDIT_NAME = 'SeAuditPrivilege';
  SE_SYSTEM_ENVIRONMENT_NAME = 'SeSystemEnvironmentPrivilege';
  SE_CHANGE_NOTIFY_NAME = 'SeChangeNotifyPrivilege';
  SE_REMOTE_SHUTDOWN_NAME = 'SeRemoteShutdownPrivilege';

function AdjustPriviliges(const PrivelegStr: string): Bool; forward;

implementation

function AdjustPriviliges(const PrivelegStr: string): Bool;
var
  hTok: THandle;
  tp: TTokenPrivileges;
begin
  Result := False;
  // Get the current process token handle so we can get privilege.
  if OpenProcessToken(GetCurrentProcess, TOKEN_ADJUST_PRIVILEGES + TOKEN_QUERY,
    hTok) then
  try
    // Get the LUID for privilege.
    if LookupPrivilegeValue(nil, PChar(PrivelegStr), tp.Privileges[0].Luid) then
    begin
      tp.PrivilegeCount := 1; // one privilege to set
      tp.Privileges[0].Attributes := SE_PRIVILEGE_ENABLED;
      // Get privilege for this process.
      Result := AdjustTokenPrivileges(hTok, False, tp, 0,
        PTokenPrivileges(nil)^, PDWord(nil)^)
    end
  finally
    // Cannot test the return value of AdjustTokenPrivileges.
    if (GetLastError <> ERROR_SUCCESS) then
      raise Exception.Create('AdjustTokenPrivileges enable failed');
    CloseHandle(hTok)
  end
  else
    raise Exception.Create('OpenProcessToken failed');
end;

end.

Пример использования:

unit uWDog;

// define _DEV_ in developing stage - this mean DEBUG version
{.$DEFINE _DEV_}

// define WRITE_DESKTOP in developing stage if you want
// visible confirmation of service work
{.$DEFINE WRITE_DESKTOP}

// define WRITE_NO_LOGIN if you want to write log when
// nobody logged in
{$DEFINE WRITE_NO_LOGIN}

// define WRITE_FOUND if you want to write log when
// everything ok and process found
{$DEFINE WRITE_FOUND}

// define WRITE_UNCHECKED_LOGINS if you want to write log for
// not checked logins (like Administrator - in release)
{$DEFINE WRITE_UNCHECKED_LOGINS}

{$IFNDEF _DEV_}
{$UNDEF WRITE_DESKTOP}
{$ENDIF}

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, SvcMgr, Dialogs,
  ExtCtrls;

type
  TwDog = class(TService)
    dx_time: TTimer;
    procedure ServiceStart(Sender: TService; var Started: Boolean);
    procedure ServiceStop(Sender: TService; var Stopped: Boolean);
    procedure dx_timeTimer(Sender: TObject);
    procedure ServiceCreate(Sender: TObject);
    procedure ServiceDestroy(Sender: TObject);
    procedure ServiceShutdown(Sender: TService);
  private
    { Private declarations }
    procedure InitiateShutdown;
    //procedure AbortShutdown;
  public
    function GetServiceController: TServiceController; override;
    { Public declarations }
  end;

var
  wDog: TwDog;

implementation
{$R *.DFM}

uses ShellAPI, NTPrivelegsU, WinSecur,
  FileCtrl{$IFDEF WRITE_DESKTOP}, DeskTopMsg{$ENDIF};
const
  TimerInterval = 5000; // in msec = 5 sec
  SleepAftLogin = 3000; // in msec = 3 sec
  ProcessName = 'Q3Arena.exe';
  ClassName = 'Quake3ArenaClassWnd';
  WndName = ' '; // 1 space
  CheckUsersCount = 2;
{$IFDEF _DEV_}
  StekServer = '127.0.0.1';
  CheckUsers: array[0..CheckUsersCount - 1] of string =
  ('Internet', 'Administrator');
{$ELSE}
  StekServer = '132.0.0.16';
  CheckUsers: array[0..CheckUsersCount - 1] of string =
  ('Gamer', 'Office');
{$ENDIF}
var
  hLog: THandle;
  CreateOptScan: LongWord;
  xBuf: array[0..$FF - 1] of Char;
  LogPath: string;

  // ------------- forward declarations
function IsLoggedIn: Boolean; forward;
function WriteLog(Status: string): DWord; forward;
procedure SndMessage; forward;
procedure Kill; forward;
{$IFDEF _DEV_}
procedure ShowError(erno: DWord); forward;
{$ENDIF}
// function ProcessTerminate(dwPID:Cardinal):Boolean; forward;

// -------------

procedure AdjTokenPrivelegs(mmName: string);
var
  gler: DWord;
begin
  AdjustPriviliges(mmName);
  gler := GetLastError;
  if (gler <> ERROR_SUCCESS) then
  begin
    WriteLog(Format('%s: [FAILED] ', [mmName]));
{$IFDEF _DEV_}
    ShowError(gler);
{$ENDIF}
    exit;
  end;
  WriteLog(Format('%s: [OK] ', [mmName]));
end;

// -------------

function MyCtrlHandler(dwCtrlType: Dword): Bool; stdcall;
begin
  //
  case dwCtrlType of
    CTRL_LOGOFF_EVENT:
      begin
        WriteLog('CTRL_LOGOFF_EVENT');
        Result := True;
      end;
    CTRL_SHUTDOWN_EVENT:
      begin
        WriteLog('CTRL_SHUTDOWN_EVENT');
        Result := True;
      end;
  else
    Result := False
  end;
end;

// -------------

procedure ServiceController(CtrlCode: DWord); stdcall;
begin
  wDog.Controller(CtrlCode);
end;

// -------------

function TwDog.GetServiceController: TServiceController;
begin
  Result := ServiceController;
end;

// -------------

procedure TwDog.ServiceStart(Sender: TService; var Started: Boolean);
begin
  WriteLog('OnStart');
  Started := True;
end;

// -------------

procedure TwDog.ServiceStop(Sender: TService; var Stopped: Boolean);
begin
  WriteLog('OnStop');
  Stopped := True;
end;

// -------------

procedure TwDog.ServiceCreate(Sender: TObject);
begin
  if sysutils.Win32Platform = VER_PLATFORM_WIN32_NT then
    CreateOptScan := FILE_FLAG_SEQUENTIAL_SCAN
  else
    CreateOptScan := 0;
  GetWindowsDirectory(xBuf, $FF);
  LogPath := Format('%s\wDog', [xBuf]);
  ForceDirectories(LogPath);
  LogPath := Format('%s\%s.log', [LogPath, FormatDateTime('dd.mm.yyyy', Now)]);
  WriteLog('Starting ...');
  AdjTokenPrivelegs(SE_SHUTDOWN_NAME);
  AdjTokenPrivelegs(SE_DEBUG_NAME);
  SetConsoleCtrlHandler(@MyCtrlHandler, True);
  dx_time.Interval := TimerInterval;
  dx_time.Enabled := true;
  WriteLog('Started: [OK]');
end;

// -------------

procedure TwDog.ServiceDestroy(Sender: TObject);
begin
  dx_time.Enabled := false;
  WriteLog('Stopped: [OK]');
  CloseHandle(hLog);
end;

// -------------

function IsLoggedIn: Boolean;
var
  stmp: string;
  i: Byte;
  pid: DWord;
begin
  Result := False;
  pid := GetPidFromProcessName(GetShellProcessName);
  if (pid = 0) or (pid = INVALID_HANDLE_VALUE) then
    // no shell running - no body logged in
    stmp := EmptyStr
  else
    // shell running - get interactive user name
    stmp := GetInteractiveUserName; // get DOMAIN\User
  if stmp = EmptyStr then
  begin
{$IFDEF WRITE_NO_LOGIN}
    WriteLog('[No_Login]');
{$ENDIF}
    Exit;
  end;
  Delete(stmp, 1, Pos('\', stmp)); // get User
  for i := 0 to CheckUsersCount do
    if AnsiSameText(stmp, CheckUsers[i]) then
    begin
      WriteLog(Format('[%s]: check', [stmp]));
      Result := True;
      exit;
    end;
  // if no login detected
{$IFDEF WRITE_UNCHECKED_LOGINS}
  WriteLog(Format('[%s]: no_check', [stmp]));
{$ENDIF}
end;

// -------------

function IsFoundByClass: Boolean;
var
  hwnd: DWord;
begin
  // try to find by classname
  hwnd := FindWindowEx(0, 0, PChar(ClassName), nil);
  if (hwnd = 0) or (hwnd = INVALID_HANDLE_VALUE) then
    Result := False
  else
    Result := True;
{$IFDEF _DEV_}
{$IFDEF WRITE_DESKTOP}
  if not Result then
    writeDirect(10, 30, 'IsFoundByClass: [NO]')
  else
    writeDirect(10, 30, 'IsFoundByClass: [YES]')
{$ENDIF}
{$ENDIF}
end;

// -------------

function IsFoundByProcName: Boolean;
var
  Pid,
    hwnd: DWord;
begin
  Pid := GetPidFromProcessName(ProcessName);
  hwnd := OpenProcess(PROCESS_ALL_ACCESS, False, Pid);
  // if hwnd = 0 then RaiseLastWin32Error;
  if (hwnd = 0) or (hwnd = INVALID_HANDLE_VALUE) then
    Result := False
  else
    Result := True;
  CloseHandle(hwnd);
{$IFDEF _DEV_}
{$IFDEF WRITE_DESKTOP}
  if not Result then
    writeDirect(10, 70, 'IsFoundByProcName: [NO]')
  else
    writeDirect(10, 70, 'IsFoundByProcName: [YES]')
{$ENDIF}
{$ENDIF}
end;

// -------------

// enable complete Boolean expression evaluation
{$B+}

procedure TwDog.dx_timeTimer(Sender: TObject);
begin
  // Check login
  // - service started under SYSTEM account, so it works on system boot.
  // To prevent machine from deadlock we must check if someone
  // has logged in.
  if IsLoggedIn then
  begin
    // turn off timer - to prevent
    // double elimination
    dx_time.Enabled := false;

    // make some delay - for user processes startup
    // just after login
    Sleep(SleepAftLogin);

    // try to find by classname, process name
    if IsFoundByClass and
      IsFoundByProcName then
    begin
{$IFDEF WRITE_FOUND}
      WriteLog('[FOUND]');
{$ENDIF}
    end
    else // cheater found
    begin
{$IFNDEF _DEV_}
      SndMessage;
{$ENDIF}
      Kill;
      InitiateShutdown;
    end;
    dx_time.Enabled := True;
  end;
end;
{$B-}
// -------------

procedure SndMessage;
var
  stmp: string;
  buf: array[0..127] of Char;
  num: DWord;
begin
  num := 128;
  stmp := EmptyStr;
  if GetComputerName(buf, num) then
    SetString(stmp, buf, num)
  else
    ; // no result for netbios name
  //
  stmp := Format('::Cheater detected on [%s]::', [stmp]);
  WriteLog(stmp);
  stmp := Format('%s %s', [StekServer, stmp]);
  // NetMessageBufferSend
  ShellExecute(0, 'open', 'net', PChar('send ' + stmp), nil, SW_HIDE);
  sleep(50);
end;

// -------------

procedure Kill;
begin
  WriteLog('[KILL]');
{$IFDEF _DEV_}
{$IFDEF WRITE_DESKTOP}
  writeDirect(10, 10, 'KILL');
{$ENDIF}
{$ELSE}
  ExitWindowsEx(EWX_LOGOFF or EWX_FORCE, 0);
{$ENDIF}
end;

// -------------

function WriteLog(Status: string): DWord;
begin
  if (hLog = INVALID_HANDLE_VALUE) or (hLog = 0) then
  begin
    if FileExists(LogPath) then
      hLog := CreateFile(PChar(LogPath),
        GENERIC_READ or GENERIC_WRITE,
        FILE_SHARE_READ,
        nil,
        OPEN_EXISTING,
        FILE_ATTRIBUTE_NORMAL or CreateOptScan,
        0)
    else
      hLog := CreateFile(PChar(LogPath),
        GENERIC_READ or GENERIC_WRITE,
        FILE_SHARE_READ,
        nil,
        CREATE_ALWAYS,
        FILE_ATTRIBUTE_NORMAL or CreateOptScan,
        0);
    if hLog = INVALID_HANDLE_VALUE then
    begin
      Result := DWord(-1);
      exit;
    end;
    // seek to the end of log
    FileSeek(hLog, 0, 2);
  end;
  FillChar(xBuf, $FF, 0);
  Status := Format('%s - %s'#13#10,
    [FormatDateTime('hh:nn:ss', Now),
    Status]);
  move((Pointer(@Status[1]))^, xBuf, Length(Status));
  // write buffer
  FileWrite(hLog, xBuf, Length(Status));
  // flush file buffers
  FlushFileBuffers(hLog);
  Result := 0;
end;

// -------------

{$IFDEF _DEV_}

procedure ShowError(erno: DWord);
var
  MsgBuf: array[0..$FF - 1] of Char;
begin
  if erno = ERROR_SUCCESS then
    exit;
  //
  FillChar(MsgBuf, $FF, 0);
  FormatMessage(
    FORMAT_MESSAGE_FROM_SYSTEM,
    nil,
    erno,
    ((WORD(SUBLANG_DEFAULT) shl 10) or WORD(LANG_NEUTRAL)),
    MsgBuf,
    $FF,
    nil);
  // Display the string.
  MessageBox(0, MsgBuf, 'GetLastError', MB_OK + MB_ICONINFORMATION + MB_TASKMODAL
    + MB_SERVICE_NOTIFICATION);
end;
{$ENDIF}

// -------------

procedure TwDog.InitiateShutdown;
begin
  InitiateSystemShutdown(nil, // shut down local computer
    'Cheater detected on this system. Shutdown initiated.', // message to user
    10, // time-out period
    FALSE, // ask user to close apps
    TRUE); // reboot after shutdown
  // bQuite:=False;
end;

// -- end of source --
Проект Delphi World © Выпуск 2002 - 2017
Автор проекта: Эксклюзивные курсы программирования