CTL_CODE Funktion in Delphi

[peanut]

Hallo,

anbei der Code zum Thema. Ich habe ihn überarbeitet und festgestellt, dass es auch ohne packed-Deklaration funktioniert.

Delphi-Quellcode:

{
  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.