VERSION 5.00
Begin VB.Form ScanForm 
   Caption         =   "PCI-A16-16A 1 Scan Sample"
   ClientHeight    =   5085
   ClientLeft      =   3570
   ClientTop       =   5565
   ClientWidth     =   11850
   LinkTopic       =   "Form1"
   ScaleHeight     =   339
   ScaleMode       =   3  'Pixel
   ScaleWidth      =   790
   StartUpPosition =   2  'CenterScreen
   Begin VB.TextBox Address8Edit 
      Height          =   375
      Left            =   3120
      TabIndex        =   6
      Text            =   "C400"
      Top             =   840
      Width           =   1695
   End
   Begin VB.TextBox Address16Edit 
      Height          =   375
      Left            =   3120
      TabIndex        =   5
      Text            =   "C800"
      Top             =   480
      Width           =   1695
   End
   Begin VB.TextBox OutMemo 
      Height          =   3705
      Left            =   120
      Locked          =   -1  'True
      MultiLine       =   -1  'True
      TabIndex        =   0
      Top             =   1320
      Width           =   11610
   End
   Begin VB.CommandButton ExitButton 
      Caption         =   "E&xit"
      Height          =   375
      Left            =   10320
      TabIndex        =   2
      Top             =   840
      Width           =   1335
   End
   Begin VB.CommandButton StartButton 
      Caption         =   "Start"
      Height          =   375
      Left            =   10320
      TabIndex        =   1
      Top             =   480
      Width           =   1335
   End
   Begin VB.CommandButton StopButton 
      Caption         =   "Stop"
      Height          =   375
      Left            =   10320
      TabIndex        =   9
      Top             =   480
      Visible         =   0   'False
      Width           =   1335
   End
   Begin VB.Label Label2 
      Caption         =   "Enter the card's 8 bit address in hex:"
      Height          =   255
      Left            =   360
      TabIndex        =   8
      Top             =   900
      Width           =   2775
   End
   Begin VB.Label Address16Label 
      Caption         =   "Enter the card's 16 bit address in hex:"
      Height          =   255
      Left            =   360
      TabIndex        =   7
      Top             =   540
      Width           =   2775
   End
   Begin VB.Label StatusLabel 
      Caption         =   "Enter Addresses of PCI-AI16-16A then press Start."
      Height          =   255
      Left            =   3360
      TabIndex        =   4
      Top             =   240
      Width           =   5205
   End
   Begin VB.Label IntroLabel 
      Caption         =   "This program will take Channels of  A/D data and display, at 10Hz / scan."
      Height          =   195
      Left            =   3323
      TabIndex        =   3
      Top             =   0
      Width           =   5205
   End
End
Attribute VB_Name = "ScanForm"
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 InPort Lib "ACCES32.dll" Alias "VBInPort" (ByVal Port As Long) As Integer
Private Declare Function OutPort Lib "ACCES32.dll" Alias "VBOutPort" (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
Public Address16 As Long
Public Address8 As Long
Public done As Boolean


Private Sub CtrMode(Base As Long, Counter As Byte, Mode As Byte)
   Dim ctrl As Byte

   ctrl = (Counter * 64) Or &H30 Or (Mode * 2)
   Call OutPortB(Base + 3, ctrl)
End Sub

Private Sub CtrLoad(Base As Long, Counter As Byte, Val As Long)
   Call OutPortB(Base + Counter, Val And &HFF)
   Call OutPortB(Base + Counter, (Val \ 256) And &HFF)
End Sub

Private Function CtrRead(Base As Long, Counter As Byte) As Long
   Call OutPortB(Base + 3, Counter * 64)
   CtrRead = InPortB(Base + Counter) + (InPortB(Base + Counter) * 256)
End Function

Private Sub ExitButton_Click()
   done = True
   End
End Sub

Private Sub Form_Load()
   Dim i As Integer
   Dim found As Boolean

    found = False
    Call RegOpenKeyEx(HKEY_LOCAL_MACHINE, "Software\PCIFIND\NTioPCI\Parameters", 0, 1, hKey)
    RunFlag = True
    DataSize = 4
    num& = 0
    
    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
    
    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 &HECE8
           Address16Edit.Text = Hex$(Buf(i).BaseAddresses(2) And &HFFF8)
           Address8Edit.Text = Hex$(Buf(i).BaseAddresses(3) And &HFFF8)
           found = True
        End Select
    Next
NoCards:
    If Not found Then
       Call Application.MessageBox("No LPCI-A16-16A found. Please check that the card is installed correctly, and you have run PCIFind.", "LPCI-A16-16A not found", MB_ICONWARNING + MB_OK)
    End If
    RegCloseKey (hKey)
End Sub

Private Sub StartButton_Click()
   Dim i As Integer
   Dim j As Long
   Dim TempString As String
   Dim maxchan As Integer
   Dim span As Double
   Dim bipolar As Boolean
   
   StartButton.Visible = False
   StopButton.Visible = True

   Address8 = "&h" + Address8Edit.Text
   Address16 = "&h" + Address16Edit.Text
   done = False

   OutMemo.Text = ""
   TempString = "Card is configured for "
   If (InPortB(Address8 + 8) And 1) = 1 Then
      maxchan = 15
      TempString = TempString + "Single Ended (16CH), "
   Else
      maxchan = 7
      TempString = TempString + "Differential (8CH), "
   End If  '  end if else
   If (InPortB(Address8 + 8) And 4) = 4 Then
      span = 10#
   Else
      span = 20#
   End If
   If (InPortB(Address8 + 8) And 2) = 2 Then
      bipolar = True
      TempString = TempString + "±" + Format(span / 2, "#.##") + " (Bipolar) Volt Range"
   Else
      bipolar = False
      TempString = TempString + "0 - " + Format(span, "#.#") + " (Unipolar) Volt Range"
   End If
   StatusLabel.Caption = TempString

   Call OutPortB(Address8 + &HD, 1)         'turn on 2s complement.
   Call CtrMode(Address8 + &H14, 0, 2)      'set counter 0 mode 2
   Call CtrMode(Address8 + &H14, 1, 2)      'set counter 1 mode 2
   Call CtrMode(Address8 + &H14, 2, 2)      'set counter 2 mode 2
   Call CtrLoad(Address8 + &H14, 0, 5)
   Call CtrLoad(Address8 + &H14, 1, 1000)   'divide counter source by (1000x1000) to get 10Hz
   Call CtrLoad(Address8 + &H14, 2, 1000)
   Call OutPortB(Address8 + &H1E, &HC0)     'counter enable
   Call OutPortB(Address8 + &H3, 0)         'disable burst
'$20 half
'$80 half
   Do While ((InPortB(Address8 + &H8) And &H80) <> &H80)
      Call InPort(Address16)  'read fifo until empty
   Loop

   Call OutPortB(Address8 + &H2, (maxchan * 16))  'write high and low scan limits
   Call OutPortB(Address8 + &H1B, &H1)            'gate timer, start timing
   Call OutPortB(Address8 + &H1A, &H11)           'GO! 1 sample per channel
   TempString = ""
   For i = 0 To maxchan
      TempString = TempString & i & vbTab
      If i = 7 Then TempString = TempString
   Next  '  end for i

   OutMemo.Text = OutMemo.Text + TempString + vbCrLf
   TempString = ""

   Do
      Do While ((InPortB(Address8 + &H8) And &H80) > 0)
         DoEvents 'wait for not empty
      Loop
      TempString = ""
      Do While (Not ((InPortB(Address8 + &H8) And &H80) > 0)) 'drain until empty
         j = InPort(Address16)
         TempString = TempString & Format$((j / 65536#) * span, " 0.##0;-0.##0") & vbTab
      Loop  '  end while not inportb

      If Len(OutMemo.Text) > 888 Then
         OutMemo.SelStart = 18
         OutMemo.SelLength = 58
         OutMemo.SelText = ""
      End If

      OutMemo.Text = OutMemo.Text + TempString + vbCrLf
      DoEvents
   Loop Until (done)

   Call CtrMode(Address8 + &H14, 2, 2)  'stop data
   OutMemo.Text = OutMemo.Text + "Program done." + vbCrLf
End Sub

Private Sub StopButton_Click()
   done = True
   StartButton.Visible = True
   StopButton.Visible = False
End Sub