unit DevDrv; { Installing, Loading, Starting, Stopping, Unloading of service using SCM }
{
  (C) 2000 - 2002 Jindrich Jindrich, Pavel Pisa, PiKRON Ltd.

  Originators of the CHROMuLAN project:

  Jindrich Jindrich - http://www.jindrich.com
                      http://orgchem.natur.cuni.cz/Chromulan/
                      software developer, project coordinator
  Pavel Pisa        - http://cmp.felk.cvut.cz/~pisa
                      embeded software developer
  PiKRON Ltd.       - http://www.pikron.com
                      project initiator, sponsor, instrument developer

  The CHROMuLAN project is distributed under the GNU General Public Licence.
  See file COPYING for details.

  Originators reserve the right to use and publish sources
  under different conditions too. If third party contributors
  do not accept this condition, they can delete this statement
  and only GNU license will apply.
}

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

