VERSION 5.00
Begin VB.Form Form1 
   BorderStyle     =   3  'Fixed Dialog
   Caption         =   "ACCES32 Sample"
   ClientHeight    =   3615
   ClientLeft      =   3210
   ClientTop       =   2580
   ClientWidth     =   5205
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   241
   ScaleMode       =   3  'Pixel
   ScaleWidth      =   347
   StartUpPosition =   2  'CenterScreen
   Begin VB.CommandButton ReadWordButton 
      Caption         =   "Read Word"
      Height          =   300
      Left            =   3720
      TabIndex        =   6
      Top             =   2040
      Width           =   1335
   End
   Begin VB.CommandButton WriteWordButton 
      Caption         =   "Write Word"
      Height          =   300
      Left            =   3720
      TabIndex        =   5
      Top             =   1560
      Width           =   1335
   End
   Begin VB.ComboBox AddressList 
      Height          =   315
      ItemData        =   "Form1.frx":0000
      Left            =   2160
      List            =   "Form1.frx":0002
      Style           =   2  'Dropdown List
      TabIndex        =   0
      Top             =   720
      Width           =   2895
   End
   Begin VB.CommandButton ExitButton 
      Cancel          =   -1  'True
      Caption         =   "E&xit Program"
      Height          =   315
      Left            =   1560
      TabIndex        =   7
      Top             =   2520
      Width           =   2055
   End
   Begin VB.CommandButton ReadByteButton 
      Caption         =   "Read Byte"
      Height          =   300
      Left            =   2280
      TabIndex        =   4
      Top             =   2040
      Width           =   1335
   End
   Begin VB.CommandButton WriteByteButton 
      Caption         =   "Write Byte"
      Height          =   300
      Left            =   2280
      TabIndex        =   3
      Top             =   1560
      Width           =   1335
   End
   Begin VB.TextBox ValueWriteEdit 
      Height          =   285
      Left            =   1200
      TabIndex        =   2
      Text            =   "FF"
      Top             =   1560
      Width           =   975
   End
   Begin VB.TextBox AddressEdit 
      Height          =   285
      Left            =   2640
      TabIndex        =   1
      Top             =   1080
      Width           =   975
   End
   Begin VB.Label CardLabel 
      AutoSize        =   -1  'True
      Caption         =   "Please select a card to use:"
      Height          =   195
      Left            =   120
      TabIndex        =   15
      Top             =   750
      Width           =   1965
   End
   Begin VB.Label StatusLabel 
      BorderStyle     =   1  'Fixed Single
      Height          =   255
      Left            =   375
      TabIndex        =   14
      Top             =   3000
      Width           =   4455
   End
   Begin VB.Label ValueReadLabel 
      BorderStyle     =   1  'Fixed Single
      Caption         =   "FF"
      Height          =   315
      Left            =   1200
      TabIndex        =   13
      Top             =   2040
      Width           =   975
   End
   Begin VB.Label ReadLabel 
      AutoSize        =   -1  'True
      Caption         =   "Value Read:"
      Height          =   195
      Left            =   120
      TabIndex        =   12
      Top             =   2070
      Width           =   885
   End
   Begin VB.Label WriteLabel 
      AutoSize        =   -1  'True
      Caption         =   "Value to Write:"
      Height          =   195
      Left            =   120
      TabIndex        =   11
      Top             =   1590
      Width           =   1050
   End
   Begin VB.Label AddressLabel 
      AutoSize        =   -1  'True
      Caption         =   "Please select an address to use:"
      Height          =   195
      Left            =   120
      TabIndex        =   10
      Top             =   1110
      Width           =   2295
   End
   Begin VB.Label Label2 
      AutoSize        =   -1  'True
      Caption         =   "All numbers are in HEXADECIMAL"
      Height          =   195
      Left            =   1387
      TabIndex        =   9
      Top             =   360
      Width           =   2430
   End
   Begin VB.Label Label1 
      Alignment       =   2  'Center
      Caption         =   "ACCES32 VISUAL BASIC 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            =   180
      TabIndex        =   8
      Top             =   0
      Width           =   4845
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private Declare Function OutPortB Lib "ACCES32" Alias "VBOutPortB" (ByVal Port As Long, ByVal Value As Byte) As Integer
Private Declare Function InPortB Lib "ACCES32" Alias "VBInPortB" (ByVal Port As Long) 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, ByRef lpType As Long, ByRef lpData As Any, ByRef 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 BaseAddresses(255) As Long
   
Private Sub AddressList_Click()
   AddressEdit.Text = Hex$(BaseAddresses(AddressList.ListIndex))
End Sub

Private Sub ExitButton_Click()
   End
End Sub

Private Sub Form_Load()
   Dim i As Integer
   Dim Num As Integer
   Dim DataSize As Long
   Dim BaseIndexOffset As Integer
   Dim CompanyKey As String
   Dim TempString As String
   Dim DataType As Long
   Dim Buf(255) As TPCI_COMMON_CONFIG
   Dim Result As Long
   Dim hKey As Long
   
   Call RegOpenKeyEx(HKEY_LOCAL_MACHINE, "Software\PCIFIND", 0, 1, hKey)
   CompanyKey = Space$(255)
   DataSize = 255
   Call RegQueryValueEx(hKey, "Company", 0, DataType, ByVal CompanyKey, DataSize)
   Call RegCloseKey(hKey)

   CompanyKey = Trim$(Left(CompanyKey, DataSize - 1))
   CompanyKey = "Software\" + CompanyKey + "\Cardlist"
      
   TempString = Space$(255)
   BaseIndexOffset = 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
   
   Result = RegOpenKeyEx(HKEY_LOCAL_MACHINE, "Software\PCIFIND\NTioPCI\Parameters", 0, 1, hKey)
   DataSize = 4
   Result = RegQueryValueEx(hKey, "NumDevices", 0, DataType, Num, DataSize)
   If (Num > 0) Then
      DataSize = 64 * 128
      Result = RegQueryValueEx(hKey, "PCICommonConfig", 0, DataType, Buf(0), DataSize)
   End If
   RegCloseKey (hKey)

   DataSize = 255
   For i = 0 To Num - 1
      If (Buf(i).VendorID = &H494F) Then
         On Error Resume Next
            Call RegOpenKeyEx(HKEY_LOCAL_MACHINE, CompanyKey, 0, 1, hKey)
            Call RegQueryValueEx(hKey, Hex$(Buf(i).DeviceID) + "$", 0, DataType, ByVal TempString, DataSize)
            If (InStr(TempString, "COM2") > 0) Then
               BaseIndexOffset = 2
            Else
               BaseIndexOffset = 0
            End If
            DataSize = 255
            TempString = Space$(255)
            Call RegQueryValueEx(hKey, Hex$(Buf(i).DeviceID), 0, DataType, ByVal TempString, DataSize)
            TempString = Trim$(Left(TempString, DataSize - 1))

            Buf(i).BaseAddresses(2) = Buf(i).BaseAddresses(2) And &HFFFE
            Buf(i).BaseAddresses(3) = Buf(i).BaseAddresses(3) And &HFFFE
            Buf(i).BaseAddresses(4) = Buf(i).BaseAddresses(4) And &HFFFE
            Buf(i).BaseAddresses(5) = Buf(i).BaseAddresses(5) And &HFFFE

            If (Buf(i).BaseAddresses(2 + BaseIndexOffset) > 0) Then ' if the card has any base addresses
               AddressList.AddItem (TempString + ": " + Hex$(Buf(i).BaseAddresses(2 + BaseIndexOffset)))
               Dim TempNum As Integer
               Dim TempNum2 As Long
               TempNum = 0
               TempNum2 = 0
               TempNum = (AddressList.ListCount - 1)
               TempNum2 = Buf(i).BaseAddresses(2 + BaseIndexOffset)
               BaseAddresses(TempNum) = TempNum2 ' AddressList.ListCount - 1) = Buf(i).BaseAddresses(2 + BaseIndexOffset)
            End If
            If (Buf(i).BaseAddresses(3 + BaseIndexOffset) > 0) Then
               AddressList.AddItem (TempString + ": " + Hex$(Buf(i).BaseAddresses(3 + BaseIndexOffset)))
               BaseAddresses(AddressList.ListCount - 1) = Buf(i).BaseAddresses(3 + BaseIndexOffset)
            End If
            If BaseIndexOffset = 0 Then
               If (Buf(i).BaseAddresses(4) > 0) Then
                  AddressList.AddItem (TempString + ": " + Hex$(Buf(i).BaseAddresses(4)))
                  BaseAddresses(AddressList.ListCount - 1) = Buf(i).BaseAddresses(4)
               End If
               If (Buf(i).BaseAddresses(5) > 0) Then
                  AddressList.AddItem (TempString + ": " + Hex$(Buf(i).BaseAddresses(5)))
                  BaseAddresses(AddressList.ListCount - 1) = Buf(i).BaseAddresses(5)
               End If
            End If  '  end if BaseIndexOffset
         On Error GoTo 0
         Call RegCloseKey(hKey)
      End If  '  end if ACCES Card
   Next  '  end for i

   If (Num > 0) And (AddressList.ListCount <> 0) Then
      AddressList.ListIndex = 0
      AddressEdit.Text = Hex$(BaseAddresses(0))
   End If
End Sub

Private Sub ReadByteButton_Click()
   Dim Addr As Long
   Dim x As Integer
      
   Addr& = Val("&H" + AddressEdit.Text)
   x% = InPortB(Addr&)
   ValueReadLabel.Caption = Format(Hex$(x% And &HFF), "00")
   StatusLabel.Caption = "Read was successful"
End Sub

Private Sub ReadWordButton_Click()
   Dim Addr As Long
   Dim x As Integer
   
   Addr& = Val("&H" + AddressEdit.Text)
   x% = InPortB(Addr&)
   ValueReadLabel.Caption = Format(Hex$(x% And &HFFFF), "0000")
   StatusLabel.Caption = "Read was successful"
End Sub

Private Sub WriteByteButton_Click()
   Dim Addr As Long
   Dim x As Integer
   Dim Value As Byte
      
   Addr& = Val("&H" + AddressEdit.Text)
   Value = Val("&H" + ValueWriteEdit.Text) And &HFF
   Call OutPortB(Addr&, Value)
   StatusLabel.Caption = "Write was successful"
End Sub

Private Sub WriteWordButton_Click()
   Dim Addr As Long
   Dim x As Integer
   Dim Value As Long
   
   Addr& = Val("&H" + AddressEdit.Text)
   Value = Val("&H" + ValueWriteEdit.Text) And &HFFFF
   Call OutPortB(Addr&, Value)
   StatusLabel.Caption = "Write was successful"
End Sub