unit DevDrv;
interface
uses Windows, WinSvc, PBSystem;

type
  TDevDrv = class
  private
    HomeDir         : string;
    DriverDir       : string;
    DriverName      : string;
    DriverPath      : string; // the whole thing
    hSCMan          : SC_HANDLE; // Service Control Manager
    hDevice         : SC_HANDLE; // Handle for device

    FDeviceType: integer;
    FLastResult: DWORD;
    FInstalled: boolean;
      { Must have been the device driver loaded to memory before starting?
        Used in DeviceStart/DeviceStop calls. }
    FStarted: boolean;
      { Must have been the device driver started during DeviceStart call? }

    //---------------------------------------
    // private multi-func funcs called by public ones
    //---------------------------------------
    {function IOCTL_IOPMD_Misc1(var RetVal: DWORD; Cmd: integer):  DWORD;
    function IOCTL_IOPMD_GET_SET_LIOPM(Addr: Word; var B: byte; cmd: integer): DWORD;}
  public
    {LastOutBuf      : longint;}
    constructor Create(const ADriverName: string; ADeviceType: integer);
      { if ADriverName = '' then gwiopm is used;
        if ADeviceType = 0 then IOPMD_TYPE is used
        (needed only for DeviceOpen - in descendants) }
    //---------------------------------------
    // Interact with Service Control Manager
    //---------------------------------------
    function OpenSCM: DWORD;
    function CloseSCM: DWORD;
    //---------------------------------------
    // Install/Start/Stop/Remove driver
    //---------------------------------------
    function Install(const NewDriverPath: string): DWORD; { use '' for default }
      { Install device drive into memory, get ready for Start call }
    function Start:   DWORD;
      { Start intalled device driver }
    function Stop:    DWORD;
      { Stop device driver started by Start call }
    function Remove:  DWORD;
      { Remove the device driver from memory (must not be running, i.e. call
        Stop first) }

    //--------------------------------
    // Device Open/Close
    //--------------------------------
    function DeviceOpen: DWORD;
      { Get a valid hDevice to already loaded device;
         used by descendant classes to interract with the device driver }
    function DeviceClose: DWORD;
      { close the handle obtained by the DeviceOpen }
    function GetState(var AState:DWORD): DWORD;

    function CheckDeviceLoaded: DWord;
      { Makes sure the device is loaded (does not start it, if was
        already loaded leave it in its current state). }

    function CheckDeviceUnloaded: DWord;
      { Makes sure the device is unloaded. If was started stops it first. }

    function CheckDeviceStarted: DWord;
      { All in one call: calls OpenSCM, Install (if needed), Start (if needed),
        CloseSCM - makes sure that the device driver is loaded in the memory
        and started - ready for other programs to access it. }
    function CheckDeviceStopped(ForceStop: boolean; ForceUnload: boolean): DWORD;
      { Other all in one: calls OpenSCM, Stop (if was started by CheckDeviceStarted
        or ForceStop is true), Remove (if Install was called in previous CheckDeviceStarted
        (or ForceUnload is true) - remove the device driver from memory if it
        was not there before) }
    //--------------------------------
    function GetStateMsg(AState:DWORD): string;
    function ErrorLookup(ErrorNum: integer): string;
    function LastResultMsg: string;
      { returns string name of the last result value }
  end;

const
  { Defaults: }
  DEVICE_NAME_STRING	= 'gwiopm';
    // in application's home directory
  // Device type           -- in the "User Defined" range."
  IOPMD_TYPE = $F100;

  // The IOCTL function codes from 0x800 to 0xFFF are for non-Microsoft use.
  // Test functions
  IOCMD_IOPMD_READ_TEST        = $900;
  IOCMD_IOPMD_READ_VERSION     = $901;
  // Manipulate driver's local IOPM (LIOPM)
  IOCMD_IOPMD_CLEAR_LIOPM      = $910;
  IOCMD_IOPMD_SET_LIOPM        = $911;
  IOCMD_IOPMD_GET_LIOPMB       = $912;
  IOCMD_IOPMD_GET_LIOPMA       = $913;
  // Interact with kernel IOPM (KIOPM)
  IOCMD_IOPMD_ACTIVATE_KIOPM   = $920;
  IOCMD_IOPMD_DEACTIVATE_KIOPM = $921;
  IOCMD_IOPMD_QUERY_KIOPM      = $922;

Var
  DrvLoader: TDevDrv;

//-------------------------------------------
implementation
//-------------------------------------------
uses SysUtils;

Const // from ntddk
// Service Types (Bit Mask)
  SERVICE_KERNEL_DRIVER        =  $00000001;
  SERVICE_FILE_SYSTEM_DRIVER   =  $00000002;
  SERVICE_ADAPTER              =  $00000004;
  SERVICE_RECOGNIZER_DRIVER    =  $00000008;

  SERVICE_DRIVER               =  SERVICE_KERNEL_DRIVER OR
                                  SERVICE_FILE_SYSTEM_DRIVER OR
                                  SERVICE_RECOGNIZER_DRIVER;

  SERVICE_WIN32_OWN_PROCESS    =  $00000010;
  SERVICE_WIN32_SHARE_PROCESS  =  $00000020;
  SERVICE_WIN32                =  SERVICE_WIN32_OWN_PROCESS OR
                                  SERVICE_WIN32_SHARE_PROCESS;

  SERVICE_INTERACTIVE_PROCESS  =  $00000100;

  SERVICE_TYPE_ALL             =  SERVICE_WIN32   OR
                                  SERVICE_ADAPTER OR
                                  SERVICE_DRIVER  OR
                                  SERVICE_INTERACTIVE_PROCESS;
// Start Type
  SERVICE_BOOT_START           =  $00000000;
  SERVICE_SYSTEM_START         =  $00000001;
  SERVICE_AUTO_START           =  $00000002;
  SERVICE_DEMAND_START         =  $00000003;
  SERVICE_DISABLED             =  $00000004;

// Error control type
  SERVICE_ERROR_IGNORE         =  $00000000;
  SERVICE_ERROR_NORMAL         =  $00000001;
  SERVICE_ERROR_SEVERE         =  $00000002;
  SERVICE_ERROR_CRITICAL       =  $00000003;

Type
  TErrorMsg = record
    Num: integer;
    Msg: string;
  end;

Const
  ErrorMsgCt = 30;
  ERROR_SCM_CANT_CONNECT = 9998;
  ERROR_NO_DEVICE_HANDLE = 9997;
  ERROR_GW_BUFFER_TOO_SMALL = 9997;
  ERROR_UNEXPECTED = 9999;

  ErrorMsgs: array[1..ErrorMsgCt] of TErrorMsg = (
    (Num: ERROR_SUCCESS                   ; Msg: 'Operation was successful'),
    (Num: ERROR_INVALID_FUNCTION          ; Msg: 'Invalid Function'),
    (Num: ERROR_ACCESS_DENIED             ; Msg: 'Access denied'),
    (Num: ERROR_CIRCULAR_DEPENDENCY       ; Msg: 'Circular dependency'),
    (Num: ERROR_DATABASE_DOES_NOT_EXIST   ; Msg: 'Database doesn''t exist'),
    (Num: ERROR_DEPENDENT_SERVICES_RUNNING; Msg: 'Dependent services running'),
    (Num: ERROR_DUP_NAME                  ; Msg: 'Display name already exists'),
    (Num: ERROR_INVALID_HANDLE            ; Msg: 'Invalid handle'),
    (Num: ERROR_INVALID_NAME              ; Msg: 'Invalid service name'),
    (Num: ERROR_INVALID_PARAMETER         ; Msg: 'Invalid Parameter'),
    (Num: ERROR_INVALID_SERVICE_ACCOUNT   ; Msg: 'User account doesn''t exist'),
    (Num: ERROR_INVALID_SERVICE_CONTROL   ; Msg: 'Invalid service control code'),
    (Num: ERROR_PATH_NOT_FOUND            ; Msg: 'Path not found'),
    (Num: ERROR_SERVICE_ALREADY_RUNNING   ; Msg: 'Service already running'),
    (Num: ERROR_SERVICE_CANNOT_ACCEPT_CTRL; Msg: 'Service can''t accept control'),
    (Num: ERROR_SERVICE_DATABASE_LOCKED   ; Msg: 'The database is locked'),
    (Num: ERROR_SERVICE_DEPENDENCY_DELETED; Msg: 'Depends on nonexistant service'),
    (Num: ERROR_SERVICE_DEPENDENCY_FAIL   ; Msg: 'Depends on service that failed'),
    (Num: ERROR_SERVICE_DISABLED          ; Msg: 'Service has been disabled'),
    (Num: ERROR_SERVICE_DOES_NOT_EXIST    ; Msg: 'Service doesn''t exist'),
    (Num: ERROR_SERVICE_EXISTS            ; Msg: 'Service already exists'),
    (Num: ERROR_SERVICE_LOGON_FAILED      ; Msg: 'Service couldn''t be logged on'),
    (Num: ERROR_SERVICE_MARKED_FOR_DELETE ; Msg: 'Service marked for deletion'),
    (Num: ERROR_SERVICE_NO_THREAD         ; Msg: 'Couldn''t create thread'),
    (Num: ERROR_SERVICE_NOT_ACTIVE        ; Msg: 'Service hasn''t been started'),
    (Num: ERROR_SERVICE_REQUEST_TIMEOUT   ; Msg: 'Service timed out'),
    (Num: ERROR_GW_BUFFER_TOO_SMALL       ; Msg: 'Buffer too small'),
    (Num: ERROR_NO_DEVICE_HANDLE          ; Msg: 'No device handle'),
    (Num: ERROR_SCM_CANT_CONNECT          ; Msg: 'Can''t connect to Service Control Manager'),
    (Num: ERROR_UNEXPECTED                ; Msg: 'An unexpected error occured')
  );

//-----------------------------------------
function TDevDrv.ErrorLookup(ErrorNum: integer): string;
//-----------------------------------------
Var
  S: string;
  N: integer;
label foundit;
Begin
  S := '';
  If ErrorNum <> ERROR_SUCCESS then
    S := 'Error: ' + IntToStr(ErrorNum) + ': ';
  For N := 1 to ErrorMsgCt do
  Begin
    if ErrorNum = ErrorMsgs[N].Num then
    Begin
      goto foundit;
    end;
  end;
  {v0.11}
  N := ErrorMsgCt;
  {/v0.11}
foundit:
  {v0.11}{/v0.11
  If N > ErrorMsgCt then begin
    N := ErrorMsgCt;
  end;}
  S := S + ErrorMsgs[N].Msg;
  result := S;
end;

//----------------------------------------------------------
// IOCTL codes
//----------------------------------------------------------
function CTL_CODE(DeviceType: integer; func: integer; meth: integer; access: integer): DWORD;
Begin
  result := (DeviceType shl 16) or (Access shl 14) or (func shl 2) or (meth);
end;

Const
  // Buffering method for user-mode app talking to drive
  METHOD_BUFFERED    = 0;
  METHOD_IN_DIRECT   = 1;
  METHOD_OUT_DIRECT  = 2;
  METHOD_NEITHER     = 3;

  // Define the access allowed
  FILE_ANY_ACCESS    = 0;
  FILE_READ_ACCESS   = 1;     // file & pipe
  FILE_WRITE_ACCESS  = 2;     // file & pipe


//-----------------------------------------
constructor TDevDrv.Create(const ADriverName: string; ADeviceType: integer);
//-----------------------------------------
var
  dir, fn: string;
  pb: TPBSystemPath;
Begin
  pb := TPBSystemPath.Create(nil);
  try
    hSCMan  := 0;
    hDevice := INVALID_HANDLE_VALUE;
    HomeDir := '';
    if ADriverName = '' then begin
      DriverName  := DEVICE_NAME_STRING;
      dir := '';
    end else begin
      dir := ExtractFilePath(ADriverName);
      DriverName := ExtractFileName(ADriverName);
    end;
    if dir <> '' then begin
      HomeDir := dir;
    end else begin
      fn := FileSearch(ADriverName + '.sys',
        '.;' + ExtractFilePath(ParamStr(0)) + ';' + pb.System + '\drivers');
      if fn <> '' then begin
        HomeDir := ExtractFilePath(fn);
        if HomeDir = '' then
          HomeDir := ExtractFilePath(ExpandFileName(fn));
      end;
    end;
      // default driver name needed by stop/remove if install wasn't executed
      // this run (ie: driver already installed
    if ADeviceType = 0 then
      FDeviceType := IOPMD_TYPE
    else
      FDeviceType := ADeviceType;
  finally
    pb.Free;
  end;
end;

//-------------------------------------------
function TDevDrv.OpenSCM:  DWORD;
//-------------------------------------------
Begin
  if hSCMan <> 0 then
    CloseSCM;
  FLastResult := ERROR_SUCCESS;
  hSCMan := OpenSCManager(nil, nil, SC_MANAGER_ALL_ACCESS);
  if hSCMan = 0 then
    FLastResult := ERROR_SCM_CANT_CONNECT;
  Result := FLastResult;
end;

//-------------------------------------------
function TDevDrv.CloseSCM:  DWORD;
//-------------------------------------------
Begin
{  FLastResult := ERROR_SUCCESS;}
  CloseServiceHandle(hSCMan);
  hSCMan := 0;
  Result := ERROR_SUCCESS;{FLastResult;}
end;

//-----------------------------------------
function TDevDrv.Install(const NewDriverPath: string): DWORD; { use '' for default }
//-----------------------------------------
Var
  hService: SC_HANDLE;
Begin
{  hService := 0;}
  FLastResult := 0;

  If NewDriverPath = '' then
  Begin
    DriverDir   := HomeDir;
    {DriverName  := DEVICE_NAME_STRING;}
  end else begin
    DriverDir  := ExtractFilePath(NewDriverPath);
    DriverName := ExtractFileName(NewDriverPath);
  end;
  DriverPath  := DriverDir + DriverName + '.SYS';

   // add to service control manager's database
   hService := CreateService(hSCMan, PChar(DriverName),PChar(DriverName),
              SERVICE_ALL_ACCESS, SERVICE_KERNEL_DRIVER, SERVICE_DEMAND_START,
              SERVICE_ERROR_NORMAL, PChar(DriverPath),
              nil, nil, nil, nil, nil);
   if (hService = 0) then
   Begin
     FLastResult := GetLastError();
   end else
   Begin
     CloseServiceHandle(hService);
   end;
   if FLastResult = 0 then
     FInstalled := true;

   result := FLastResult;
end;

//-------------------------------------------
function TDevDrv.Start:   DWORD;
//-------------------------------------------
Var
  hService: SC_HANDLE;
  lpServiceArgVectors: PChar;
  temp: LongBool;
Begin
{  hService := 0;}
  FLastResult := 0;
  lpServiceArgVectors := nil;
  // get a handle to the service
  hService := OpenService(hSCMan, PChar(DriverName), SERVICE_ALL_ACCESS);
  if hService <> 0 then
  Begin
    // start the driver
    temp := StartService(hService, 0, PChar(lpServiceArgVectors));
    if not temp then
      FLastResult := GetLastError();
  end else
    FLastResult := GetLastError();
  if (hService <> 0) then
    CloseServiceHandle(hService);
  if FLastResult = 0 then
    FStarted := true;
  Result := FLastResult;
end;

//-------------------------------------------
function TDevDrv.Stop:    DWORD;
//-------------------------------------------
Var
  hService: SC_HANDLE;
  serviceStatus: TServiceStatus;
  temp: LongBool;
  shouldStop: boolean;
Begin
{  hService := 0;}
  FLastResult := 0;
  // get a handle to the service
  hService := OpenService(hSCMan, PChar(DriverName), SERVICE_ALL_ACCESS);
  if hService <> 0 then
  Begin
    shouldStop := true;
    // stop the driver
    if QueryServiceStatus(hService, serviceStatus) then begin
      if serviceStatus.dwCurrentState = SERVICE_STOPPED then
        shouldStop := false;
    end;
    if shouldStop then begin
      temp := ControlService(hService, SERVICE_CONTROL_STOP, serviceStatus);
      if not temp then
        FLastResult := GetLastError();
    end;
  end else
    FLastResult := GetLastError();
  if (hService <> 0) then
    CloseServiceHandle(hService);
  Result := FLastResult;
end;

//-------------------------------------------
function TDevDrv.Remove:  DWORD;
//-------------------------------------------
Var
  hService: SC_HANDLE;
  temp: LongBool;
Begin
{  hService := 0;}
  FLastResult := 0;

  FLastResult := Stop;  // ignore result
  FLastResult := 0;

  // get a handle to the service
  hService := OpenService(hSCMan, PChar(DriverName), SERVICE_ALL_ACCESS);
  if hService <> 0 then
  Begin
    temp := DeleteService(hService);
    if not temp then
      FLastResult := GetLastError();
  end else
    FLastResult := GetLastError();

  if (hService <> 0) then
    CloseServiceHandle(hService);
  result := FLastResult;
end;

//=============================================================
// Device Open/Close functions
//=============================================================

//-------------------------------------------
function TDevDrv.DeviceOpen:  DWORD;
//-------------------------------------------
Var
  dn: array[0..255] of char;
Begin
  FLastResult := 0;
  if hDevice <> INVALID_HANDLE_VALUE then
    DeviceClose;
  StrPCopy(dn,'\\.\' + DriverName);
  // get a handle to the device
  hDevice := CreateFile(
             { lpFileName: PChar            } dn,
             { dwDesiredAccess: integer     } GENERIC_READ or GENERIC_WRITE,
             { dwShareMode: Integer         } 0,
             { lpSecurityAttributes         } PSECURITY_DESCRIPTOR(nil),
             { dwCreationDisposition: DWORD } OPEN_EXISTING,
             { dwFlagsAndAttributes: DWORD  } FILE_ATTRIBUTE_NORMAL,
             { hTemplateFile: THandle       } 0);

  if hDevice = INVALID_HANDLE_VALUE then
  Begin
    FLastResult := GetLastError();
  end;
  Result := FLastResult;
end;

//-------------------------------------------
function TDevDrv.DeviceClose:  DWORD;
//-------------------------------------------
Begin
  FLastResult := 0;
  if (hDevice <> INVALID_HANDLE_VALUE) then
    CloseHandle(hDevice);
  hDevice := INVALID_HANDLE_VALUE;
  result := FLastResult; { assume that it went OK? }
end;

function TDevDrv.GetState(var AState:DWORD): DWORD;
var
  hService: SC_HANDLE;
  serviceStatus: TServiceStatus;
Begin
{  hService := 0;}
  FLastResult := OpenSCM;
  AState := $FFFF;
  if FLastResult = 0 then begin
    hService := OpenService(hSCMan, PChar(DriverName), SERVICE_ALL_ACCESS);
    if hService <> 0 then begin
      if QueryServiceStatus(hService, serviceStatus) then begin
        AState := serviceStatus.dwCurrentState;
      end else begin
        FLastResult := GetLastError();
      end;
      if not CloseServiceHandle(hService) then
        FLastResult := GetLastError();
    end else begin
      FLastResult := GetLastError();
    end;
    CloseSCM;
  end;
  Result := FLastResult;
end;

{DoXXXX}
function TDevDrv.CheckDeviceLoaded: DWord;
  { Makes sure the device is loaded (does not start it, if was
   already loaded leave it in its current state). }
begin
  Result := OpenSCM;
  if Result = 0 then begin
    Result := Install('');
    if (Result = 0) or (Result = ERROR_SERVICE_EXISTS) then begin
      Result := 0;
    end;
    CloseSCM;
  end;
end;

function TDevDrv.CheckDeviceUnloaded: DWord;
  { Makes sure the device is unloaded. If was started stops it first. }
begin
  FLastResult := OpenSCM;
  if FLastResult = 0 then begin
    FLastResult := Stop;
    if (FLastResult = 0) then begin
      FLastResult := Remove;
    end else if (FLastResult = ERROR_SERVICE_DOES_NOT_EXIST) then begin
      FLastResult := 0;
    end;
    CloseSCM;
  end;
  Result := FLastResult;
end;

function TDevDrv.CheckDeviceStarted: DWord;
      { All in one call: calls OpenSCM, Install (if needed), Start ,CloseSCM -
        loads device driver to memory, get it ready for other programs }
begin
  Result := OpenSCM;
  if Result = 0 then begin
    Result := Install('');
    if (Result = 0) or (Result = ERROR_SERVICE_EXISTS) then begin
      Result := Start;
      if Result = ERROR_SERVICE_ALREADY_RUNNING then
        Result := 0;
    end;
    CloseSCM;
  end;
end;

function TDevDrv.CheckDeviceStopped(ForceStop: boolean; ForceUnload: boolean): DWORD;
 { Other all in one: calls OpenSCM, Stop, Remove (if Install was called
   in previous DeviceStart - remove the device driver from memory
   if it was not there before) }
begin
  FLastResult := 0;
  if FStarted or ForceStop or ForceUnload then begin
    FLastResult := OpenSCM;
    if FLastResult = 0 then begin
      FLastResult := Stop;
      if (FLastResult = 0) then begin
        if FInstalled or ForceUnload then begin
          FLastResult := Remove;
        end;
      end else if (FLastResult = ERROR_SERVICE_DOES_NOT_EXIST) then begin
        FLastResult := 0;
      end;
      CloseSCM;
    end;
  end;
  Result := FLastResult;
end;

function TDevDrv.LastResultMsg: string;
begin
  Result := ErrorLookup(FLastResult);
end;

function TDevDrv.GetStateMsg(AState:DWORD): string;
begin
  Result := 'Unknown';
  case AState of
    SERVICE_STOPPED: Result := 'Stopped';
    SERVICE_START_PENDING: Result := 'Starting';
    SERVICE_STOP_PENDING: Result := 'Stopping';
    SERVICE_RUNNING: Result := 'Running';
    SERVICE_CONTINUE_PENDING: Result := 'Continue is pending';
    SERVICE_PAUSE_PENDING: Result := 'Pause is pending';
    SERVICE_PAUSED: Result := 'Paused';
  end;
end;

//-------------------------------------------
initialization
//-------------------------------------------
{  DrvLoader := TDevDrv.Create;}
//-------------------------------------------
finalization
//-------------------------------------------

end.

