library Win32IRQ;

uses
  SysUtils,
  Classes,
  Windows, WinSvc, Registry;

{$R *.RES}

type
  TInitData = packed record
    BaseAddress : DWORD;
    IRQ : WORD;
    BusType : SmallInt;
    BusNumber : WORD;
    ClearOffset : WORD;
    Operation : WORD;
    Reserved1 : DWORD;
    Reserved2 : DWORD;
  end;

var
    hDevice : HWND;
    ManagerHandle, ServiceHandle : SC_HANDLE;
    OS : Byte;

const
    ServiceExe: PChar = '%SystemRoot%\SYSTEM32\DRIVERS\IRQGEN.SYS';
    // control codes created by CTL_CODE macro in winioctl.h
    dioInit = $80FF2004;
    dioDetectIRQ = $80FF2008;
    dioSendEOI = $80FF200C;
    dioAbort = $80FF2010;
    dioINSW = $80FF2020;
    DriverName : PChar = 'IRQGEN';
    Args : PChar = NIL;
    kWin = 1;
    kNT = 2;
    kNT5 = 3;
    //   the following are defined in winnt.h
    SERVICE_AUTO_START = $02;
    SERVICE_DEMAND_START = $03;
    SERVICE_ERROR_NORMAL = $01;
    SERVICE_KERNEL_DRIVER = $01;

function InitGenDriver(Base: DWORD; IRQ: Byte; BusType: SmallInt; BusNumber: BYTE; Off: WORD; Op: BYTE): ByteBool; cdecl;
var
    cbRet : LongWord;
    ret : Boolean;
    Data : TInitData;
begin
    ret := false;
    if hDevice <> INVALID_HANDLE_VALUE then
    begin
        Data.BaseAddress := Base;
        Data.IRQ := IRQ;
        Data.BusType := BusType;
        Data.BusNumber := BusNumber;
        Data.ClearOffset := Off;
        Data.Operation := Op;
        ret := DeviceIOControl(hDevice, dioInit, @Data, sizeof(Data), nil, 0, cbRet, nil);
    end;
    InitGenDriver := ret;
end;

function DetectIRQ: ByteBool; cdecl;
var
    O : TOverlapped;
    hEvent, cbRet : LongWord;
begin
    DetectIRQ := false;
    if hDevice <> INVALID_HANDLE_VALUE then
    begin
        hEvent := CreateEvent(nil, true, false, '');
        O.Internal := 0;
        O.InternalHigh := 0;
        O.Offset := 0;
        O.OffsetHigh := 0;
        O.hEvent := hEvent;

        if not DeviceIOControl(hDevice, dioDetectIRQ, nil, 0, nil, 0, cbRet, @O) then
        begin
            if GetLastError = ERROR_IO_PENDING then
            begin
                GetOverlappedResult(hDevice, O, cbRet, true);
                if cbRet <> 0 then
                begin
                    CloseHandle(hEvent);
                    Exit;    // IRP was cancelled
                end;
            end else
            begin
                CloseHandle(hEvent);
                Exit;    // some error occurred in the driver so return false
            end;
        end;

        CloseHandle(hEvent);
        DetectIRQ := true;
    end;
end;

function SendEOI: ByteBool; cdecl;
var
    cbRet : LongWord;
begin
    SendEOI := false;
    if hDevice <> INVALID_HANDLE_VALUE then
        SendEOI := DeviceIOControl(hDevice, dioSendEOI, nil, 0, nil, 0, cbRet, nil);
end;

function AbortRequest: ByteBool; cdecl;
var
    cbRet: LongWord;
begin
    Result := false;
    if hDevice <> INVALID_HANDLE_VALUE then
        Result := DeviceIOControl(hDevice, dioAbort, nil, 0, nil, 0, cbRet, nil);
end;

function WinINSW(Addr: Word; pBuffer: PWord; Count: LongWord): ByteBool; cdecl;
var
  cbRet: LongWord;

begin
  SetLastError(ERROR_INVALID_HANDLE);
  Result := False;
  if hDevice <> INVALID_HANDLE_VALUE then
    Result := DeviceIOControl(hDevice, dioINSW, @Addr, SizeOf(Addr), pBuffer, Count * 2, cbRet, nil)
  ;
end;

function VBInitGenDriver(Base: DWORD; IRQ: Byte; BusType: SmallInt; BusNumber: BYTE; Off: WORD; Op: BYTE): ByteBool; stdcall;
begin
    Result := InitGenDriver(Base, IRQ, BusType, BusNumber, Off, Op);
end;

function VBDetectIRQ: ByteBool; stdcall;
begin
    Result := DetectIRQ;
end;

function VBSendEOI: ByteBool; stdcall;
begin
    Result := SendEOI;
end;

function VBAbortRequest: ByteBool; stdcall;
begin
    Result := AbortRequest;
end;

function VBWinINSW(Addr: Word; pBuffer: PWord; Count: LongWord): ByteBool; stdcall;
begin
  Result := WinINSW(Addr, pBuffer, Count);
end;

exports
    WinINSW,
    WinINSW name '_WinINSW',
    VBWinINSW,
    InitGenDriver,
    DetectIRQ,
    SendEOI,
    AbortRequest,
    InitGenDriver name '_InitGenDriver',
    DetectIRQ name '_DetectIRQ',
    SendEOI name '_SendEOI',
    AbortRequest name '_AbortRequest',
    VBInitGenDriver, VBDetectIRQ, VBSendEOI, VBAbortRequest;

procedure DLLHandler(Reason: Integer);
var
   ServiceStatus : TServiceStatus;
begin
    if (Reason = DLL_PROCESS_DETACH) and (hDevice <> 0) then
    begin
        CloseHandle(hDevice);
        Exit; // if auto start
        if OS = kNT then
        begin
            ManagerHandle := OpenSCManager (NIL, NIL, SC_MANAGER_ALL_ACCESS);
            ServiceHandle := OpenService(ManagerHandle, DriverName, SERVICE_ALL_ACCESS);
            ControlService(ServiceHandle, SERVICE_CONTROL_STOP, ServiceStatus);
            CloseServiceHandle(ManagerHandle);
            CloseServiceHandle(ServiceHandle);
        end;
    end;
end;

// DLL Initialization
const
  IFKey = 'System\CurrentControlSet\Control\DeviceClasses\{E77894A2-697F-11D5-958E-AF1FDADB2F1B}';

var
  Reg: TRegistry;
  SubKeys: TStringList;
  V: OSVERSIONINFO;
  NTDevName: String;

begin
    DLLProc := @DLLHandler;
    if hDevice <> 0 then Exit;



    OS := kWin; //Assume we're on Win9x if we can't tell where we are

    V.dwOSVersionInfoSize := sizeof(OSVERSIONINFO);
    GetVersionEx(V);
    case V.dwPlatformId of
    VER_PLATFORM_WIN32_WINDOWS, VER_PLATFORM_WIN32s: //` Win32s is an assumption!
      OS := kWin;
    VER_PLATFORM_WIN32_NT:
      if V.dwMajorVersion > 4 then
        OS := kNT5
      else
        OS := kNT
      ;
    end;

    if OS = kWin then //Open IRQCOS for Win9x
        hDevice := CreateFile('\\.\irqgen.vxd',
                            GENERIC_READ or GENERIC_WRITE,
                            FILE_SHARE_READ or FILE_SHARE_WRITE,
                            nil,
                            OPEN_EXISTING,
                            FILE_FLAG_DELETE_ON_CLOSE or FILE_FLAG_OVERLAPPED,
                            0)
    else begin
      NTDevName := '\\.\IRQGEN';



      if OS = kNT5 then begin //If NT5 then it's the WDM driver, so get the name from the GUID
        Reg := TRegistry.Create(KEY_ENUMERATE_SUB_KEYS or KEY_QUERY_VALUE);
        Reg.RootKey := HKEY_LOCAL_MACHINE;
        if Reg.OpenKey(IFKey, False) then begin
          SubKeys := TStringList.Create;
          Reg.GetKeyNames(SubKeys);
          Reg.CloseKey;
          if (SubKeys.Count <> 0) then if Reg.OpenKey(IFKey + '\' + SubKeys[0] + '\#', False) then begin
            try
              NTDevName := Reg.ReadString('SymbolicLink');
            except
            end;
            Reg.CloseKey;
          end;
          SubKeys.Free;
        end;
        Reg.Free;
      end;

      //If the driver is already up, this will just work
      hDevice := CreateFile(PChar(NTDevName),
                            GENERIC_READ or GENERIC_WRITE,
                            FILE_SHARE_READ or FILE_SHARE_WRITE,
                            nil,
                            OPEN_EXISTING,
                            FILE_FLAG_OVERLAPPED,
                            0
      );
      if hDevice <> INVALID_HANDLE_VALUE then Exit;



      //It isn't, so load and start it
        // open manager
      ManagerHandle := OpenSCManager (NIL, NIL, SC_MANAGER_ALL_ACCESS);
        // create service
      ServiceHandle := CreateService (ManagerHandle,          // SCManager database
                                      DriverName,           // name of service
                                      DriverName,           // name to display
                                      SERVICE_ALL_ACCESS,    // desired access
                                      SERVICE_KERNEL_DRIVER, // service type
                                      SERVICE_AUTO_START,  // start type
                                      SERVICE_ERROR_NORMAL,  // error control type
                                      ServiceExe,            // service's binary
                                      NIL,                  // no load ordering group
                                      NIL,                  // no tag identifier
                                      NIL,                  // no dependencies
                                      NIL,                  // LocalSystem account
                                      NIL                   // no password
                                      );

        // open if already created
      if (ServiceHandle = 0) then
        ServiceHandle := OpenService(ManagerHandle, DriverName, SERVICE_ALL_ACCESS);

      StartService (ServiceHandle, 0, Args);

      CloseServiceHandle (ServiceHandle);
      CloseServiceHandle (ManagerHandle);

      hDevice := CreateFile(PChar(NTDevName),
                            GENERIC_READ or GENERIC_WRITE,
                            FILE_SHARE_READ or FILE_SHARE_WRITE,
                            nil,
                            OPEN_EXISTING,
                            FILE_FLAG_OVERLAPPED,
                            0
      );
    end;
end.