test.frm

USBLIB FOR VB,USBLIB FOR VB

VERSION 5.00
Begin VB.Form Form1 
   Caption         =   "LibUSB DemoProgram"
   ClientHeight    =   7470
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   7995
   LinkTopic       =   "Form1"
   ScaleHeight     =   7470
   ScaleWidth      =   7995
   StartUpPosition =   3  '窗口缺省
   Begin VB.CommandButton Command2 
      Caption         =   "Using the USB_Device Class"
      Height          =   375
      Left            =   4680
      TabIndex        =   2
      Top             =   120
      Width           =   3135
   End
   Begin VB.CommandButton Command1 
      Caption         =   "The classical way ..."
      Height          =   375
      Left            =   240
      TabIndex        =   1
      Top             =   120
      Width           =   3015
   End
   Begin VB.TextBox textbox 
      BeginProperty Font 
         Name            =   "Courier New"
         Size            =   9.75
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   6495
      Left            =   240
      MultiLine       =   -1  'True
      ScrollBars      =   3  'Both
      TabIndex        =   0
      Top             =   720
      Width           =   7575
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
' ******************************************** LIBusb demo program *************************************************
' Written by Vincent Himpe
' ******************************************************************************************************************
Option Explicit                               ' we force ourselves to write clean code. No messy 'street basic' here

' Define some datastructures used throughout this program

Dim my_descriptor As UsbDeviceDescriptor
Dim dev_config As UsbConfigDescriptor
Dim my_interface As UsbInterfaceDescriptor
Dim my_endpoint As UsbEndPointDescriptor

' Create an object 'my_usbdevice' that belongs to the 'USB_device' class and inherits events from that class.
' In the Form_load routine we will assign this object to a new instance of USB_class

Private WithEvents my_usbdevice As USB_Device
Attribute my_usbdevice.VB_VarHelpID = -1
' ********************************************** This code interfaces to a custom class ****************************
' It does not implement the full USB information walker as the other demo (command1_click), but shows the basic
' workings with the USB_Device class
Sub Form_load()
    Set my_usbdevice = New USB_Device                        ' assign a new instance of USB_Device to 'my_usbdevice'
End Sub
Private Sub Command2_Click()                                 ' handles the clicking of the 'The Class way' button
    Dim index                                                ' define a local variable
    index = 0                                                ' and set it to zero
    UsbInit                                                  ' Initialise the USB engine
    textbox.Text = ""                                        ' erase all text in the textbox
    While my_usbdevice.Start(index) <> 0                     ' As long as there are devices : start device number 'index'
          msg " Device : " & index                           ' show some information
          msg " Product ID : (" & Hex$(my_usbdevice.PID) & ") : " & my_usbdevice.ProductID
          msg " Vendor  ID : (" & Hex$(my_usbdevice.VID) & ") : " & my_usbdevice.VendorID
          msg " Serial nr  : " & my_usbdevice.Serial
          my_usbdevice.Release                               ' release the device. we no longer need it
          index = index + 1                                  ' increment index so we can grab the next device
    Wend                                                     ' Keep going
End Sub

' If , during USB access , errors should occur in the USB_class then this event will be raised.
' The errornumber and errormessage are passed. so we simply show them to the user

Private Sub my_usbdevice_error(errnum, errstring)
    MsgBox " Error " & errnum & vbCrLf & errstring, vbOKOnly, "USB error"
End Sub

' ********************************************** This code interfaces directly to the DLL ***************************
Private Sub Command1_Click()
    scan_bus
End Sub
' Scan bus performs the actual scanning of the USB bus.
Private Sub scan_bus()
    Dim buffer(0 To 255) As Byte                                 ' define a local buffer for string transfers
    Dim i, x As Long
    Dim my_handle As Long
    Dim usbver
    textbox.Text = ""                                            ' erase the textbox
    UsbInit                                                      ' Start the USB engine
    UsbSetDebug (255)                                            ' needs commenting....
    i = 0                                                        ' we start with device 0
    my_handle = UsbOpen(i, -1, -1)                               ' attempt to obtain a handle
    Do While my_handle                                           ' if successful : ( if not , handle will be 0 )
        ' get the descriptor information
        If (UsbGetDescriptor(my_handle, USB_DT_DEVICE, 0, my_descriptor, USB_DT_DEVICE_SIZE) = USB_DT_DEVICE_SIZE) Then
            ' show some information
            msg "Device " & i
            msg "-- VID             : " & Hex$(my_descriptor.idVendor)
            msg "-- PID             : " & Hex$(my_descriptor.idProduct) & " "
            
            
            If (my_descriptor.iManufacturer) Then                 ' if there is a manufacturer string
                If (UsbGetStringSimple(my_handle, my_descriptor.iManufacturer, buffer(0), UBound(buffer))) Then
                    msg "-- Manufacturer    : " & StrConv(buffer, vbUnicode)
                    msg " "
                End If
            Else                                                  ' if no manufacturer string : return a default
                msg "-- Manufacturer    : not specified"
            End If
                        
            If (my_descriptor.iProduct) Then                      ' if there is a product string
                If (UsbGetStringSimple(my_handle, my_descriptor.iProduct, buffer(0), UBound(buffer))) Then
                    msg "-- Product         : " & StrConv(buffer, vbUnicode)
                    msg " "
                End If
            Else                                                  ' if not ,return a feault
                msg "-- Product         : not specified"
            End If
            
            If (my_descriptor.iSerialNumber) Then                 ' if there is a serial number string
                If (UsbGetStringSimple(my_handle, my_descriptor.iSerialNumber, buffer(0), UBound(buffer))) Then
                    msg "-- Serial  nmbr    : " & StrConv(buffer, vbUnicode)
                    msg " "
                End If
            Else                                                  ' if not ...
                msg "-- Serial  nmbr    : not specified"
            End If
            
            ' retrieve the USB version. USB version is returned as a 3 digit Binary coded decimal (BCD)
            usbver = Hex$(my_descriptor.bcdUSB)                   ' convert to a hexadecimal string
            Mid$(usbver, 3, 1) = Mid$(usbver, 2, 1)               ' move the second character 1 position to the right
            Mid$(usbver, 2, 1) = "."                              ' replace the second caracter with a dot (.)
            msg "-- USB version     : " & usbver                  ' and show to the user
            msg "-- Device Class    : " & my_descriptor.bDeviceClass
            msg "-- Subclass        : " & my_descriptor.bDeviceSubClass
            For x = 0 To my_descriptor.bNumConfigurations - 1     ' for as many configurations
                print_configuration my_handle, x                  ' call print_configuration
            Next x
        End If
        UsbClose (my_handle)                                      ' release the device. we no longer need it
        i = i + 1                                                 ' increment the device number
        my_handle = UsbOpen(i, -1, -1)                            ' and try to open again..
    Loop                                                          ' keep going until usbopen returns 0 in my_handle
    ' there are no more devices : end of this routine
End Sub

Sub print_configuration(handle As Long, index)
    Dim x
    If UsbGetConfigurationDescriptor(handle, index, dev_config) Then   ' fetch the configuration
        msg "--- Configuration   : " & index
        msg "--- Total Length    : " & dev_config.wTotalLength
        msg "--- Num interfaces  : " & dev_config.bNumInterfaces
        msg "--- Config. Value   : " & dev_config.bConfigurationValue
        msg "--- Configuration   : " & dev_config.iConfiguration
        msg "--- Attributes      : " & Hex$(dev_config.bmAttributes)
        msg "--- Max Power       : " & dev_config.MaxPower
    End If
    For x = 0 To dev_config.bNumInterfaces - 1                         ' for as many interfaces
        print_interface handle, index, x                               ' call print_interface
    Next x
    ' no more configuration info
End Sub
Sub print_interface(handle As Long, config_index, interface_index)
    Dim x
    Dim alt        ' There are alternates possible. How many is uncertain , we need to try one by one until it fails
    alt = 0
    Do While UsbGetInterfaceDescriptor(handle, config_index, interface_index, alt, my_interface) '       if it works
       msg "---- Interface         : " & interface_index & "/" & alt
       msg "---- Alternate setting : " & my_interface.bAlternateSetting
       msg "---- NumEndpoints      : " & my_interface.bNumEndpoints
       msg "---- InterfaceClass    : " & my_interface.bInterfaceClass
       msg "---- InterfaceSubClass : " & my_interface.bInterfaceSubClass
       msg "---- InterfaceProtocol : " & my_interface.bInterfaceProtocol
       msg "---- Interface         : " & my_interface.iInterface
       For x = 0 To my_interface.bNumEndpoints - 1
           print_endpoint handle, config_index, interface_index, alt, x                         ' call print_endpoint
       Next x
       alt = alt + 1                                                                         ' try the next alternate
    Loop
    ' no more alternate info
End Sub
Sub print_endpoint(handle As Long, config_index, interface_index, alt_setting, index)
    ' grab the endpoint information
    If UsbGetEndpointDescriptor(handle, config_index, interface_index, alt_setting, index, my_endpoint) Then
       msg "----- Endpoint    : " & index
       msg "----- Address     : " & Hex$(my_endpoint.bEndpointAddress)
       msg "----- Attributes  : " & Hex$(my_endpoint.bmAttributes)
       msg "----- Packetsize  : " & Hex$(my_endpoint.wMaxPacketSize)
       msg "----- Interval    : " & Hex$(my_endpoint.bInterval)
       msg "----- Refresh     : " & Hex$(my_endpoint.bRefresh)
       msg "----- Syncaddress : " & Hex$(my_endpoint.bSynchAddress)
    End If
    ' and return to the prevous function
End Sub
' *********************************** support routines *****************************************************************
Sub msg(msg)       ' in order to avoid all the typing work this routine allows you to add text easily to the textbox
   textbox.Text = textbox.Text & msg & vbNewLine
End Sub
' this makes the form and textbox sizeable by the user
Private Sub Form_Resize()
    If Me.Height < 2500 Then Me.Height = 2500
    If Me.Width < textbox.Left Then Me.Width = textbox.Left + 100
    textbox.Width = Me.Width - (2 * textbox.Left)
    textbox.Height = Me.Height - (2 * textbox.Top)
End Sub