{*******************************************************}
{                                                       }
{       nrCommLib Communication Library for Delphi      }
{       Driver Development Base for Win32               }
{       Copyright (c) 1997-2011 Roman Novgorodov        }
{       v9.27                                           }
{       last update: 07 Jun 2006                        }
{                                                       }
{       e-mail:noro@deepsoftware.com                    }
{       DeepSoftware                                    }
{       http://www.deepsoftware.com/                    }
{                                                       }
{*******************************************************}
{$I nrcommlib.inc}
unit nrddbasew32;
interface
Uses Windows, nrclasses,
     WinSvc, Dialogs, nrwin32, SysUtils;
Type

  TnrDriverBase = class
  private
    fOnFatalError: TOnFatalErrorEvent;
    fLog: TnrCustomLogFile;
  protected
    fDeviceName:string;
    fDriverFileName:string;
    fResName:string;
    fHandle:THandle;
    procedure DoFatalErrors(Code,Detail:cardinal;Msg:string);virtual;
    procedure Logging(Det: TDetailLevel; Mess: string);
    function GetLicx: dword;

  public
    constructor Create; virtual;
    destructor Destroy; override;
    function Open:THandle; virtual;
    procedure Close; virtual;

    function CreateService: boolean;
    function RemoveService: boolean;

    function StartService: boolean;
    function StopService: boolean;

    property DeviceName:string read fDeviceName;
    property DriverFileName:string read fDriverFileName;
    property ResName:string read fResName;
    property Handle:THandle read fHandle;
    property Log : TnrCustomLogFile read fLog write fLog;
    property OnFatalError:TOnFatalErrorEvent read fOnFatalError write fOnFatalError;

  end;

implementation
uses nrwin32di, nrsysutils;

Const
  ECC_DDBASE = 7;
  ECS_DDBASE_CREATE_SERVICE     = 'Create service failed.';
  ECS_DDBASE_START_SERVICE      = 'Start service failed.';

{$IFDEF GEN3}
  SERVICE_KERNEL_DRIVER         = $00000001;
  SERVICE_DEMAND_START          = $00000003;
  SERVICE_ERROR_NORMAL          = $00000001;
{$ENDIF}

              
constructor TnrDriverBase.Create;
begin
  inherited Create;
  fHandle := INVALID_HANDLE_VALUE;
end;

destructor TnrDriverBase.Destroy;
begin
  Close;
  inherited Destroy;
end;

procedure TnrDriverBase.DoFatalErrors(Code, Detail: cardinal; Msg: string);
var fRaise:boolean;
begin
  fRaise := True;
  Logging(dlSimple, Msg);
  if Assigned(fOnFatalError) then fOnFatalError(Self,Code,Detail,Msg,fRaise);
  if fRaise then raise Exception.Create(Msg);
end;

function TnrDriverBase.CreateService: Boolean;
var hSCMan, hService: SC_HANDLE;
    s, sDir:string;
    dwEr:cardinal;
    flWow64:boolean;
begin
  Result := False;
  flWow64 := IsWow64();

//  StopService( );
//  RemoveService();
  Logging(dlDebug, 'CreateService ...');
  if not FileExists(fDriverFileName) then begin
    if Length(ResName) = 0 then exit;
    if Length(fDriverFileName) = 0 then begin
      SetLength(sDir, MAX_PATH + 2);
      SetLength(sDir, GetTempPath(MAX_PATH, PChar(sDir)));
      if sDir[Length(sDir)] <> '\' then sDir := sDir + '\';
      fDriverFileName := sDir + DeviceName + '.sys';
    end;

    if (SizeOf(THandle) = 8) or flWow64 then s := 'x64' else s := '';
    if not CreateFileFromRes(ResName + s, fDriverFileName) then exit;
  end;

  if flWow64 then begin
    Logging(dlDebug,'WOW64 mode ...');
    sDir := ExtractFilePath(fDriverFileName);

    // extract x64stub app from resources ...
    CreateFileFromRes('nrx64stub', sDir + CS_x64stub_exe);

    RunProcess(GetMainWindowHandle,
         Format('"%s%s" "%s" "%s" "1" "1"',
         [sDir, CS_x64stub_exe, fDriverFileName, fDeviceName]),
          sDir, True, True);
    dwEr := GetLastError;
    Result := dwEr = ERROR_SUCCESS;
    Logging(dlDebug, 'x64 stub finished. Error Code : ' + IntToHex(dwEr, 8));
    exit;
  end;

//  RemoveService();

  hSCMan := WinSvc.OpenSCManager(Nil,Nil,
  {SC_MANAGER_CONNECT}
  SC_MANAGER_CREATE_SERVICE
  {SC_MANAGER_ALL_ACCESS});
  If hSCMan = 0 then begin
    Logging(dlSimple, 'OpenSCManager fails: ' + SysErrorMessage(GetLastError()));
    Exit;
  end;

  hService := WinSvc.CreateService(hSCMan, PChar(fDeviceName),PChar(fDeviceName),
      //SERVICE_ALL_ACCESS
      SERVICE_START
      //SC_MANAGER_CONNECT
      , SERVICE_KERNEL_DRIVER,
      SERVICE_DEMAND_START, SERVICE_ERROR_NORMAL,
      PChar(fDriverFileName),
      nil,nil,nil,nil,nil);

  If hService = 0 then begin
    dwEr := GetLastError();
    if (dwEr <> ERROR_SERVICE_EXISTS) then begin
      CloseServiceHandle(hSCMan);
      Exit;
    end;
    Logging(dlSimple, 'CreateService fails: ' + IntToHex(dwEr, 8) + ' ' + SysErrorMessage(dwEr));
  End;

  if hService <> 0 then WinSvc.CloseServiceHandle(hService);
  WinSvc.CloseServiceHandle(hSCMan);

  Result:= True;
end;

function TnrDriverBase.RemoveService : Boolean;
var hSCMan, hService : SC_HANDLE;
    flWow64:boolean;
    sDir:string;
begin
  //Result:= False;
  //StopService();
  Logging(dlDebug, 'RemoveService ...');

  flWow64 := IsWow64();

  if flWow64 then begin
    Logging(dlDebug,'WOW64 mode ...');
    sDir := ExtractFilePath(fDriverFileName);
    RunProcess(GetMainWindowHandle,
         Format('"%s%s" "%s" "%s" "2" "1"',
         [sDir, CS_x64stub_exe, fDriverFileName, fDeviceName]),
          sDir, True, True);
//    Result := GetLastError = ERROR_SUCCESS;
    Logging(dlDebug, 'x64 stub finished.');
    DeleteFile(sDir + CS_x64stub_exe);
  end else begin
    Logging(dlDebug,'32bit mode ...');
    hSCMan:= WinSvc.OpenSCManager(Nil,Nil,SC_MANAGER_ALL_ACCESS);
    if hSCMan <> 0 then begin
      hService := WinSvc.OpenService(hSCMan, PChar(fDeviceName), SERVICE_ALL_ACCESS);
      If hService <> 0 then begin
        WinSvc.DeleteService(hService);
        WinSvc.CloseServiceHandle(hService);
      End;
      WinSvc.CloseServiceHandle(hSCMan);
    end;
  end;

  if FileExists(fDriverFileName) then DeleteFile(fDriverFileName);

  Result:= True;
end;

function TnrDriverBase.StartService  : Boolean;
var lpServiceArgVectors : PChar;
    hSCMan, hService : SC_HANDLE;
begin
  Result:= False;
  Logging(dlDebug, 'StartService ...');
  hSCMan  := WinSvc.OpenSCManager(Nil, Nil, SC_MANAGER_CONNECT);
  if hSCMan = 0 then Exit;
  hService:= WinSvc.OpenService(hSCMan,PChar(fDeviceName), SERVICE_START);
  if hService = 0 then begin
    CloseServiceHandle(hSCMan);
    Exit;
  end;
  lpServiceArgVectors:=nil;
  WinSvc.StartService(hService, 0, lpServiceArgVectors);
  WinSvc.CloseServiceHandle(hService);
  WinSvc.CloseServiceHandle(hSCMan);
  Result := True;
end;

function TnrDriverBase.StopService   : Boolean;
var serviceStatus    : TServiceStatus;
    hSCMan, hService : SC_HANDLE;
begin
  Result := False;
  hSCMan := WinSvc.OpenSCManager(Nil, Nil, SC_MANAGER_CONNECT);
  If hSCMan = 0 then Exit;

  hService := WinSvc.OpenService(hSCMan,PChar(fDeviceName), SERVICE_STOP);
  If hService = 0 then begin
    WinSvc.CloseServiceHandle(hSCMan);
    Exit;
  End;

  WinSvc.ControlService(hService, SERVICE_CONTROL_STOP, serviceStatus);
  WinSvc.CloseServiceHandle(hService);
  WinSvc.CloseServiceHandle(hSCMan);
  Result := True;
End;

function TnrDriverBase.Open: THandle;
//var err:dword;
begin
  Logging(dlDebug, 'Open()');
  if Handle = INVALID_HANDLE_VALUE then begin
    Result := INVALID_HANDLE_VALUE;
    if not CreateService then begin
     // err := GetLastError;
      //OutputDebugString(PChar('0:' + IntToHex(err, 8) + ' ' + SysErrorMessage(err)));
      DoFatalErrors(ECC_DDBASE, GetLastError,ECS_DDBASE_CREATE_SERVICE);
      exit;
    end;

    if not StartService then begin
      //err := GetLastError;
      //OutputDebugString(PChar('1:' + IntToHex(err, 8) + ' ' + SysErrorMessage(err)));
      DoFatalErrors(ECC_DDBASE,GetLastError,ECS_DDBASE_START_SERVICE);
      exit;
    end;

    fHandle := CreateFile(PChar('\\.\' + fDeviceName), GENERIC_READ or GENERIC_WRITE,
                         0,nil,OPEN_EXISTING,FILE_ATTRIBUTE_NORMAL,0);

//    err := GetLastError;

  end;
  Result := fHandle;
end;

procedure TnrDriverBase.Close;
begin
 if fHandle <> INVALID_HANDLE_VALUE then begin
   CloseHandle(fHandle);
   //OutputdebugString('Stop ...');
   StopService;
   //OutputdebugString('Remove ...');
   RemoveService;
   //OutputdebugString('Close ...');
   fHandle := INVALID_HANDLE_VALUE;
 end;
end;

procedure TnrDriverBase.Logging(Det: TDetailLevel; Mess: string);
begin
  if Assigned(Log) then Log.AddLog(Det, self.ClassName + ' ' + Mess);
end;

function TnrDriverBase.GetLicx: dword;
var res: TFILETIME;
begin
  GetSystemTimeAsFileTime(res);
  Result := Dword(Pointer(Dword(@res) + 2)^);
end;

end.
