apietc.bas

usb pci detection to usb port device

    BinaryToDecimal = Decimal1
End Function
Public Function ByteFormat(CurInfo As String) As String
    Select Case Len(CurInfo)
    Case 0
        ByteFormat = "00000000"
    Case 1
        ByteFormat = "0000000" & CurInfo
    Case 2
        ByteFormat = "000000" & CurInfo
    Case 3
        ByteFormat = "00000" & CurInfo
    Case 4
        ByteFormat = "0000" & CurInfo
    Case 5
        ByteFormat = "000" & CurInfo
    Case 6
        ByteFormat = "00" & CurInfo
    Case 7
        ByteFormat = "0" & CurInfo
    Case Else
        ByteFormat = CurInfo
    End Select
End Function
''Mimic C++ Function
Public Function CTL_CODE(lngDevFileSys As Long, _
                         lngFunction As Long, _
                         lngMethod As Long, _
                         lngAccess As Long) As Long
    CTL_CODE = (lngDevFileSys * (2 ^ 16)) Or (lngAccess * (2 ^ 14)) Or (lngFunction * (2 ^ 2)) Or lngMethod
End Function
Public Function DecimalToBinary(Dec As Variant) As String
Dim Decimal1 As Long
Dim Binary1  As String
Dim Binary2  As String
Dim A        As Integer
    Binary1 = vbNullString
    Binary2 = vbNullString
    Decimal1 = Dec
    Do Until Decimal1 = 0
        If Not Postal(Decimal1) Then
            Binary2 = Binary2 & 1
        ElseIf Postal(Decimal1) Then
            Binary2 = Binary2 & 0
        End If
        Decimal1 = Int(Decimal1 / 2)
    Loop
    For A = Len(Binary2) To 1 Step -1
        Binary1 = Binary1 & Mid$(Binary2, A, 1)
    Next A
    DecimalToBinary = Binary1
End Function
Public Function GetVar(Address As Long, _
                       Length As Long)
'Using ByVal Address because I am passing the raw memory address
'   and not a defined variable
'Using Length to determine size in bytes then using CopyMemory
'   to pass one byte at a time.  Passing one byte at a time
'   because the card and Windows are accessing the same memory.
'   The GeniusBus card does have a read and write memory request,
'   but I am using this trick because I'm only concerned with one,
'   to a only a few bytes at a time.
Dim b    As Byte
Dim I(1) As Byte
Dim l(3) As Byte
    If Length = 1 Then
        CopyMemory b, ByVal Address, Length
        GetVar = b
    ElseIf Length = 2 Then
        CopyMemory I(0), ByVal Address, 1
        CopyMemory I(1), ByVal Address + 1, 1
        GetVar = MakeInt(I(1), I(0))
    ElseIf Length = 4 Then
        CopyMemory l(0), ByVal Address, 1
        CopyMemory l(1), ByVal Address + 1, 1
        CopyMemory l(2), ByVal Address + 2, 1
        CopyMemory l(3), ByVal Address + 3, 1
        GetVar = MakeLong((MakeInt(l(3), l(2))), (MakeInt(l(1), l(0))))
    End If
End Function
Public Function HiByte(ByVal w As Integer) As Byte
    If w And &H8000 Then
        HiByte = &H80 Or ((w And &H7FFF) \ &HFF)
    Else
        HiByte = w \ 256
    End If
End Function
Public Function HiWord(dw As Long) As Integer
    If dw And &H80000000 Then
        HiWord = (dw \ 65535) - 1
    Else
        HiWord = dw \ 65535
    End If
End Function
Public Function LoByte(w As Integer) As Byte
    LoByte = w And &HFF
End Function
Public Function LoWord(dw As Long) As Integer
    If dw And &H8000& Then
        LoWord = &H8000 Or (dw And &H7FFF&)
    Else
        LoWord = dw And &HFFFF&
    End If
End Function
Public Function MakeInt(ByVal LByte As Byte, _
                        ByVal HByte As Byte) As Integer
Dim temp(1) As Byte
    temp(0) = HByte
    temp(1) = LByte
    CopyMemory MakeInt, temp(0), 2
End Function
Public Function MakeLong(ByVal LoWord As Integer, _
                         ByVal HiWord As Integer) As Single
    MakeLong = ((HiWord * &H10000) + LoWord)
End Function
Private Function Postal(Getal As Long) As Boolean
    If Getal = Int(Getal / 2) * 2 Then
        Postal = True
    ElseIf Getal <> Int(Getal / 2) * 2 Then
        Postal = False
    End If
End Function
Public Function SetVar(Address As Long, _
                       Data As Variant, _
                       Length As Integer)
'Using ByVal Address because I am passing the raw memory address
'   and not a defined variable
'Using Length to determine size in bytes then using CopyMemory
'   to pass one byte at a time.  Passing one byte at a time
'   because the card and Windows are accessing the same memory.
'   The GeniusBus card does have a read and write memory request,
'   but I am using this trick because I'm only concerned with one,
'   to a only a few bytes at a time.
Dim I(1) As Byte
Dim l(3) As Byte
    IO_Display.Text1 = vbNullString
    If Length = 1 Then
        CopyMemory ByVal Address, CByte(Data), 1
    ElseIf Length = 2 Then
        I(0) = HiByte(CInt(Data))
        I(1) = LoByte(CInt(Data))
        CopyMemory ByVal Address, I(0), 1
        CopyMemory ByVal Address + 1, I(1), 1
    ElseIf Length = 4 Then
        CopyMemory l(0), (CSng(Data)), 4
        
'l(0) = HiByte(HiWord(CSng(Data)))
'l(1) = LoByte(HiWord(CSng(Data)))
'l(2) = HiByte(LoWord(CSng(Data)))
'l(3) = LoByte(LoWord(CSng(Data)))

        CopyMemory ByVal Address, l(0), 1
        CopyMemory ByVal Address + 1, l(1), 1
        CopyMemory ByVal Address + 2, l(2), 1
        CopyMemory ByVal Address + 3, l(3), 1
    End If
End Function