unit giveio_r;

interface

Uses Windows, SysUtils, Classes;

type
 TGiveIO = class
  Private
   Function CreateFileFromResource(FName : String) : Boolean;
  Public
   Function CreateService : Boolean;
   Function RemoveService : Boolean;

   Function StartService  : Boolean;
   Function StopService   : Boolean;

   Procedure GiveIoForCurrentProcess;
   Procedure GiveIoForProcess(dwProcessId: Cardinal);
 End;

implementation

Uses WinSvc, Dialogs;

Const
 DriverName : PChar= 'giveioex'#0;

{ Подключение файла ресурсов }
{$R GiveIoEx.RES}

function GetSystemDir : String;
var
  Buffer: array[0..1023] of Char;
begin
 SetString(Result, Buffer, GetSystemDirectory(Buffer, SizeOf(Buffer)));
end;

function GetDriverPath : String;
begin
 Result:= GetSystemDir + '\giveioex.sys';
end;

Function TGiveIO.CreateService : Boolean;
var hSCMan, hService: SC_HANDLE;
    DriverPath : String;
Begin
 Result:= False;

 DriverPath:= GetDriverPath;
 CreateFileFromResource(DriverPath);
 
 {== Создание сервиса ==}
 {Сервис регистрируется в ветке реестра}
 {HKEY_LOCAL_MACHINE\SYSTEM\CurrentControlSet\Services\giveioex}
 {Будут созданы ключи:}
 { DisplayName = имя_драйвера (равно giveio)}
 { ImagePath   = путь к файлу sys. При регистрации в локальной директории }
 {               будет равно \??\E:\Test\giveioex.sys}
 hSCMan:= WinSvc.OpenSCManager(
           Nil,         { local }
           Nil,         { SERVICES_ACTIVE_DATABASE }
           SC_MANAGER_ALL_ACCESS
          );
 If hSCMan = 0 then Exit;        

 {Создаем сервис (регистрируем драйвер)}
 hService:= WinSvc.CreateService(hSCMan, Drivername, DriverName,
      SERVICE_ALL_ACCESS, SERVICE_KERNEL_DRIVER,
      SERVICE_DEMAND_START, SERVICE_ERROR_NORMAL,
      PChar(@DriverPath[1]),
      nil,nil,nil,nil,nil);
 {Файл не найден или сервис уже зарегистрирован}
 If hService = 0 then begin
  CloseServiceHandle(hSCMan);
  Exit;
 End;

 {Регистрация успешна}
 WinSvc.CloseServiceHandle(hService);
 WinSvc.CloseServiceHandle(hSCMan);
 Result:= True;
End;

Function TGiveIO.RemoveService : Boolean;
var hSCMan, hService : SC_HANDLE;
    DriverPath : String;
Begin
 Result:= False;

 DriverPath:= GetDriverPath;
 Windows.DeleteFile(PChar(DriverPath));

 {== Удаление сервиса из реестра}
 hSCMan:= WinSvc.OpenSCManager(Nil,Nil,SC_MANAGER_ALL_ACCESS);
 If hSCMan = 0 then Exit;

 hService:= WinSvc.OpenService(hSCMan, DriverName, SERVICE_ALL_ACCESS);
 {Ошибка открытия сервиса}
 If hService=0 then begin
  CloseServiceHandle(hSCMan);
  Exit;
 End;

 WinSvc.DeleteService(hService);
 WinSvc.CloseServiceHandle(hService);
 WinSvc.CloseServiceHandle(hSCMan);
 Result:= True;
End;

Function TGiveIO.StartService  : Boolean;
var lpServiceArgVectors : PChar;
    hSCMan, hService : SC_HANDLE;
Begin
 Result:= False;
 
 {== Старт зарегистрированного сервиса}
 hSCMan  := WinSvc.OpenSCManager(Nil, Nil, SC_MANAGER_CONNECT);
 If hSCMan = 0 then Exit;
 
 hService:= WinSvc.OpenService(hSCMan, DriverName, 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 TGiveIO.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, DriverName, 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;

{== Загрузка драйвера в память }
{Дает доступ к портам для текущего процесса}
Procedure TGiveIO.GiveIoForCurrentProcess;
var hDevice : SC_HANDLE;
Begin
 hDevice:= CreateFile('\\.\giveioex',
             GENERIC_READ or GENERIC_WRITE,
             0,nil,
             OPEN_EXISTING,
             FILE_ATTRIBUTE_NORMAL,
             0
           );
 CloseHandle(hDevice);
End;

Const
 GIVEIO_TYPE =  40000;
 METHOD_BUFFERED   = 0;
 FILE_ANY_ACCESS   = $0000;
  
function Get_Ctl_Code(Nr: Integer): Integer;
begin
  Result:=
     (GIVEIO_TYPE shl 16) or
     (FILE_ANY_ACCESS shl 14) or
     (Nr shl 2) or
     METHOD_BUFFERED;
end;

Procedure TGiveIO.GiveIoForProcess(dwProcessId : Cardinal);
var hDevice : SC_HANDLE; Result : Cardinal;
begin
 hDevice:= CreateFile('\\.\giveioex',
             GENERIC_READ or GENERIC_WRITE,
             0,nil,
             OPEN_EXISTING,
             FILE_ATTRIBUTE_NORMAL,
             0
           );

 DeviceIoControl(hDevice, Get_Ctl_Code($900),
    @dwProcessId, SizeOf(dwProcessId), nil, 0, Result, nil);
 CloseHandle(hDevice);
end;

Function TGiveIO.CreateFileFromResource(FName : String) : Boolean;
Var S: TFileStream;  Rsrc: HRSRC; Res: THandle;
    Data: Pointer;
Begin
 Result := False;
 Rsrc := FindResource(HInstance, MakeIntResource(101), RT_RCDATA);
 If Rsrc = 0 then Exit;

 Res:= LoadResource(HInstance, Rsrc);
 Try
  Data := LockResource(Res);
  If Data <> nil then
   Try
    S:= TFileStream.Create(FName, fmCreate);
    Try
     S.WriteBuffer(Data^, SizeOfResource(HInstance, Rsrc));
    Finally
     S.Free;
    End;
    Result:= True;
   Finally
    UnlockResource(Res);
   End;
  Finally
   FreeResource(Res);
  End;
End;

end.
