Получение дополнительных привилегий под NT

Code:

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;