{ **** UBPFD *********** by kladovka.net.ru ****
>>
В принципе и так все понятно - задаеш название привилегии и
если это возможно, то система их тебе дает
Зависимости: uses Windows, SysUtils;
Автор: Денис, <a href="mailto:LiquidStorm_HSS@yahoo.com">LiquidStorm_HSS@yahoo.com</a>, 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';
const SE_ASSIGNPRIMARYTOKEN_NAME = 'SeAssignPrimaryTokenPrivilege';
const SE_LOCK_MEMORY_NAME = 'SeLockMemoryPrivilege';
const SE_INCREASE_QUOTA_NAME = 'SeIncreaseQuotaPrivilege';
const SE_UNSOLICITED_INPUT_NAME = 'SeUnsolicitedInputPrivilege';
const SE_MACHINE_ACCOUNT_NAME = 'SeMachineAccountPrivilege';
const SE_TCB_NAME = 'SeTcbPrivilege';
const SE_SECURITY_NAME = 'SeSecurityPrivilege';
const SE_TAKE_OWNERSHIP_NAME = 'SeTakeOwnershipPrivilege';
const SE_LOAD_DRIVER_NAME = 'SeLoadDriverPrivilege';
const SE_SYSTEM_PROFILE_NAME = 'SeSystemProfilePrivilege';
const SE_SYSTEMTIME_NAME = 'SeSystemtimePrivilege';
const SE_PROF_SINGLE_PROCESS_NAME = 'SeProfileSingleProcessPrivilege';
const SE_INC_BASE_PRIORITY_NAME = 'SeIncreaseBasePriorityPrivilege';
const SE_CREATE_PAGEFILE_NAME = 'SeCreatePagefilePrivilege';
const SE_CREATE_PERMANENT_NAME = 'SeCreatePermanentPrivilege';
const SE_BACKUP_NAME = 'SeBackupPrivilege';
const SE_RESTORE_NAME = 'SeRestorePrivilege';
const SE_SHUTDOWN_NAME = 'SeShutdownPrivilege';
const SE_DEBUG_NAME = 'SeDebugPrivilege';
const SE_AUDIT_NAME = 'SeAuditPrivilege';
const SE_SYSTEM_ENVIRONMENT_NAME = 'SeSystemEnvironmentPrivilege';
const SE_CHANGE_NOTIFY_NAME = 'SeChangeNotifyPrivilege';
const 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}, DeskMsg{$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;

{
 For some functions you need to get the right privileges
 on a Windows NT machine.
 (e.g: To shut down or restart windows with ExitWindowsEx or
 to change the system time)
 The following code provides a procedure to adjust the privileges.
 The AdjustTokenPrivileges() function enables or disables privileges
 in the specified access token.
}
// NT Defined Privileges from winnt.h
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';
 SE_UNDOCK_NAME = 'SeUndockPrivilege';
 SE_SYNC_AGENT_NAME = 'SeSyncAgentPrivilege';
 SE_ENABLE_DELEGATION_NAME = 'SeEnableDelegationPrivilege';
 SE_MANAGE_VOLUME_NAME = 'SeManageVolumePrivilege';
// Enables or disables privileges debending on the bEnabled
function NTSetPrivilege(sPrivilege: string; bEnabled: Boolean): Boolean;
var
 hToken: THandle;
 TokenPriv: TOKEN_PRIVILEGES;
 PrevTokenPriv: TOKEN_PRIVILEGES;
 ReturnLength: Cardinal;
begin
 Result := True;
 // Only for Windows NT/2000/XP and later.
 if not (Win32Platform = VER_PLATFORM_WIN32_NT) then Exit;
 Result := False;
 // obtain the processes token
 if OpenProcessToken(GetCurrentProcess(),
  TOKEN_ADJUST_PRIVILEGES or TOKEN_QUERY, hToken) then
 begin
  try
  // Get the locally unique identifier (LUID) .
  if LookupPrivilegeValue(nil, PChar(sPrivilege),
  TokenPriv.Privileges[0].Luid) then
  begin
  TokenPriv.PrivilegeCount := 1; // one privilege to set
  case bEnabled of
  True: TokenPriv.Privileges[0].Attributes := SE_PRIVILEGE_ENABLED;
  False: TokenPriv.Privileges[0].Attributes := 0;
  end;
  ReturnLength := 0; // replaces a var parameter
  PrevTokenPriv := TokenPriv;
  // enable or disable the privilege
  AdjustTokenPrivileges(hToken, False, TokenPriv, SizeOf(PrevTokenPriv),
  PrevTokenPriv, ReturnLength);
  end;
  finally
  CloseHandle(hToken);
  end;
 end;
 // test the return value of AdjustTokenPrivileges.
 Result := GetLastError = ERROR_SUCCESS;
 if not Result then
  raise Exception.Create(SysErrorMessage(GetLastError));
end;