library Win32COS;

uses
  SysUtils,
  Classes,
  Windows,
  WinSvc,
  Registry;

{$R *.RES}

const
  IOCTL_IRQCOS_VERSION = $80FF2000;
  IOCTL_IRQCOS_IRQ_GETDATA = $80FF200C;
  IOCTL_IRQCOS_ABORT = $80FF2018;

type
  TIRQCOSVersionData = packed record
    MajorVersion,
    MinorVersion: Byte;
  end;

  TIRQCOSGetdataData = packed record
    Port0A,
    Port0B,
    Port0C,
    Port1A,
    Port1B,
    Port1C: Byte;
  end;

  TInitData = record
    BaseAddress : DWORD;
    IRQ : WORD;
    BusType : SmallInt;
    BusNumber : WORD;
  end;

var
    hDevice : HWND;
    ManagerHandle, ServiceHandle : SC_HANDLE;
    OS : Byte;
    WDMIOCTLs: Boolean = False;

const
    ServiceExe: PChar = '%SystemRoot%\SYSTEM32\DRIVERS\IRQCOS.SYS';
    // control codes created by CTL_CODE macro in winioctl.h
    dioInit = $80FF2004;
    dioGetData = $80FF2010;
    dioAbort = $80FF2014;

    DriverName : PChar = 'IRQCOS';
    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 InitCOSDriver(Addr: DWord; IRQ: Byte; BusType: SmallInt; BusNumber: Byte): ByteBool; cdecl;
var
  cbRet: LongWord;
  Data: TInitData;
  Data5: TIRQCOSVersionData;

begin
  if WDMIOCTLs then begin
    Result := False;
    Data5.MajorVersion := 255;
    Data5.MinorVersion := 255;
    if hDevice <> INVALID_HANDLE_VALUE then
    begin
      Result := DeviceIOControl(hDevice, IOCTL_IRQCOS_VERSION, nil, 0, @Data5, sizeof(Data5), cbRet, nil);
    end;
  end
  else begin
    Result := false;
    if (hDevice <> INVALID_HANDLE_VALUE) then
    begin
        Data.BaseAddress := Addr;
        Data.IRQ := IRQ;
        Data.BusType := BusType;
        Data.BusNumber := BusNumber;
        Result := DeviceIOControl(hDevice, dioInit, @Data, sizeof(Data), nil, 0, cbRet, nil);
    end;
  end;
end;

function GetCOSData(Buf : Pointer): ByteBool; cdecl;
var
    O : TOverlapped;
    hEvent, cbRet : LongWord;

begin
  if WDMIOCTLs then begin
    Result := 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 DeviceIOControl(hDevice, IOCTL_IRQCOS_IRQ_GETDATA, nil, 0, Buf, 6, cbRet, @O) then //Historical IRQ
        Result := True
      else if GetLastError = ERROR_IO_PENDING then begin
        GetOverlappedResult(hDevice, O, cbRet, True);
        if cbRet = 6 then //IRQ happened
          Result := True
        //else IRP was cancelled
        ;
      end
      //else an error happened
      ;

      CloseHandle(hEvent);
    end;
  end
  else begin
    Result := 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, dioGetData, nil, 0, Buf, 6, 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);
        Result := True; // success
    end;
  end;
end;

function AbortCOSRequest: ByteBool; cdecl;
var
    cbRet: LongWord;
begin
  if WDMIOCTLs then begin
    Result := False;
    if hDevice <> INVALID_HANDLE_VALUE then
      Result := DeviceIOControl(hDevice, IOCTL_IRQCOS_ABORT, nil, 0, nil, 0, cbRet, nil)
    ;
  end
  else begin
    Result := false;
    if hDevice <> INVALID_HANDLE_VALUE then
    begin
        if DeviceIOControl(hDevice, dioAbort, nil, 0, nil, 0, cbRet, nil) then
            Result := true;
    end;
  end;
end;

function VBInitCOSDriver(Addr: DWord; IRQ: Byte; BusType: SmallInt; BusNumber: Byte): ByteBool; stdcall;
begin
    Result := InitCOSDriver(Addr, IRQ, BusType, BusNumber);
end;

function VBGetCOSData(Buf : Pointer): ByteBool; stdcall;
begin
    Result := GetCOSData(Buf);
end;

function VBAbortCOSRequest: ByteBool; stdcall;
begin
    Result := AbortCOSRequest;
end;

exports
    InitCOSDriver,
    GetCOSData,
    AbortCOSRequest,
    InitCOSDriver name '_InitCOSDriver',
    GetCOSData name '_GetCOSData',
    AbortCOSRequest name '_AbortCOSRequest',
    VBInitCOSDriver, VBGetCOSData, VBAbortCOSRequest;

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;

const
  IFKey = 'System\CurrentControlSet\Control\DeviceClasses\{781EF630-72B2-11D2-B852-00C04FAD5171}';

var
  Reg: TRegistry;
  SubKeys: TStringList;
  V: OSVERSIONINFO;
  NTDevName, Buf: String;
  I, J: Integer;

begin
  DLLProc := @DLLHandler;

  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('\\.\irqcos.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 := '\\.\IRQCOS';



    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;
      SubKeys := TStringList.Create;
      if Reg.OpenKey(IFKey, False) then begin
        Reg.GetKeyNames(SubKeys);
        Reg.CloseKey;
        if (SubKeys.Count <> 0) then begin
          //Pop non-48S-compatible cards
          I := 0;
          while I < SubKeys.Count do begin
            Buf := SubKeys[I];
            J := Pos('DEV_', Buf);
            if J <> 0 then begin
              J := StrToInt('$' + Copy(Buf, J + 4, 4));
              case J of
              $0E50, $0C60, $0E60: begin
                Inc(I);
                Continue;
              end;
              end;
            end;
            SubKeys.Delete(I);
          end;
          if Reg.OpenKey(IFKey + '\' + SubKeys[0] + '\#', False) then begin
            try
              NTDevName := Reg.ReadString('SymbolicLink');
              WDMIOCTLs := True;
            except
            end;
            Reg.CloseKey;
          end;
        end;
      end;
      SubKeys.Free;
      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.