VERSION 5.00 Begin VB.Form Form1 BorderStyle = 3 'Fixed Dialog Caption = "Isolated Input/Digital Output Test/Sample" ClientHeight = 4530 ClientLeft = 45 ClientTop = 330 ClientWidth = 6150 LinkTopic = "Form1" MaxButton = 0 'False MinButton = 0 'False ScaleHeight = 4530 ScaleWidth = 6150 ShowInTaskbar = 0 'False StartUpPosition = 2 'CenterScreen Begin VB.TextBox IsaEdit Height = 285 Left = 3000 TabIndex = 14 Text = "300" Top = 1320 Visible = 0 'False Width = 855 End Begin VB.Timer Timer1 Enabled = 0 'False Interval = 1000 Left = 2640 Top = 4080 End Begin VB.Frame Frame1 Caption = "Status" Height = 1695 Left = 120 TabIndex = 11 Top = 2280 Width = 5895 Begin VB.TextBox Memo1 Height = 1335 Left = 120 Locked = -1 'True MultiLine = -1 'True ScrollBars = 2 'Vertical TabIndex = 12 Top = 240 Width = 5655 End End Begin VB.CommandButton ExitButton Caption = "E&xit" Height = 375 Left = 4320 TabIndex = 10 Top = 4080 Width = 1575 End Begin VB.CommandButton PerformButton Caption = "Perform I/O" Height = 375 Left = 240 TabIndex = 3 Top = 4080 Width = 1455 End Begin VB.Label AddressLabel BeginProperty Font Name = "MS Sans Serif" Size = 12 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 255 Left = 2520 TabIndex = 15 Top = 960 Width = 2055 End Begin VB.Label IsaLabel AutoSize = -1 'True Caption = "Base Address of ISA IIRO-8 (in hex):" Height = 195 Left = 240 TabIndex = 13 Top = 1320 Visible = 0 'False Width = 2565 End Begin VB.Label OptoIn Alignment = 2 'Center BorderStyle = 1 'Fixed Single Caption = "00000000" Height = 255 Left = 3960 TabIndex = 9 Top = 1920 Width = 1215 End Begin VB.Label RelayRead Alignment = 2 'Center BorderStyle = 1 'Fixed Single Caption = "00000000" Height = 255 Left = 2400 TabIndex = 8 Top = 1920 Width = 1215 End Begin VB.Label RelayOut Alignment = 2 'Center BorderStyle = 1 'Fixed Single Caption = "00000000" Height = 255 Left = 840 TabIndex = 7 Top = 1920 Width = 1215 End Begin VB.Label Label5 AutoSize = -1 'True Caption = "Opto Input" Height = 195 Left = 4200 TabIndex = 6 Top = 1680 Width = 750 End Begin VB.Label Label4 AutoSize = -1 'True Caption = "Relay Readback" Height = 195 Left = 2400 TabIndex = 5 Top = 1680 Width = 1200 End Begin VB.Label Label3 AutoSize = -1 'True Caption = "Relay Output" Height = 195 Left = 960 TabIndex = 4 Top = 1680 Width = 930 End Begin VB.Label Label2 AutoSize = -1 'True Caption = "Base address (hex):" BeginProperty Font Name = "MS Sans Serif" Size = 12 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 300 Left = 240 TabIndex = 2 Top = 960 Width = 2115 End Begin VB.Label CardName AutoSize = -1 'True Caption = "Card Name" BeginProperty Font Name = "MS Sans Serif" Size = 12 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 300 Left = 240 TabIndex = 1 Top = 480 Width = 1200 End Begin VB.Label Label1 AutoSize = -1 'True Caption = "Windows 95/NT Sample" BeginProperty Font Name = "MS Sans Serif" Size = 13.5 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 360 Left = 1080 TabIndex = 0 Top = 120 Width = 3360 End End Attribute VB_Name = "Form1" Attribute VB_GlobalNameSpace = False Attribute VB_Creatable = False Attribute VB_PredeclaredId = True Attribute VB_Exposed = False Private Declare Function InPortB Lib "ACCES32.dll" Alias "VBInPortB" (ByVal Port As Long) As Integer Private Declare Function OutPortB Lib "ACCES32.dll" Alias "VBOutPortB" (ByVal Port As Long, ByVal Value As Byte) As Integer Private Declare Function RegOpenKeyEx Lib "advapi32.dll" Alias "RegOpenKeyExA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal ulOptions As Long, ByVal samDesired As Long, phkResult As Long) As Long Private Declare Function RegQueryValueEx Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, lpData As Any, lpcbData As Long) As Long ' Note that if you declare the lpData parameter as String, you must pass it By Value. Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long Private Const HKEY_LOCAL_MACHINE = &H80000002 Private Const KEY_QUERY_VALUE = &H1 Private Type TPCI_COMMON_CONFIG VendorID As Integer DeviceID As Integer Command As Integer Status As Integer RevisionID As Byte ProgIf As Byte SubClass As Byte BaseClass As Byte CacheLineSize As Byte LatencyTimer As Byte HeaderType As Byte BIST As Byte BaseAddresses(5) As Long Reserved1(1) As Long RomBaseAddress As Long Reserved2(1) As Long InterruptLine As Byte InterruptPin As Byte MinimumGrant As Byte MaximumLatency As Byte End Type Dim Buf(63) As TPCI_COMMON_CONFIG Dim Ports(4) As Long Public RunFlag As Boolean Public Address As Long Public MyIndex As Integer Dim MyValues(2) As Integer Public Msg As String ' delete ' 'Private Sub AddressList_Click() ' NewAddress = Ports(AddressList.ListIndex) ' If NewAddress <> Address Then ' Address = NewAddress: ' Memo1.Text = Memo1.Text + "New Port Selected: " + AddressList.Text + Chr(13) + Chr(10): ' Memo1.SelStart = 32768: ' End If 'End Sub Private Sub ExitButton_Click() End End Sub Private Sub Form_Load() If (InPortB(&H61) = &HAA55) Then Call MsgBox("ACCESNT.SYS not detected. Please copy ACCESNT.SYS into [NT]/system32/drivers and re-run this sample.", 0, "Warning") End If Memo1.Text = "This sample will sequentially turn on all bits of the relay input and sequentially turn them off. Each time it sets a new bit, both the relay output and the relay input are read and the data is displayed. This demonstrates how to read and write to the relays and how to use the readback function of the board." + Chr(13) + Chr(10) Memo1.SelStart = 32768 Found = False Call RegOpenKeyEx(HKEY_LOCAL_MACHINE, "Software\PCIFind\NTioPCI\Parameters", 0, KEY_QUERY_VALUE, hKey) RunFlag = True DataSize = 4 Num& = 0 Call RegQueryValueEx(hKey, "NumDevices", 0, DataType, Num, DataSize) If (Num = 0) Then GoTo NoCards DataSize = 64 * 64 Call RegQueryValueEx(hKey, "PCICommonConfig", 0, DataType, Buf(0), DataSize) For i = 0 To Num - 1 If Found Then Exit For Select Case Buf(i).DeviceID Case &HF00 CardName.Caption = "PCI-IIRO-8 Digital Input/Relay Output Card" AddressLabel.Caption = Hex(Buf(i).BaseAddresses(2) And &HFFFE) ' Ports(0) = Buf(i).BaseAddresses(2) And &HFFFE Found = True Case &HF08 CardName.Caption = "PCI-IIRO-16 Digital Input/Relay Output Card" AddressLabel.Caption = Hex(Buf(i).BaseAddresses(2) And &HFFFE) ' Ports(0) = Buf(i).BaseAddresses(2) And &HFFFE Found = True Case &HDC8 CardName.Caption = "PCI-IDIO-16 Solid-State Input/Output Card" AddressLabel.Caption = Hex(Buf(i).BaseAddresses(2) And &HFFFE) ' Ports(0) = Buf(i).BaseAddresses(2) And &HFFFE Found = True End Select Next NoCards: If Not Found Then CardName.Caption = "No Card Found In Registry": Memo1.Text = "No Card Found In Registry." + vbCrLf + _ "This may mean an ISA IIRO-8 is installed, no card is installed, or that NTioPCI.SYS is not installed." + vbCrLf + _ "If you have an ISA IIRO-8 card installed, you may continue running the sample by entering the card's Base Address in the edit box above and continuing as normal." + vbCrLf + _ "If you have a PCI card installed, please make sure you have run PCIFind.EXE." Memo1.SelStart = 32768: IsaLabel.Visible = True IsaEdit.Visible = True AddressLabel.Enabled = False Label2.Enabled = False Label2.Visible = False RunFlag = False End If If RunFlag Then 'AddressList.ListIndex = 0 Address = "&H" + AddressLabel.Caption End If RegCloseKey (hKey) End Sub Private Sub PerformButton_Click() If Not RunFlag Then Address = "&H" + IsaEdit.Text End If If Timer1.Enabled Then Timer1.Enabled = False: PerformButton.Caption = "Perform I/O" Else Timer1.Enabled = True: PerformButton.Caption = "Stop I/O" End If End Sub Private Sub Timer1_Timer() MyValues(0) = 2 ^ MyIndex Call OutPortB(Address, MyValues(0)) MyValues(1) = InPortB(Address) MyValues(2) = InPortB(Address + 1) MyIndex = MyIndex + 1 MyIndex = MyIndex Mod 8 Msg = "" For j = 7 To 0 Step -1 If (MyValues(0) And (2 ^ j)) > 0 Then Msg = Msg & "1" Else Msg = Msg & "0" End If Next RelayOut.Caption = Msg Msg = "" For j = 7 To 0 Step -1 If (MyValues(1) And (2 ^ j)) > 0 Then Msg = Msg & "1" Else Msg = Msg & "0" End If Next RelayRead.Caption = Msg Msg = "" For j = 7 To 0 Step -1 If (MyValues(2) And (2 ^ j)) > 0 Then Msg = Msg & "1" Else Msg = Msg & "0" End If Next OptoIn.Caption = Msg End Sub