usb_device.cls

USBLIB FOR VB,USBLIB FOR VB

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "USB_Device"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit                                 ' Good programmers write clean, documented code and take no chances ....

'******************************************************* USB class driver **********************************************
' Version -1 ( minus one. meaning it is not finshed yet ... )
' Written by Vincent Himpe. Use as you please , i'm not responsible for anything that may, or may not, happen.
' ------------------------------------------------------ Internal datatypes --------------------------------------------
Private Type USB_Device_Descriptor
        Length As Byte
        DescriptorType As Byte
        USBversion As Integer
        DeviceClass As Byte
        DeviceSubClass As Byte
        DeviceProtocol As Byte
        MaxPacketSize0 As Byte
        idVendor As Integer
        idProduct As Integer
        bcdDevice As Integer
        iManufacturer As Byte
        iProduct As Byte
        iSerialNumber As Byte
        bNumConfigurations As Byte
End Type

Private Type USB_EndPointDescriptor
        bLength As Byte
        bDescriptorType As Byte
        bEndpointAddress As Byte
        bmAttributes As Byte
        wMaxPacketSize As Integer
        bInterval As Byte
        bRefresh As Byte
        bSynchAddress As Byte
End Type

Private Type USB_InterfaceDescriptor
        bLength As Byte
        bDescriptorType As Byte
        bInterfaceNumber As Byte
        bAlternateSetting As Byte
        bNumEndpoints As Byte
        bInterfaceClass As Byte
        bInterfaceSubClass As Byte
        bInterfaceProtocol As Byte
        iInterface As Byte
End Type

Private Type USB_ConfigDescriptor
        bLength As Byte
        bDescriptorType As Byte
        wTotalLength As Integer
        bNumInterfaces As Byte
        bConfigurationValue As Byte
        iConfiguration As Byte
        bmAttributes As Byte
        MaxPower As Byte
End Type

' ------------------------------------------------------ LIBUSB prototypes ---------------------------------------------
' For more information on these functions consult libusb.bas
' That file has the full comment
Private Declare Function USB_GetDescriptor Lib "libusbvb0.dll" Alias "vb_usb_get_descriptor" ( _
        ByVal dev As Long, _
        ByVal dtype As Long, _
        ByVal index As Long, _
        ByRef buf As Any, _
        ByVal size As Long) _
        As Long
Private Declare Function USB_GetString Lib "libusbvb0.dll" Alias "vb_usb_get_string" ( _
        ByVal dev As Long, _
        ByVal index As Long, _
        ByVal langid As Long, _
        ByRef buf As Any, _
        ByVal size As Long) _
        As Long
Private Declare Function USB_GetStringSimple Lib "libusbvb0.dll" Alias "vb_usb_get_string_simple" ( _
        ByVal dev As Long, _
        ByVal index As Long, _
        ByRef buf As Any, _
        ByVal size As Long) _
        As Long
Private Declare Function USB_Open Lib "libusbvb0.dll" Alias "vb_usb_open" ( _
        ByVal index As Long, _
        ByVal VID As Long, _
        ByVal PID As Long) _
        As Long
Private Declare Function USB_Close Lib "libusbvb0.dll" Alias "vb_usb_close" ( _
        ByVal dev As Long) _
        As Long
Private Declare Function USB_GetDescriptor_ByEndpoint Lib "libusbvb0.dll" Alias "vb_usb_get_descriptor_by_endpoint" ( _
        ByVal dev As Long, _
        ByVal ep As Long, _
        ByVal dtype As Long, _
        ByVal index As Long, _
        ByRef buf As Any, _
        ByVal size As Long) _
        As Long
Private Declare Function USB_Bulk_Write Lib "libusbvb0.dll" Alias "vb_usb_bulk_write" ( _
        ByVal dev As Long, _
        ByVal ep As Long, _
        ByRef buf As Any, _
        ByVal size As Long, _
        ByVal timeout As Long) _
        As Long
Private Declare Function USB_Bulk_Read Lib "libusbvb0.dll" Alias "vb_usb_bulk_read" ( _
        ByVal dev As Long, _
        ByVal ep As Long, _
        ByRef buf As Any, _
        ByVal size As Long, _
        ByVal timeout As Long) _
        As Long
Private Declare Function USB_Interrupt_Write Lib "libusbvb0.dll" Alias "vb_usb_interrupt_write" ( _
        ByVal dev As Long, _
        ByVal ep As Long, _
        ByRef buf As Any, _
        ByVal size As Long, _
        ByVal timeout As Long) _
        As Long
Private Declare Function USB_Interrupt_Read Lib "libusbvb0.dll" Alias "vb_usb_interrupt_read" ( _
        ByVal dev As Long, _
        ByVal ep As Long, _
        ByRef buf As Any, _
        ByVal size As Long, _
        ByVal timeout As Long) _
        As Long
Private Declare Function USB_Control_Msg Lib "libusbvb0.dll" Alias "vb_usb_control_msg" ( _
        ByVal dev As Long, _
        ByVal requesttype As Long, _
        ByVal request As Long, _
        ByVal value As Long, _
        ByVal index As Long, _
        ByVal buf As Any, _
        ByVal size As Long, _
        ByVal timeout As Long) _
        As Long
Private Declare Function USB_Set_Configuration Lib "libusbvb0.dll" Alias "vb_usb_set_configuration" ( _
        ByVal dev As Long, _
        ByVal configuration As Long) _
        As Long
Private Declare Function USB_Claim_Interface Lib "libusbvb0.dll" Alias "vb_usb_claim_interface" ( _
        ByVal dev As Long, _
        ByVal interface As Long) _
        As Long
Private Declare Function USB_Release_Interface Lib "libusbvb0.dll" Alias "vb_usb_release_interface" ( _
        ByVal dev As Long, _
        ByVal interface As Long) _
        As Long
Private Declare Function USB_Set_Altinterface Lib "libusbvb0.dll" Alias "vb_usb_set_altinterface" ( _
        ByVal dev As Long, _
        ByVal alternate As Long) _
        As Long
Private Declare Function USB_ResetEndpoint Lib "libusbvb0.dll" Alias "vb_usb_resetep" ( _
        ByVal dev As Long, _
        ByVal ep As Long) _
        As Long
Private Declare Function USB_ClearHalt Lib "libusbvb0.dll" Alias "vb_usb_clear_halt" ( _
        ByVal dev As Long, _
        ByVal ep As Long) _
        As Long
Private Declare Function USB_Reset Lib "libusbvb0.dll" Alias "vb_usb_reset" ( _
        ByVal dev As Long) _
        As Long
Private Declare Function USB_GetConfigurationDescriptor Lib "libusbvb0.dll" Alias "vb_usb_get_configuration_descriptor" ( _
        ByVal dev As Long, _
        ByVal config_index As Long, _
        ByRef descriptor As UsbConfigDescriptor) _
        As Boolean
Private Declare Function USB_GetInterfaceDescriptor Lib "libusbvb0.dll" Alias "vb_usb_get_interface_descriptor" ( _
        ByVal dev As Long, _
        ByVal config_index As Long, _
        ByVal interface_index As Long, _
        ByVal alt_index As Long, _
        ByRef descriptor As UsbInterfaceDescriptor) _
        As Boolean
Private Declare Function USB_GetEndpointDescriptor Lib "libusbvb0.dll" Alias "vb_usb_get_endpoint_descriptor" ( _
        ByVal dev As Long, _
        ByVal config_index As Long, _
        ByVal interface_index As Long, _
        ByVal alt_index As Long, _
        ByVal endpoint_index As Long, _
        ByRef descriptor As UsbEndPointDescriptor) _
        As Boolean


Private Const DSC_Device = 1       ' this defines the Device Descriptor
Private Const DSC_DeviceSize = 18  ' this defines the size of a device descriptor
Private my_handle As Long          ' this holds the assigned handle from USB_Open
Private my_vid As Long             ' this holds my VID as long
Private my_pid As Long             ' this holds my PID as long
Private my_version As String       ' this holds my USB version as string
Private my_product As String       ' this holds my ProductID as string      Read from Device
Private my_vendor As String        ' this holds my VendorID  as string      Read from Device
Private my_serial As String        ' this holds my Serial Number as string  Read from device
Private my_configurations As Long  ' holds the number of configurations
Private my_interfaces As Long      ' holds the number of interfaces this device has
Private my_endpoints As Long       ' holds the number of endpoints

Public Event error(errnum, errstring) ' is fired whenever a problem is detected


Dim my_descriptor As USB_Device_Descriptor
Dim my_config As USB_ConfigDescriptor
Dim my_interface As USB_InterfaceDescriptor
Dim my_endpoint As USB_EndPointDescriptor

Dim my_buffer(0 To 255) As Byte

' --------------------------- start -------------------------------
Public Function Start(index, Optional VID = -1, Optional PID = -1) As Integer
    Dim usbver
    If my_handle = 0 Then
       my_handle = USB_Open(index, VID, PID)
       If my_handle = 0 Then
          Start = 0
          RaiseEvent error(1, "Could not Open device")
       Else
          If (USB_GetDescriptor(my_handle, DSC_Device, 0, my_descriptor, DSC_DeviceSize) <> DSC_DeviceSize) Then
             RaiseEvent error(3, "Failed to retrieve descriptor")
          Else
             my_vid = my_descriptor.idVendor
             my_pid = my_descriptor.idProduct
             If (my_descriptor.iManufacturer) Then
                If (USB_GetStringSimple(my_handle, my_descriptor.iManufacturer, my_buffer(0), UBound(my_buffer))) Then
                    my_vendor = StrConv(my_buffer, vbUnicode)
                    my_vendor = Left$(my_vendor, InStr(my_vendor, Chr$(0)) - 1)  ' get rid of all the NULL characters
                End If
             Else
                my_vendor = "Not specified"
             End If
             If (my_descriptor.iProduct) Then
                If (USB_GetStringSimple(my_handle, my_descriptor.iProduct, my_buffer(0), UBound(my_buffer))) Then
                    my_product = StrConv(my_buffer, vbUnicode)
                    my_product = Left$(my_product, InStr(my_product, Chr$(0)) - 1)  ' get rid of all the NULL characters
                End If
             Else
                my_product = "Not specified"
             End If
             If (my_descriptor.iSerialNumber) Then
                If (USB_GetStringSimple(my_handle, my_descriptor.iSerialNumber, my_buffer(0), UBound(my_buffer))) Then
                    my_serial = StrConv(my_buffer, vbUnicode)
                    my_serial = Left$(my_serial, InStr(my_serial, Chr$(0)) - 1)  ' get rid of all the NULL characters
                End If
             Else
                my_serial = "Not specified"
             End If
             usbver = Hex$(my_descriptor.USBversion)
             Mid$(usbver, 3, 1) = Mid$(usbver, 2, 1)
             Mid$(usbver, 2, 1) = "."
             my_version = usbver
             my_configurations = my_descriptor.bNumConfigurations
          End If
          Start = 1
       End If
    Else
       Start = 0
       RaiseEvent error(2, "Already handling a device")
    End If
End Function
Public Sub Release()
       Dim x
       If my_handle <> 0 Then         ' be careful not to close an empty handle !
          x = USB_Close(my_handle)
       End If
       my_handle = 0                  ' destroy the handle
End Sub
Public Property Get VID() As Long
       If my_handle = 0 Then          ' if the handle is empty , this is pointless
          RaiseEvent error(9, "Device not open")
       Else
          VID = my_vid
       End If
End Property
Public Property Get PID() As Long
       If my_handle = 0 Then          ' if the handle is empty , this is pointless
          RaiseEvent error(9, "Device not open")
       Else
          PID = my_pid
       End If
End Property
Public Property Get VendorID() As String
       If my_handle = 0 Then          ' if the handle is empty , this is pointless
          RaiseEvent error(9, "Device not open")
       Else
          VendorID = my_vendor
       End If
End Property
Public Property Get ProductID() As String
       If my_handle = 0 Then          ' if the handle is empty , this is pointless
          RaiseEvent error(9, "Device not open")
       Else
          ProductID = my_product
       End If
End Property
Public Property Get Serial() As String
       If my_handle = 0 Then          ' if the handle is empty , this is pointless
          RaiseEvent error(9, "Device not open")
       Else
          Serial = my_serial
       End If
End Property
Public Property Get USBversion() As String
       If my_handle = 0 Then          ' if the handle is empty , this is pointless
          RaiseEvent error(9, "Device not open")
       Else
          USBversion = my_version
       End If
End Property

' ------------------------------------------------------ Internal datatypes --------------------------------------------
' the routines below are not ready for showtime yet. so i made them private ...


Private Property Get Number_Of_Configurations() As Integer
       Number_Of_Configurations = my_configurations
End Property
Private Property Get Configuration_Information(index As Integer) As String
       If index > my_configurations Then
          RaiseEvent error(4, "No configurations or device not open")
       Else
         ' If USB_GetConfigurationDescriptor(my_handle, index, my_config) Then
         '    my_interfaces = my_config.bNumInterfaces
         ' Else
         ' RaiseEvent error(5, "No configuration for index " & index)
         ' End If
       End If
End Property
Private Property Get Number_Of_interfaces(config_index, interface_index, alt_index) As Integer
   '    If index > my_interfaces Then
   '       RaiseEvent error(6, "No such interface number")
   '    Else
   '       If USB_GetInterfaceDescriptor(my_handle, config_index, interface_index, alt_index, my_interface) Then
   '       Else
   '          RaiseEvent error(7, "No configuration for interface")
   '       End If
   '    End If
End Property
Private Property Get Interface_information(interface As Long) As String

End Property
Private Property Get Number_Of_Endpoints() As Integer

End Property
Private Property Get Endpoint_Information(interface As Long, endpoint As Long) As String

End Property
Private Function Bulk_Write(endpoint, datablock, Optional size = 0) As Integer

End Function
Private Function Bulk_read(endpoint, datablock, Optional size = 0) As Integer

End Function