{
Based on an article and code by Ivo Ivanov at The Code Project: Detecting Windows NT/2K process execution
url: [url]http://www.codeproject.com/threads/procmon.asp[/url]
PLEASE NOTE: Download driver 'NTProcDrv.sys' at the url noted above!!!
}
program NTDriverController;
{$APPTYPE CONSOLE}
uses
SysUtils, Windows, psapi, WinSvc;
type
TCallbackInfo =
record
ParentId : THANDLE;
ProcessId: THANDLE;
bCreate : ByteBool;
end;
PCallbackInfo = ^TCallbackInfo;
const
IOCTL_PROCVIEW_GET_PROCINFO = $0022E000;
//CTL_CODE(FILE_DEVICE_UNKNOWN, 0x0800, METHOD_BUFFERED, FILE_READ_ACCESS | FILE_WRITE_ACCESS)
var
m_hSCM : SC_HANDLE;
m_hDriver : SC_HANDLE;
nServiceStatus : SERVICE_STATUS;
strServiceName :
String = '
NTProcDrv';
strDisplayName :
String = '
Process creation/termination detector for Windows XP';
strFileName :
String = '
';
lpServiceArgVectors: PAnsiChar =
nil;
m_hShutDownEvent : THandle;
////////////////////////////////////////////////////////////////////////////////
function GetExeNameByPID(dwPID: DWord):
String;
var
h: THandle;
begin
Result := '
';
h := OpenProcess(PROCESS_QUERY_INFORMATION
or PROCESS_VM_READ, False, dwPID);
if (h <> 0)
then
try
SetLength(Result, MAX_PATH);
ZeroMemory(@Result[1], MAX_PATH);
SetLength(Result, GetModuleFileNameEx(h, 0, @Result[1], MAX_PATH));
finally
CloseHandle(h);
end;
Result := LowerCase(Result);
end;
////////////////////////////////////////////////////////////////////////////////
function KeyboardThread(dwArg: DWORD): DWORD;
var
nEvents : Cardinal;
dwNumRead: DWORD;
InputRec : TInputRecord;
begin
Result := 0;
while (true)
do
begin
GetNumberOfConsoleInputEvents(GetStdHandle(STD_INPUT_HANDLE), nEvents);
if (nEvents > 0)
then
begin
ReadConsoleInput(GetStdHandle(STD_INPUT_HANDLE), InputRec, 1, dwNumRead);
if (InputRec.Event.KeyEvent.AsciiChar = '
q')
then break;
end;
Sleep(800);
end;
writeln('
# shutting down, please wait...');
SetEvent(m_hShutDownEvent);
ExitThread(0);
end;
////////////////////////////////////////////////////////////////////////////////
function WaitForState(dwDesiredState: DWORD; pss: SERVICE_STATUS): Boolean;
var
dwWaitHint: DWORD;
begin
Result := False;
if (m_hDriver <> 0)
then
while (True)
do
begin
// Get current state of driver
Result := QueryServiceStatus(m_hDriver, pss);
// If we can't query the driver, we're done
if not(Result)
then
break;
// If the driver reaches the desired state
if (pss.dwCurrentState = dwDesiredState)
then
break;
// We're not done, wait the specified period of time
dwWaitHint := pss.dwWaitHint
div 10;
// Poll 1/10 of the wait hint
if (dwWaitHint < 1000)
then dwWaitHint := 1000;
// At most once a second
if (dwWaitHint > 10000)
then dwWaitHint := 10000;
// At least every 10 seconds
Windows.Sleep(dwWaitHint);
end;
end;
////////////////////////////////////////////////////////////////////////////////
procedure RetrieveProcessInfo(hDriver: THandle; CallbackInfo, CallbackTemp: PCallbackInfo);
var
dwBytesReturned: DWORD;
ov : OVERLAPPED;
begin
ZeroMemory(@ov, SizeOf(OVERLAPPED));
dwBytesReturned := 0;
ov.hEvent := CreateEvent(
nil, True, False,
nil);
if DeviceIoControl(hDriver, IOCTL_PROCVIEW_GET_PROCINFO,
nil, 0, @CallbackInfo^, SizeOf(TCallbackInfo), dwBytesReturned, @ov)
then
GetOverlappedResult(m_hDriver, ov, dwBytesReturned, True)
else
writeln('
! Error while DeviceIoControl, code: ' + IntToStr(GetLastError));
if ((callbackTemp^.ParentId <> callbackInfo^.ParentId)
or (callbackTemp^.ProcessId <> callbackInfo^.ProcessId)
or (callbackTemp^.bCreate <> callbackInfo^.bCreate))
then
begin
if(callbackInfo^.bCreate)
then
begin
Sleep(300);
// sleep some ms or image name could not be determinated :-(
writeln('
# process created, PID : ' + IntToStr(callbackInfo^.ProcessId) + '
' + GetExeNameByPID(callbackInfo.ProcessId))
end else
writeln('
# process terminated, PID: ' + IntToStr(callbackInfo^.ProcessId));
end;
CloseHandle(ov.hEvent);
// Store the data for next time to prevent doubled events
callbackTemp^ := callbackInfo^;
end;
////////////////////////////////////////////////////////////////////////////////
procedure ProcessMonitor;
var
szDriverName :
String;
hDriver : THandle;
m_hProcessEvent: THandle;
CallbackInfo : TCallbackInfo;
CallbackTemp : TCallbackInfo;
lpHandles : TWOHandleArray;
dwResult : DWORD;
dwThreadID : DWORD;
begin
szDriverName := '
\\.\Global\NTProcDrv'#0;
// Change to '\\.\NTProcDrv'#0 if CreateFile failes...
hDriver := CreateFile(@szDriverName[1], GENERIC_READ
or GENERIC_WRITE, FILE_SHARE_READ
or FILE_SHARE_WRITE,
nil, OPEN_EXISTING, FILE_FLAG_OVERLAPPED, 0);
if (hDriver <> INVALID_HANDLE_VALUE)
then
begin
m_hShutdownEvent := CreateEvent(
nil, False, False,
nil);
m_hProcessEvent := OpenEvent(SYNCHRONIZE, False, '
NTProcDrvProcessEvent');
ZeroMemory(@lpHandles, SizeOf(lpHandles));
lpHandles[0] := m_hShutdownEvent;
lpHandles[1] := m_hProcessEvent;
CreateThread(
nil, 0, @KeyboardThread,
nil, 0, dwThreadID);
ZeroMemory(@CallbackInfo, SizeOf(TCallbackInfo));
ZeroMemory(@CallbackTemp, SizeOf(TCallbackInfo));
while (True)
do
begin
dwResult := WaitForMultipleObjects(2, @lpHandles, False, INFINITE);
if (dwResult = 0)
then
break;
// user pressed 'q'
RetrieveProcessInfo(hDriver, @CallbackInfo, @CallbackTemp);
end;
Sleep(1000);
// ExitThread(0) and cleaning stack might take some ms
CloseHandle(m_hProcessEvent);
CloseHandle(m_hShutdownEvent);
CloseHandle(hDriver);
end;
end;
////////////////////////////////////////////////////////////////////////////////
begin
writeln('
# opening Servive Control Manager (SCM)...');
m_hSCM := OpenSCManager(
nil,
nil, SC_MANAGER_ALL_ACCESS);
if (m_hSCM <> 0)
then
begin
writeln('
# opened SCM');
strFileName := ExtractFilePath(ParamStr(0)) + strServiceName + '
.sys';
m_hDriver := OpenService(m_hSCM, PChar(strServiceName), SERVICE_ALL_ACCESS);
if (m_hDriver <> 0)
then
begin
if ControlService(m_hDriver, SERVICE_CONTROL_STOP, nServiceStatus)
then
WaitForState(SERVICE_STOPPED, nServiceStatus);
DeleteService(m_hDriver);
CloseServiceHandle(m_hDriver);
writeln('
! driver was not deleted last time.');
CloseServiceHandle(m_hDriver);
Sleep(1000);
end;
m_hDriver := CreateService(m_hSCM, PChar(strServiceName), PChar(strDisplayName), SERVICE_ALL_ACCESS, SERVICE_KERNEL_DRIVER, SERVICE_DEMAND_START, SERVICE_ERROR_NORMAL, PChar(strFilename),
nil,
nil,
nil,
nil,
nil);
if (m_hDriver <> 0)
then
begin
writeln('
# service created, starting kernel driver...');
if (StartService(m_hDriver, 0, lpServiceArgVectors))
then
WaitForState(SERVICE_RUNNING, nServiceStatus)
else begin
DeleteService(m_hDriver);
CloseServiceHandle(m_hDriver);
CloseServiceHandle(m_hSCM);
writeln('
! error while starting driver');
exit;
end;
writeln('
# kernel driver started');
// interact with driver now...
ProcessMonitor;
writeln('
# stopping kernel driver...');
if ControlService(m_hDriver, SERVICE_CONTROL_STOP, nServiceStatus)
then
WaitForState(SERVICE_STOPPED, nServiceStatus)
else
writeln('
! could not stop kernel driver');
// Mark the service for deletion.
if DeleteService(m_hDriver)
then
writeln('
# service deleted')
else
writeln('
! could not delete service');
CloseServiceHandle(m_hDriver);
end;
CloseServiceHandle(m_hSCM);
end;
Sleep(1000);
end.