unit CoreExports;

interface

uses
  Windows;

procedure InitDLL;

function   RelInPortB (CardNum, Offset: LongWord                    ): Word;     cdecl;
function   RelInPort  (CardNum, Offset: LongWord                    ): Word;     cdecl;
function   RelInPortL (CardNum, Offset: LongWord                    ): LongWord; cdecl;
function   RelOutPortB(CardNum, Offset: LongWord; Value: Byte       ): Word;     cdecl;
function   RelOutPort (CardNum, Offset: LongWord; Value: Word       ): Word;     cdecl;
function   RelOutPortL(CardNum, Offset: LongWord; Value: LongWord   ): Word;     cdecl;

function   RelINSB(CardNum, Offset, Count: LongWord; pBuf: PByte    ): LongWord; cdecl;
function   RelINSW(CardNum, Offset, Count: LongWord; pBuf: PWord    ): LongWord; cdecl;
function   RelINSL(CardNum, Offset, Count: LongWord; pBuf: PLongWord): LongWord; cdecl;

function VBRelInPortB (CardNum, Offset: LongWord                    ): Word;     stdcall;
function VBRelInPort  (CardNum, Offset: LongWord                    ): Word;     stdcall;
function VBRelInPortL (CardNum, Offset: LongWord                    ): LongWord; stdcall;
function VBRelOutPortB(CardNum, Offset: LongWord; Value: Byte       ): Word;     stdcall;
function VBRelOutPort (CardNum, Offset: LongWord; Value: Word       ): Word;     stdcall;
function VBRelOutPortL(CardNum, Offset: LongWord; Value: LongWord   ): Word;     stdcall;

function VBRelINSB(CardNum, Offset, Count: LongWord; pBuf: PByte    ): LongWord; stdcall;
function VBRelINSW(CardNum, Offset, Count: LongWord; pBuf: PWord    ): LongWord; stdcall;
function VBRelINSL(CardNum, Offset, Count: LongWord; pBuf: PLongWord): LongWord; stdcall;

function      InPortB (Addr: LongWord                    ): Word;     cdecl;
function      InPort  (Addr: LongWord                    ): Word;     cdecl;
function      InPortL (Addr: LongWord                    ): LongWord; cdecl;
function      OutPortB(Addr: LongWord; Value: Byte       ): Word;     cdecl;
function      OutPort (Addr: LongWord; Value: Word       ): Word;     cdecl;
function      OutPortL(Addr: LongWord; Value: LongWord   ): Word;     cdecl;

function      INSB(Addr, Count: LongWord; pBuf: PByte    ): LongWord; cdecl;
function      INSW(Addr, Count: LongWord; pBuf: PWord    ): LongWord; cdecl;
function      INSL(Addr, Count: LongWord; pBuf: PLongWord): LongWord; cdecl;

function    VBInPortB (Addr: LongWord                    ): Word;     stdcall;
function    VBInPort  (Addr: LongWord                    ): Word;     stdcall;
function    VBInPortL (Addr: LongWord                    ): LongWord; stdcall;
function    VBOutPortB(Addr: LongWord; Value: Byte       ): Word;     stdcall;
function    VBOutPort (Addr: LongWord; Value: Word       ): Word;     stdcall;
function    VBOutPortL(Addr: LongWord; Value: LongWord   ): Word;     stdcall;

function    VBINSB(Addr, Count: LongWord; pBuf: PByte    ): LongWord; stdcall;
function    VBINSW(Addr, Count: LongWord; pBuf: PWord    ): LongWord; stdcall;
function    VBINSL(Addr, Count: LongWord; pBuf: PLongWord): LongWord; stdcall;

function CSA_RelOutPortMB2(CardNum, Offset: LongWord;               Value:     Word): Word; cdecl;
function CSA_RelOutPortMB3(CardNum, Offset: LongWord;               Value: LongWord): Word; cdecl;
function CSA_RelOutPortMB4(CardNum, Offset: LongWord;               Value: LongWord): Word; cdecl;
function CSA_RelOutPortMB (CardNum, Offset: LongWord; Count: Byte; pValue: PByte   ): Word; cdecl;

function VBCSA_RelOutPortMB2(CardNum, Offset: LongWord;               Value:     Word): Word; stdcall;
function VBCSA_RelOutPortMB3(CardNum, Offset: LongWord;               Value: LongWord): Word; stdcall;
function VBCSA_RelOutPortMB4(CardNum, Offset: LongWord;               Value: LongWord): Word; stdcall;
function VBCSA_RelOutPortMB (CardNum, Offset: LongWord; Count: Byte; pValue: PByte   ): Word; stdcall;

function GetNumCards: Integer; cdecl;
function QueryCardInfo(CardNum: Integer; pDeviceID, pBase: PLongWord; pNameSize: pLongWord; pName: PAnsiChar): LongWord; cdecl;
function QueryBARBase(CardNum: Integer; BARIndex: LongWord; pBase: PLongWord): LongWord; cdecl;
function WaitForIRQ(CardNum: Integer): LongWord; cdecl;
function COSWaitForIRQ(CardNum: Integer; PPIs: LongWord; pData: Pointer): LongWord; cdecl;
function SetCOSScheme(CardNum: LongInt; COSScheme: LongWord): LongWord; cdecl;
function WDGHandleIRQ(CardNum: Integer; Action: LongWord): LongWord; cdecl;
function WDGInit(CardNum: Integer): LongWord; cdecl;
function WDGSetTimeout(CardNum: Integer; Milliseconds, MHzClockRate: Double): Double; cdecl;
function WDGSetResetDuration(CardNum: Integer; Milliseconds, MHzClockRate: Double): Double; cdecl;
function WDGPet(CardNum: Integer): LongWord; cdecl;
function WDGReadTemp(CardNum: Integer): Double; cdecl;
function WDGReadStatus(CardNum: Integer): LongWord; cdecl;
function WDGStart(CardNum: Integer): LongWord; cdecl;
function WDGStop(CardNum: Integer): LongWord; cdecl;
function EmergencyReboot(): LongWord; cdecl;
function AbortRequest(CardNum: Integer): LongWord; cdecl;
function ForgetIRP(CardNum: Integer): LongWord; cdecl;
function PollForIRQ(CardNum: Integer): LongWord; cdecl;
function CloseCard(CardNum: Integer): LongWord; cdecl;
{$IFDEF EXPORT_BENCH}
function GetBench(CardNum: Integer): Integer; cdecl;
{$ENDIF}

function VBGetNumCards: Integer; stdcall;
function VBQueryCardInfo(CardNum: Integer; pDeviceID, pBase: PLongWord; pNameSize: pLongWord; pName: PAnsiChar): LongWord; stdcall;
function VBQueryBARBase(CardNum: Integer; BARIndex: LongWord; pBase: PLongWord): LongWord; stdcall;
function VBWaitForIRQ(CardNum: Integer): LongWord; stdcall;
function VBAbortRequest(CardNum: Integer): LongWord; stdcall;
function VBForgetIRP(CardNum: Integer): LongWord; stdcall;
function VBPollForIRQ(CardNum: Integer): LongWord; stdcall;
function VBCloseCard(CardNum: Integer): LongWord; stdcall;
function VBCOSWaitForIRQ(CardNum: Integer; PPIs: LongWord; pData: Pointer): LongWord; stdcall;
function VBSetCOSScheme(CardNum: LongInt; COSScheme: LongWord): LongWord; stdcall;
function VBWDGHandleIRQ(CardNum: Integer; Action: LongWord): LongWord; stdcall;
function VBWDGInit(CardNum: Integer): LongWord; stdcall;
function VBWDGSetTimeout(CardNum: Integer; Milliseconds, MHzClockRate: Double): Double; stdcall;
function VBWDGSetResetDuration(CardNum: Integer; Milliseconds, MHzClockRate: Double): Double; stdcall;
function VBWDGPet(CardNum: Integer): LongWord; stdcall;
function VBWDGReadTemp(CardNum: Integer): Double; stdcall;
function VBWDGReadStatus(CardNum: Integer): LongWord; stdcall;
function VBWDGStart(CardNum: Integer): LongWord; stdcall;
function VBWDGStop(CardNum: Integer): LongWord; stdcall;
function VBEmergencyReboot(): LongWord; stdcall;

function VBStartIRQCallback(CardNum: Integer; Callback: Pointer; Context: LongWord): LongWord; stdcall;





implementation

uses
  SysUtils, Classes, Registry, SetupDiW, WDMIO;

type
  UTF16String = UnicodeString;

  TOS = (osDunno, osWin95, osWin98, osNT, osNT5);

  TStringArray16 = array of UTF16String;

  TCardInfo = packed record
    DeviceID: LongWord;
    BaseAddress: Word;
    Reserved: Word;
  end;

const
  //IFKey = 'System\CurrentControlSet\Control\DeviceClasses\{E77894A2-697F-11D0-958E-AF1FDADB2F1B}';
  AIOWDMClassGUID:  TGUID = (D1: $E77894A2; D2: $697F; D3: $11D0; D4: ($95, $8E, $AF, $1F, $DA, $DB, $2F, $1B) );
  PCIFindKey = 'Software\PCIFind';
  IOCTL_QUERY_INFO     = $80FF6000;
  IOCTL_QUERY_BAR_BASE = $80FF6004;
  IOCTL_IRQ_WAIT_BEGIN = $80FF6040;
  IOCTL_IRQ_WAIT_ABORT = $80FF2048;
  IOCTL_IRQ_POLL       = $80FF6050;
  IOCTL_SET_COS_SCHEME = $80FF6058;
  IOCTL_GET_BENCH      = $80FF60C0;
  IOCTL_FORGET_IRP     = $80FFA200;
  LongTrue = LongWord(-1);

var
  OS: TOS = osDunno;
  bStupidXPShutdownIssue: Boolean;
  Devices: array of record
    SymbolicLink: UTF16String;
    hDevice: THandle;
    Base: Word;
    BaseOK: ByteBool;
    WDGOK: ByteBool;
    WDGCountsA,
    WDGCountsB: Word;
    IsOpen: WordBool;
    Reserved: Word;
    WDGAction: LongWord;
    PPISize: LongWord;
  end;
  hCentralDevice: THandle;
  CurCardNum: Integer = 0;
  Args: PAnsiChar = nil;



function EnsureCardOpen(CardNum: Integer; EnsureWDG: Boolean = False): Boolean;
begin
  Result := False;
  if (CardNum < 0) or (CardNum > High(Devices)) then begin
    SetLastError(ERROR_INVALID_PARAMETER);
    Exit;
  end;
  if Devices[CardNum].hDevice <> INVALID_HANDLE_VALUE then begin
    if EnsureWDG and not Devices[CardNum].WDGOK then begin
      SetLastError(ERROR_BAD_TOKEN_TYPE);
      Result := False;
    end
    else begin
      SetLastError(ERROR_ALREADY_EXISTS);
      Result := True;
    end;
    Exit;
  end;
  if EnsureWDG then
    SetLastError(ERROR_BAD_TOKEN_TYPE)
  else begin
    Devices[CardNum].hDevice := CreateFile(
      PChar(Devices[CardNum].SymbolicLink),
      GENERIC_READ or GENERIC_WRITE,
      FILE_SHARE_READ or FILE_SHARE_WRITE,
      nil,
      OPEN_EXISTING,
      FILE_FLAG_OVERLAPPED,
      0
    );
    Result := Devices[CardNum].hDevice <> INVALID_HANDLE_VALUE;
    if Result then begin
      Devices[CardNum].PPISize := 3;
    end;
  end;
end;

function CheckCentralDevice: Boolean;
begin
  Result := hCentralDevice <> INVALID_HANDLE_VALUE;
  if not Result then SetLastError(ERROR_INVALID_HANDLE);
end;

function   RelInPortB (CardNum, Offset: LongWord                    ): Word;     cdecl;   begin if not EnsureCardOpen(CardNum) then Result := $AA55 else Result := _InPortB (Devices[CardNum].hDevice, Offset);             end;
function   RelInPort  (CardNum, Offset: LongWord                    ): Word;     cdecl;   begin if not EnsureCardOpen(CardNum) then Result := $AA55 else Result := _InPort  (Devices[CardNum].hDevice, Offset);             end;
function   RelInPortL (CardNum, Offset: LongWord                    ): LongWord; cdecl;   begin if not EnsureCardOpen(CardNum) then Result := $AA55 else Result := _InPortL (Devices[CardNum].hDevice, Offset);             end;
function   RelOutPortB(CardNum, Offset: LongWord; Value: Byte       ): Word;     cdecl;   begin if not EnsureCardOpen(CardNum) then Result := $AA55 else Result := _OutPortB(Devices[CardNum].hDevice, Offset, Value);      end;
function   RelOutPort (CardNum, Offset: LongWord; Value: Word       ): Word;     cdecl;   begin if not EnsureCardOpen(CardNum) then Result := $AA55 else Result := _OutPort (Devices[CardNum].hDevice, Offset, Value);      end;
function   RelOutPortL(CardNum, Offset: LongWord; Value: LongWord   ): Word;     cdecl;   begin if not EnsureCardOpen(CardNum) then Result := $AA55 else Result := _OutPortL(Devices[CardNum].hDevice, Offset, Value);      end;
function   RelINSB(CardNum, Offset, Count: LongWord; pBuf: PByte    ): LongWord; cdecl;   begin if not EnsureCardOpen(CardNum) then Result := $AA55 else Result := _INS(Devices[CardNum].hDevice, Offset, Count, 1, pBuf);  end;
function   RelINSW(CardNum, Offset, Count: LongWord; pBuf: PWord    ): LongWord; cdecl;   begin if not EnsureCardOpen(CardNum) then Result := $AA55 else Result := _INS(Devices[CardNum].hDevice, Offset, Count, 2, pBuf);  end;
function   RelINSL(CardNum, Offset, Count: LongWord; pBuf: PLongWord): LongWord; cdecl;   begin if not EnsureCardOpen(CardNum) then Result := $AA55 else Result := _INS(Devices[CardNum].hDevice, Offset, Count, 4, pBuf);  end;

function VBRelInPortB (CardNum, Offset: LongWord                    ): Word;     stdcall; begin Result := RelInPortB (CardNum, Offset);           end;
function VBRelInPort  (CardNum, Offset: LongWord                    ): Word;     stdcall; begin Result := RelInPort  (CardNum, Offset);           end;
function VBRelInPortL (CardNum, Offset: LongWord                    ): LongWord; stdcall; begin Result := RelInPortL (CardNum, Offset);           end;
function VBRelOutPortB(CardNum, Offset: LongWord; Value: Byte       ): Word;     stdcall; begin Result := RelOutPortB(CardNum, Offset, Value);    end;
function VBRelOutPort (CardNum, Offset: LongWord; Value: Word       ): Word;     stdcall; begin Result := RelOutPort (CardNum, Offset, Value);    end;
function VBRelOutPortL(CardNum, Offset: LongWord; Value: LongWord   ): Word;     stdcall; begin Result := RelOutPortL(CardNum, Offset, Value);    end;
function VBRelINSB(CardNum, Offset, Count: LongWord; pBuf: PByte    ): LongWord; stdcall; begin Result := RelINSB(CardNum, Offset, Count, pBuf);  end;
function VBRelINSW(CardNum, Offset, Count: LongWord; pBuf: PWord    ): LongWord; stdcall; begin Result := RelINSW(CardNum, Offset, Count, pBuf);  end;
function VBRelINSL(CardNum, Offset, Count: LongWord; pBuf: PLongWord): LongWord; stdcall; begin Result := RelINSL(CardNum, Offset, Count, pBuf);  end;

function      InPortB (Addr: LongWord                    ): Word;     cdecl;   begin if not CheckCentralDevice then Result := $AA55 else Result := _InPortB (hCentralDevice, Addr);             end;
function      InPort  (Addr: LongWord                    ): Word;     cdecl;   begin if not CheckCentralDevice then Result := $AA55 else Result := _InPort  (hCentralDevice, Addr);             end;
function      InPortL (Addr: LongWord                    ): LongWord; cdecl;   begin if not CheckCentralDevice then Result := $AA55 else Result := _InPortL (hCentralDevice, Addr);             end;
function      OutPortB(Addr: LongWord; Value: Byte       ): Word;     cdecl;   begin if not CheckCentralDevice then Result := $AA55 else Result := _OutPortB(hCentralDevice, Addr, Value);      end;
function      OutPort (Addr: LongWord; Value: Word       ): Word;     cdecl;   begin if not CheckCentralDevice then Result := $AA55 else Result := _OutPort (hCentralDevice, Addr, Value);      end;
function      OutPortL(Addr: LongWord; Value: LongWord   ): Word;     cdecl;   begin if not CheckCentralDevice then Result := $AA55 else Result := _OutPortL(hCentralDevice, Addr, Value);      end;
function      INSB(Addr, Count: LongWord; pBuf: PByte    ): LongWord; cdecl;   begin if not CheckCentralDevice then Result := $AA55 else Result := _INS(hCentralDevice, Addr, Count, 1, pBuf);  end;
function      INSW(Addr, Count: LongWord; pBuf: PWord    ): LongWord; cdecl;   begin if not CheckCentralDevice then Result := $AA55 else Result := _INS(hCentralDevice, Addr, Count, 2, pBuf);  end;
function      INSL(Addr, Count: LongWord; pBuf: PLongWord): LongWord; cdecl;   begin if not CheckCentralDevice then Result := $AA55 else Result := _INS(hCentralDevice, Addr, Count, 4, pBuf);  end;

function    VBInPortB (Addr: LongWord                    ): Word;     stdcall; begin Result := InPortB (Addr);           end;
function    VBInPort  (Addr: LongWord                    ): Word;     stdcall; begin Result := InPort  (Addr);           end;
function    VBInPortL (Addr: LongWord                    ): LongWord; stdcall; begin Result := InPortL (Addr);           end;
function    VBOutPortB(Addr: LongWord; Value: Byte       ): Word;     stdcall; begin Result := OutPortB(Addr, Value);    end;
function    VBOutPort (Addr: LongWord; Value: Word       ): Word;     stdcall; begin Result := OutPort (Addr, Value);    end;
function    VBOutPortL(Addr: LongWord; Value: LongWord   ): Word;     stdcall; begin Result := OutPortL(Addr, Value);    end;
function    VBINSB(Addr, Count: LongWord; pBuf: PByte    ): LongWord; stdcall; begin Result := INSB(Addr, Count, pBuf);  end;
function    VBINSW(Addr, Count: LongWord; pBuf: PWord    ): LongWord; stdcall; begin Result := INSW(Addr, Count, pBuf);  end;
function    VBINSL(Addr, Count: LongWord; pBuf: PLongWord): LongWord; stdcall; begin Result := INSL(Addr, Count, pBuf);  end;

function CSA_RelOutPortMB2(CardNum, Offset: LongWord; Value: Word): Word; cdecl;
begin
  if not EnsureCardOpen(CardNum) then Result := $AA55 else Result := _OutPortMB(Devices[CardNum].hDevice, Offset, 2, @Value);
end;

function CSA_RelOutPortMB3(CardNum, Offset: LongWord; Value: LongWord): Word; cdecl;
begin
  if not EnsureCardOpen(CardNum) then Result := $AA55 else Result := _OutPortMB(Devices[CardNum].hDevice, Offset, 3, @Value);
end;

function CSA_RelOutPortMB4(CardNum, Offset: LongWord; Value: LongWord): Word; cdecl;
begin
  if not EnsureCardOpen(CardNum) then Result := $AA55 else Result := _OutPortMB(Devices[CardNum].hDevice, Offset, 4, @Value);
end;

function CSA_RelOutPortMB (CardNum, Offset: LongWord; Count: Byte; pValue: PByte): Word; cdecl;
begin
  if not EnsureCardOpen(CardNum) then Result := $AA55 else Result := _OutPortMB(Devices[CardNum].hDevice, Offset, Count, pValue);
end;

function VBCSA_RelOutPortMB2(CardNum, Offset: LongWord;               Value:     Word): Word; stdcall; begin Result := CSA_RelOutPortMB2(CardNum, Offset,         Value); end;
function VBCSA_RelOutPortMB3(CardNum, Offset: LongWord;               Value: LongWord): Word; stdcall; begin Result := CSA_RelOutPortMB3(CardNum, Offset,         Value); end;
function VBCSA_RelOutPortMB4(CardNum, Offset: LongWord;               Value: LongWord): Word; stdcall; begin Result := CSA_RelOutPortMB4(CardNum, Offset,         Value); end;
function VBCSA_RelOutPortMB (CardNum, Offset: LongWord; Count: Byte; pValue: PByte   ): Word; stdcall; begin Result := CSA_RelOutPortMB (CardNum, Offset, Count, pValue); end;

procedure CtrMode(CardNum: LongWord; Ctr, Mode: Byte);
begin
  RelOutPortB(CardNum, 3, (Ctr shl 6) or $30 or (Mode shl 1));
end;

procedure CtrLoad(CardNum: LongWord; Ctr: Byte; Data: Word);
begin
  RelOutPortB(CardNum, Ctr, Lo(Data));
  RelOutPortB(CardNum, Ctr, Hi(Data));
end;



procedure GetPrivilege(Priv: PAnsiChar);
var
  TP: TTokenPrivileges;
  LUID: Int64;
  hToken: THandle;
  cbRet: LongWord;

begin
  if (OS <> osNT) and (OS <> osNT5) then Exit;

  LookupPrivilegeValueA(nil, Priv, LUID);

  TP.PrivilegeCount := 1;
  TP.Privileges[0].Luid := LUID;
  TP.Privileges[0].Attributes := SE_PRIVILEGE_ENABLED;

  OpenProcessToken(GetCurrentProcess(), TOKEN_ADJUST_PRIVILEGES, hToken);

  AdjustTokenPrivileges(
    hToken,
    FALSE,
    TP,
    sizeof(TOKEN_PRIVILEGES),
    nil,
    cbRet
  );

end;


function GetNumCards: Integer; cdecl;
begin
  Result := Length(Devices);
end;



function QueryCardInfo(CardNum: Integer; pDeviceID, pBase: PLongWord; pNameSize: pLongWord; pName: PAnsiChar): LongWord; cdecl;
var
  cbRet: LongWord;
  Data: TCardInfo;
  Reg: TRegistry;
  Buf: AnsiString;
  I: Integer;

begin
  Result := 0;
  Reg := nil;
  if not EnsureCardOpen(CardNum) then Exit;

  ZeroMemory(@Data, SizeOf(Data));
  if DeviceIOControl(Devices[CardNum].hDevice, IOCTL_QUERY_INFO, nil, 0, @Data, SizeOf(Data), cbRet, nil) then begin
    Result := LongTrue;
    Devices[CardNum].Base := Data.BaseAddress;
    Devices[CardNum].BaseOK := True;
    if pDeviceID <> nil then pDeviceID^ := Data.DeviceID;
    if pBase     <> nil then pBase^ := Data.BaseAddress;
    if (pName    <> nil) or (pNameSize <> nil) then try try
        Reg := TRegistry.Create(KEY_QUERY_VALUE);
        Reg.RootKey := HKEY_LOCAL_MACHINE;
        Reg.Access := Reg.Access or KEY_WOW64_64KEY;
        Reg.OpenKey(PCIFindKey, False);
        Buf := AnsiString(UTF8String(Reg.ReadString('Company')));
        Reg.CloseKey;
        Reg.OpenKey(UTF16String('Software\' + Buf + '\Cardlist'), False);
        Buf := AnsiString(UTF8String(Reg.ReadString(IntToHex(Data.DeviceID, 4))));
        Reg.CloseKey;
        if pNameSize <> nil then begin
          I := pNameSize^;
          pNameSize^ := Length(Buf) + 1;
        end
        else
          I := 0
        ;
        if Length(Buf) + 1 < I then
          I := Length(Buf) + 1
        ;
        if I <> 0 then
          if I <> 1 then
            CopyMemory(pName, PAnsiChar(Buf), I)
          else
            pName^ := #0//Failed to get name
        ;
      except
        if pNameSize <> nil then
          pNameSize^ := 0
        ;
        Result := 0;
      end;
    finally
      FreeAndNil(Reg);
    end;
  end;
end;

function QueryBARBase(CardNum: Integer; BARIndex: LongWord; pBase: PLongWord): LongWord; cdecl;
var
  cbRet: LongWord;
  Data: LongWord;

begin
  Result := 0;
  if pBase = nil then begin
    SetLastError(ERROR_INVALID_ACCESS);
    Exit;
  end
  else if BARIndex > 5 then begin
    SetLastError(ERROR_INVALID_PARAMETER);
    Exit;
  end;
  if not EnsureCardOpen(CardNum) then Exit;

  Data := BARIndex;
  if DeviceIOControl(Devices[CardNum].hDevice, IOCTL_QUERY_BAR_BASE, @Data, SizeOf(Data), @Data, SizeOf(Data), cbRet, nil) then begin
    Result := LongTrue;
    pBase^ := Data;
  end;
end;



function WaitForIRQ(CardNum: Integer): LongWord; cdecl;
var
  O : TOverlapped;
  hEvent, cbRet: LongWord;

begin
  Result := 0;
  if not EnsureCardOpen(CardNum) then Exit;

  hEvent := CreateEvent(nil, true, false, '');
  try
    O.Internal := 0;
    O.InternalHigh := 0;
    O.Offset := 0;
    O.OffsetHigh := 0;
    O.hEvent := hEvent;

    Devices[CardNum].IsOpen := True;
    try
      if not DeviceIOControl(Devices[CardNum].hDevice, IOCTL_IRQ_WAIT_BEGIN, nil, 0, nil, 0, cbRet, @O) then begin
        if GetLastError <> ERROR_IO_PENDING then Exit; // some error occurred in the driver so return false
        GetOverlappedResult(Devices[CardNum].hDevice, O, cbRet, true);
        case GetLastError of
          ERROR_SUCCESS, ERROR_NO_MORE_FILES: ;
          else Exit; // IRP was cancelled(wait was aborted), so return false
        end;
      end;
    finally
      Devices[CardNum].IsOpen := False;
    end;

    Result := LongTrue;
  finally
    CloseHandle(hEvent);
  end;
end;



function COSWaitForIRQ(CardNum: Integer; PPIs: LongWord; pData: Pointer): LongWord; cdecl;
var
  O : TOverlapped;
  hEvent, cbRet: LongWord;
  Data: array of Byte;

begin
  Result := 0;
  if not EnsureCardOpen(CardNum) then Exit;

  hEvent := CreateEvent(nil, true, false, '');
  try
    O.Internal := 0;
    O.InternalHigh := 0;
    O.Offset := 0;
    O.OffsetHigh := 0;
    O.hEvent := hEvent;

    SetLength(Data, PPIs * Devices[CardNum].PPISize);

    Devices[CardNum].IsOpen := True;
    try
      if not DeviceIOControl(Devices[CardNum].hDevice, IOCTL_IRQ_WAIT_BEGIN, nil, 0, Data, Length(Data), cbRet, @O) then begin
        if GetLastError <> ERROR_IO_PENDING then Exit; // some error occurred in the driver so return false
        GetOverlappedResult(Devices[CardNum].hDevice, O, cbRet, true);
        case GetLastError of
          ERROR_SUCCESS, ERROR_NO_MORE_FILES: ;
          else Exit; // IRP was cancelled(wait was aborted), so return false
        end;
      end;
      CopyMemory(pData, @Data[0], Length(Data));
    finally
      Devices[CardNum].IsOpen := False;
    end;

    Result := LongTrue;
  finally
    CloseHandle(hEvent);
  end;
end;

function SetCOSScheme(CardNum: LongInt; COSScheme: LongWord): LongWord; cdecl;
var
  PPISize, cbRet: LongWord;

begin
  Result := 0;
  if not EnsureCardOpen(CardNum) then Exit;

  PPISize := 0;
  if DeviceIOControl(Devices[CardNum].hDevice, IOCTL_SET_COS_SCHEME, @COSScheme, SizeOf(COSScheme), @PPISize, SizeOf(PPISize), cbRet, nil) then begin
    Result := LongTrue;
    Devices[CardNum].PPISize := PPISize;
  end;
end;



function EnsureCardOpenAndWDGAndBaseOK(CardNum: Integer): Boolean;
begin
  Result := False;
  if not EnsureCardOpen(CardNum, True) then Exit;

  Result := Devices[CardNum].BaseOK;

  if not Result then begin
    QueryCardInfo(CardNum, nil, nil, nil, nil);
    Result := Devices[CardNum].BaseOK;
  end;
end;



function HandlerThread(CardNum: Integer): Integer;
var
  Flags, ShutdownFlag: set of (ewxShutdown, ewxReboot, ewxForce, ewxPoweroff, ewxForceIfHung);
  Disable: Boolean;

begin
  Result := ERROR_CANCELLED;
  if WaitForIRQ(CardNum) = 0 then Exit;

  //If we get to here, an IRQ has just occurred
  Flags := [];
  Disable := Devices[CardNum].WDGAction and (1 shl 0) <> 0;
  if Disable or bStupidXPShutdownIssue then
    ShutdownFlag := [ewxReboot]
  else
    ShutdownFlag := [ewxShutdown]
  ;
  if Devices[CardNum].WDGAction and (1 shl 1) <> 0 then Flags := Flags + ShutdownFlag;
  if Devices[CardNum].WDGAction and (1 shl 2) <> 0 then Flags := Flags + ShutdownFlag + [ewxForce];

  if Disable then
    RelInPortB(CardNum, 7)
  else if Flags <> [] then begin
    CtrMode(CardNum, 1, 3);
    CtrLoad(CardNum, 1, 2860); // 90 sec @ 2.0833 MHz
  end;
  if Flags <> [] then begin
    GetPrivilege('SeShutdownPrivilege');
    ExitWindowsEx(Byte(Flags), 0);
  end;
end;

function WDGHandleIRQ(CardNum: Integer; Action: LongWord): LongWord; cdecl;
var
  cbRet: LongWord;

begin
  Result := 0;
  if Action > 5 then begin
    SetLastError(ERROR_INVALID_PARAMETER);
    Exit;
  end;

  if Devices[CardNum].IsOpen then begin
    SetLastError(ERROR_INVALID_FUNCTION);
    Exit;
  end;

  if not EnsureCardOpenAndWDGAndBaseOK(CardNum) then Exit;

  Devices[CardNum].IsOpen := True;
  Devices[CardNum].WDGAction := Action;
  Result := BeginThread(nil, 0, @HandlerThread, Pointer(CardNum), 0, cbRet);
  if Result = 0 then Devices[CardNum].IsOpen := False;
end;



function WDGInit(CardNum: Integer): LongWord; cdecl;
begin
  Result := 0;

  if not Devices[CardNum].BaseOK then
    QueryCardInfo(CardNum, nil, nil, nil, nil)
  ;

  if Devices[CardNum].BaseOK then begin
    Devices[CardNum].WDGOK := True;
    Devices[CardNum].WDGCountsA := $FFFF;
    Devices[CardNum].WDGCountsB := $27C;
    Result := LongTrue;
  end;
end;



function WDGSetTimeout(CardNum: Integer; Milliseconds, MHzClockRate: Double): Double; cdecl;
begin
  Result := 0;
  if not EnsureCardOpenAndWDGAndBaseOK(CardNum) then Exit;

  if Milliseconds < 0 then Exit;
  if (Milliseconds > 4800000) and (MHzClockRate > 0.890) then Exit; //Exit if ISA and counts too high
  if (Milliseconds > 2060000) and (MHzClockRate > 2.0  ) then Exit; //Exit if PCI and counts too high

  Devices[CardNum].WDGCountsB := Round(Milliseconds * (MHzClockRate * 1000) / $FFFF);
  if Devices[CardNum].WDGCountsB = 0 then Devices[CardNum].WDGCountsB := 1;

  RelInPortB(CardNum, 7); //Disable counters
  CtrMode(CardNum, 2, 0); //Lower counter 2 to clear the reset
  CtrMode(CardNum, 2, 1);

  CtrMode(CardNum, 0, 2);
  CtrLoad(CardNum, 0, Devices[CardNum].WDGCountsA);
  CtrMode(CardNum, 1, 2);
  CtrLoad(CardNum, 1, Devices[CardNum].WDGCountsB);

  Result := Devices[CardNum].WDGCountsB / (MHzClockRate * 1000) * $FFFF;
end;



function WDGSetResetDuration(CardNum: Integer; Milliseconds, MHzClockRate: Double): Double; cdecl;
var
  Counts: LongWord;

begin
  Result := 0;
  if not EnsureCardOpenAndWDGAndBaseOK(CardNum) then Exit;

  if Milliseconds < 0 then Exit;
  if Milliseconds = 0 then CtrMode(CardNum, 2, 0); //Set counter 2 to mode 0, ISA disable buzzer
  if Milliseconds > 0 then CtrMode(CardNum, 2, 1); //Set counter 2 to mode 1, ISA enable buzzer
  if Milliseconds <= 1 then Exit;

  Counts := Round(Milliseconds * MHzClockRate * 1000);
  if Counts > $FFFF then Exit; //Exit if counts too high
  if Counts = 0 then Counts := 1;
  CtrMode(CardNum, 2, 2);
  CtrLoad(CardNum, 2, Counts);
  Result := Counts / (MHzClockRate * 1000);
end;



function WDGPet(CardNum: Integer): LongWord; cdecl;
begin
  Result := 0;
  if not EnsureCardOpenAndWDGAndBaseOK(CardNum) then Exit;

  //This algorithm leaves at least two places the system could lock up and the card not catch it.
  //Ideally, there'd be a single write to the CPLD that would cause it to drop the gates for one tick.
  //Pre-moding the counters appropriately, with MSB-only mode, and just writing to the larger counter would also work, but would have less flexibility.
  CtrMode(CardNum, 0, 3);
  CtrLoad(CardNum, 0, Devices[CardNum].WDGCountsA);
  CtrMode(CardNum, 1, 2);
  CtrLoad(CardNum, 1, Devices[CardNum].WDGCountsB);
  Result := LongTrue;
end;

function WDGReadTemp(CardNum: Integer): Double; cdecl;
begin
  Result := 0;
  if not EnsureCardOpenAndWDGAndBaseOK(CardNum) then Exit;

  // calculate temp in F
  Result := RelInPortB(CardNum, 5) * (11 / 15) + 7;
end;

function WDGReadStatus(CardNum: Integer): LongWord; cdecl;
begin
  Result := $1000;
  if not EnsureCardOpenAndWDGAndBaseOK(CardNum) then Exit;

  Result := RelInPortB(CardNum, 4); //Read Status Register - also enables IRQs
end;

function WDGStart(CardNum: Integer): LongWord; cdecl;
begin
  Result := 0;
  if not EnsureCardOpenAndWDGAndBaseOK(CardNum) then Exit;

  RelOutPortB(CardNum, 7, 0); //Enable counters
  Result := LongTrue;
end;

function WDGStop(CardNum: Integer): LongWord; cdecl;
begin
  Result := 0;
  if not EnsureCardOpen(CardNum, True) then Exit;

  RelInPortB(CardNum, 7); //disable counters
  Result := LongTrue;
end;

function EmergencyReboot(): LongWord; cdecl;
begin
  GetPrivilege('SeShutdownPrivilege');
  if ExitWindowsEx(EWX_REBOOT or EWX_FORCE, 0) then
    Result := LongTrue
  else
    Result := 0
  ;
end;



function AbortRequest(CardNum: Integer): LongWord; cdecl;
var
  cbRet: LongWord;

begin
  Result := 0;
  if not EnsureCardOpen(CardNum) then Exit;

  if DeviceIOControl(Devices[CardNum].hDevice, IOCTL_IRQ_WAIT_ABORT, nil, 0, nil, 0, cbRet, nil) then
    Result := LongTrue
  ;
end;

function ForgetIRP(CardNum: Integer): LongWord; cdecl;
var
  cbRet: LongWord;

begin
  Result := 0;
  if not EnsureCardOpen(CardNum) then Exit;

  if DeviceIOControl(Devices[CardNum].hDevice, IOCTL_FORGET_IRP, nil, 0, nil, 0, cbRet, nil) then
    Result := LongTrue
  ;
end;

function PollForIRQ(CardNum: Integer): LongWord; cdecl;
var
  cbRet: LongWord;

begin
  Result := 0;
  if not EnsureCardOpen(CardNum) then Exit;

  SetLastError(ERROR_SUCCESS);
  DeviceIOControl(Devices[CardNum].hDevice, IOCTL_IRQ_POLL, nil, 0, nil, 0, cbRet, nil);
  Result := GetLastError;
end;



function CloseCard(CardNum: Integer): LongWord; cdecl;
begin
  if (CardNum < 0) or (CardNum > High(Devices)) then begin
    Result := 0;
    SetLastError(ERROR_INVALID_PARAMETER);
    Exit;
  end;

  if Devices[CardNum].hDevice = INVALID_HANDLE_VALUE then begin
    Result := 1;
    SetLastError(ERROR_SUCCESS);
    Exit;
  end;

  if Devices[CardNum].IsOpen then AbortRequest(CardNum);
  Result := 1;
  CloseHandle(Devices[CardNum].hDevice);
  Devices[CardNum].hDevice := INVALID_HANDLE_VALUE;
  Devices[CardNum].WDGOK := False;
end;

{$IFDEF EXPORT_BENCH}
function GetBench(CardNum: Integer): Integer; cdecl;
var
  cbRet: LongWord;

begin
  Result := -1;
  if not EnsureCardOpen(CardNum) then Exit;

  if not DeviceIOControl(Devices[CardNum].hDevice, IOCTL_GET_BENCH, nil, 0, @Result, 4, cbRet, nil) then
    Result := -1
  ;
end;
{$ENDIF}



function VBGetNumCards: Integer; stdcall;
begin
  Result := GetNumCards;
end;

function VBQueryCardInfo(CardNum: Integer; pDeviceID, pBase: PLongWord; pNameSize: pLongWord; pName: PAnsiChar): LongWord; stdcall;
begin
  Result := QueryCardInfo(CardNum, pDeviceID, pBase, pNameSize, pName);
end;

function VBQueryBARBase(CardNum: Integer; BARIndex: LongWord; pBase: PLongWord): LongWord; stdcall;
begin
  Result := QueryBARBase(CardNum, BARIndex, pBase);
end;

function VBWaitForIRQ(CardNum: Integer): LongWord; stdcall;
begin
  Result := WaitForIRQ(CardNum);
end;

function VBAbortRequest(CardNum: Integer): LongWord; stdcall;
begin
  Result := AbortRequest(CardNum);
end;

function VBForgetIRP(CardNum: Integer): LongWord; stdcall;
begin
  Result := ForgetIRP(CardNum);
end;

function VBPollForIRQ(CardNum: Integer): LongWord; stdcall;
begin
  Result := PollForIRQ(CardNum);
end;

function VBCloseCard(CardNum: Integer): LongWord; stdcall;
begin
  Result := CloseCard(CardNum);
end;

function VBCOSWaitForIRQ(CardNum: Integer; PPIs: LongWord; pData: Pointer): LongWord; stdcall;
begin
  Result := COSWaitForIRQ(CardNum, PPIs, pData);
end;

function VBSetCOSScheme(CardNum: LongInt; COSScheme: LongWord): LongWord; stdcall;
begin
  Result := SetCOSScheme(CardNum, COSScheme);
end;

function VBWDGHandleIRQ(CardNum: Integer; Action: LongWord): LongWord; stdcall;
begin
  Result := WDGHandleIRQ(CardNum, Action);
end;

function VBWDGInit(CardNum: Integer): LongWord; stdcall;
begin
  Result := WDGInit(CardNum);
end;

function VBWDGSetTimeout(CardNum: Integer; Milliseconds, MHzClockRate: Double): Double; stdcall;
begin
  Result := WDGSetTimeout(CardNum, Milliseconds, MHzClockRate);
end;

function VBWDGSetResetDuration(CardNum: Integer; Milliseconds, MHzClockRate: Double): Double; stdcall;
begin
  Result := WDGSetResetDuration(CardNum, Milliseconds, MHzClockRate);
end;

function VBWDGPet(CardNum: Integer): LongWord; stdcall;
begin
  Result := WDGPet(CardNum);
end;

function VBWDGReadTemp(CardNum: Integer): Double; stdcall;
begin
  Result := WDGReadTemp(CardNum);
end;

function VBWDGReadStatus(CardNum: Integer): LongWord; stdcall;
begin
  Result := WDGReadStatus(CardNum);
end;

function VBWDGStart(CardNum: Integer): LongWord; stdcall;
begin
  Result := WDGStart(CardNum);
end;

function VBWDGStop(CardNum: Integer): LongWord; stdcall;
begin
  Result := WDGStop(CardNum);
end;

function VBEmergencyReboot(): LongWord; stdcall;
begin
  Result := EmergencyReboot;
end;

type
  TIRQCallback = procedure(Context: LongWord); stdcall;

type
  TIRQThread = class(TThread)
  public
    MyCardNum: Integer;
    MyCallback: TIRQCallback;
    MyContext: LongWord;
  protected
    procedure Execute; override;
  end;

procedure TIRQThread.Execute;
begin
  while WaitForIRQ(MyCardNum) <> 0 do
    MyCallback(MyContext)
  ;
end;

function VBStartIRQCallback(CardNum: Integer; Callback: Pointer; Context: LongWord): LongWord; stdcall;
begin
  try
    Result := LongTrue;

    with TIRQThread.Create(True) do begin
      FreeOnTerminate := True;
      MyCardNum := CardNum;
      MyCallback := Callback;
      MyContext := Context;
      Start;
    end;
  except
    Result := 0;
  end;
end;



{
procedure LoadCardList;
var
  Reg: TRegistry;
  I: Integer;
  SubKeys: TStringList;
  Linked: Boolean;

begin
  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;
    I := 0;
    while I < SubKeys.Count do begin
      if Reg.OpenKey(IFKey + '\' + SubKeys[I] + '\#\Control', False) then begin
        try
          Linked := Reg.ReadBool('Linked');
        except
          Linked := False;
        end;
        Reg.CloseKey;
        if not Linked then begin
          SubKeys.Delete(I);
          Continue;
        end;
      end
      else begin
        SubKeys.Delete(I);
        Continue;
      end;
      if not Reg.OpenKey(IFKey + '\' + SubKeys[I] + '\#', False) then begin
        SubKeys.Delete(I);
        Continue;
      end;
      try
        SubKeys[I] := Reg.ReadString('SymbolicLink');
        Inc(I);
      except
        SubKeys.Delete(I);
      end;
      Reg.CloseKey;
    end;
    SetLength(Devices, SubKeys.Count);
    for I := 0 to High(Devices) do begin
      Devices[I].SymbolicLink := SubKeys[I];
      Devices[I].hDevice := INVALID_HANDLE_VALUE;
    end;
    SubKeys.Free;
  end;
  Reg.Free;
end;
}

function GetDevicePaths(const ClassGUID: TGUID): TStringArray16;
var
  DevInterfaceData: SP_DEVICE_INTERFACE_DATA;
  MemberIndex: Integer;
  hDevInfo: THandle;

  L: LongWord;
  pDetailData: PSP_DEVICE_INTERFACE_DETAIL_DATA;

  Buf: UTF16String;
  I, RL: Integer;

begin
  RL := 0;
  SetLength(Result, RL);

  hDevInfo := SetupDiGetClassDevs(@ClassGUID, nil, 0, DIGCF_PRESENT or DIGCF_DEVICEINTERFACE);
  if hDevInfo = 0 then Exit;

  DevInterfaceData.cbSize := sizeof(DevInterfaceData);
  MemberIndex := 0;
  while SetupDiEnumDeviceInterfaces(hDevInfo, nil, ClassGUID, MemberIndex, DevInterfaceData) do begin
    L := 0;
    SetupDiGetDeviceInterfaceDetail(hDevInfo, @DevInterfaceData, nil, 0, @L, nil);

    GetMem(pDetailData, 2*L);
    if SizeOf(Pointer) = 8 then
      pDetailData.cbSize := 8 //The fixed portion is 4. Dunno where 8 comes from.
    else
      pDetailData.cbSize := 6 //The fixed portion is 4. Dunno where 6 comes from.
    ;

    if not SetupDiGetDeviceInterfaceDetail(hDevInfo, @DevInterfaceData, pDetailData, L, nil, nil) then begin
      FreeMem(pDetailData);
      Inc(MemberIndex);
      Continue;
    end;

    SetString(Buf, PWideChar(@pDetailData.DevicePath[0]), L - 4);
    FreeMem(pDetailData);
    I := Pos(#0, Buf);
    if I <> 0 then SetLength(Buf, I - 1);

    SetLength(Result, RL + 1);
    Result[RL] := Buf;
    Inc(RL);
    Buf := '';

    Inc(MemberIndex);
  end;
  SetupDiDestroyDeviceInfoList(hDevInfo);
end;

procedure LoadCardList;
var
  I: Integer;
  DevicePath: TStringArray16;

begin
  DevicePath := GetDevicePaths(AIOWDMClassGUID);
  SetLength(Devices, Length(DevicePath));
  for I := 0 to High(Devices) do begin
    Devices[I].SymbolicLink := DevicePath[I];
    Devices[I].hDevice := INVALID_HANDLE_VALUE;
  end;
end;

function GetOS: TOS;
var
  V: OSVERSIONINFO;
  VerNum: LongWord;
  VerNums: packed record Min, Maj: Word; end absolute VerNum;

begin
  Result := osDunno; //Assume we're on Win9x if we can't tell where we are

  V.dwOSVersionInfoSize := sizeof(OSVERSIONINFO);
  GetVersionEx(V);
  VerNums.Min := V.dwMinorVersion;
  VerNums.Maj := V.dwMajorVersion;
  case V.dwPlatformId of
  VER_PLATFORM_WIN32s: Result := osWin95; // Win32s doesn't have WDM, does it?
  VER_PLATFORM_WIN32_WINDOWS:
    if VerNum < $4000A then
      Result := osWin95
    else
      Result := osWin98
    ;
  VER_PLATFORM_WIN32_NT:
    if VerNum < $50000 then
      Result := osNT
    else begin
      Result := osNT5;
      if VerNum >= $50001 then
        bStupidXPShutdownIssue := True
      ;
    end;
  end;
end;

procedure DLLHandler(Reason: Integer);
var
  I: Integer;

begin
  if (Reason = DLL_PROCESS_DETACH) then begin
    for I := 0 to High(Devices) do
      if Devices[I].hDevice <> INVALID_HANDLE_VALUE then
        CloseHandle(Devices[I].hDevice)
    ;
    CloseHandle(hCentralDevice);
  end;
end;

procedure InitDLL;
begin
  if OS <> osDunno then Exit;
  DLLProc := @DLLHandler;
  OS := GetOS;
  LoadCardList;
  hCentralDevice := CreateFile('\\.\AIOWDMCore', GENERIC_WRITE or GENERIC_READ, FILE_SHARE_READ or FILE_SHARE_WRITE, nil, OPEN_EXISTING, 0, 0);
  if hCentralDevice = 0 then hCentralDevice := INVALID_HANDLE_VALUE;
end;

end.
