collectdata.frm

PC端的USB主机源代码

VERSION 5.00
Begin VB.Form Collect_Data 
   BackColor       =   &H00FF8080&
   Caption         =   "USB Design By Example:  Display USB Devices"
   ClientHeight    =   6495
   ClientLeft      =   3000
   ClientTop       =   2145
   ClientWidth     =   6285
   FillStyle       =   0  'Solid
   ForeColor       =   &H8000000E&
   LinkTopic       =   "Form1"
   NegotiateMenus  =   0   'False
   OLEDropMode     =   1  'Manual
   ScaleHeight     =   6495
   ScaleWidth      =   6285
   ShowInTaskbar   =   0   'False
   Begin VB.ListBox Device_Display 
      BeginProperty Font 
         Name            =   "Courier New"
         Size            =   8.25
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   4890
      ItemData        =   "CollectData.frx":0000
      Left            =   240
      List            =   "CollectData.frx":0007
      TabIndex        =   5
      Top             =   1320
      Width           =   5775
   End
   Begin VB.TextBox StatusBox 
      BackColor       =   &H00FFFFC0&
      ForeColor       =   &H00800000&
      Height          =   285
      Left            =   240
      TabIndex        =   4
      Text            =   "Status Line"
      Top             =   960
      Width           =   5775
   End
   Begin VB.CommandButton HCD 
      BackColor       =   &H0000FF00&
      Caption         =   "Host Controller 3"
      BeginProperty Font 
         Name            =   "Arial Rounded MT Bold"
         Size            =   12
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   375
      Index           =   3
      Left            =   3120
      Style           =   1  'Graphical
      TabIndex        =   3
      Top             =   480
      Width           =   2655
   End
   Begin VB.CommandButton HCD 
      BackColor       =   &H0000FF00&
      Caption         =   "Host Controller 2"
      BeginProperty Font 
         Name            =   "Arial Rounded MT Bold"
         Size            =   12
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   375
      Index           =   2
      Left            =   3120
      Style           =   1  'Graphical
      TabIndex        =   2
      Top             =   120
      Width           =   2655
   End
   Begin VB.CommandButton HCD 
      BackColor       =   &H0000FF00&
      Caption         =   "Host Controller 1"
      BeginProperty Font 
         Name            =   "Arial Rounded MT Bold"
         Size            =   12
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   375
      Index           =   1
      Left            =   480
      Style           =   1  'Graphical
      TabIndex        =   1
      Top             =   480
      Width           =   2655
   End
   Begin VB.CommandButton HCD 
      BackColor       =   &H0000FF00&
      Caption         =   "Host Controller 0"
      BeginProperty Font 
         Name            =   "Arial Rounded MT Bold"
         Size            =   12
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   375
      Index           =   0
      Left            =   480
      MaskColor       =   &H0080FF80&
      Style           =   1  'Graphical
      TabIndex        =   0
      Top             =   120
      Width           =   2655
   End
End
Attribute VB_Name = "Collect_Data"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Sub Form_Load()
'   This subroutine runs as soon as the program starts  (ie as soon as this FORM is loaded)
'   Initialize my global variables
ConnectionStatus(0) = "No device"
ConnectionStatus(1) = "Device connected"
ConnectionStatus(2) = "Device FAILED enumeration"
ConnectionStatus(3) = "Device general FAILURE"
ConnectionStatus(4) = "Device caused overcurrent"
ConnectionStatus(5) = "Not enough power for device"

'   Initialize the display
For i& = 0 To 3: HCD(i&).BackColor = RGB(256, 0, 0): Next i& 'Red = start
StatusBox.Text = "Searching for Host Controllers"
Collect_Data.Height = 1725

'   Descriptors will be displayed in a different window, load it
Load Display_Descriptors

'   Look for Host Controllers.
'   I limit the search to 3. There may be more but this is unlikely.
'   The Host Controller Buttons are HCD(0) to HCD(3)
'   Try opening the controller using it's Symbollic Name
'
For ControllerIndex& = 0 To 3
    HostControllerName$ = "\\.\HCD" & ControllerIndex&
    HostControllerHandle& = CreateFile(HostControllerName$, &H40000000, 2, 0, 3, 0, 0)
    If HostControllerHandle& > 0 Then
        HCD(ControllerIndex&).Tag = HostControllerHandle&
        HCD(ControllerIndex&).BackColor = RGB(0, 256, 0) 'Green = GO
        HCD(ControllerIndex&).Enabled = True
        Else
        HCD(ControllerIndex&).BackColor = RGB(256, 128, 0) 'Amber = wait
        HCD(ControllerIndex&).Enabled = False
        End If
    Next ControllerIndex&
StatusBox.Text = "Select a Host Controller"
End Sub

Private Sub HCD_Click(Index%)
'   Can only click HCD buttons with a Host Controller behind them
'   Host controller handle is stored in the button's TAG field
'
'   Get the name of the host controller
HostController$ = GetNameOf("Host Controller", HCD(Index).Tag, &H220424)
StatusBox.Text = "Host Controller: " & HostController$ & " selected"
Device_Display.Clear
Collect_Data.Height = 6900
'
'   Get the name of the Root Hub and open a connection to it
RootHubName$ = GetNameOf("Root Hub", HCD(Index).Tag, &H220408)
RootHubHandle& = OpenConnection(RootHubName$)
'
'   Get the node connection information.
' **This is commented out, it should work but doesn't.  Assume Root Hub has a Device ID of 1
'Status& = DeviceIoControl(RootHubHandle&, &H22040C, RootHubNodeConnection.ConnectionIndex, 256, RootHubNodeConnection.ConnectionIndex, 256, BytesReturned&, 0)
'If Status& = 0 Then ErrorExit ("Could not get connection information from Root Hub")
'
Call GetNodeInformation(RootHubHandle&)
'
'   Save this information in our data table
DeviceData(0).DeviceHandle = RootHubHandle&
DeviceData(0).DeviceType = 1  'Root Hub
Device_Display.AddItem "001      : Root Hub"
'
'   Discover what is connected to the ports of this Root Hub
Level& = 0
Level& = GetPortData(RootHubHandle&, DeviceData(0).NodeData.NodeDescriptor.PortCount, Level& + 1)

StatusBox.Text = "Select a device, then choose a descriptor to display"
End Sub

Function GetPortData(Handle&, PortCount As Byte, HubDepth&) As Long
Dim ThisDevice As Byte

For PortIndex& = 1 To PortCount
    Call GetNodeConnectionData(Handle&, PortIndex&)
    
    ThisDevice = 0 ' default value, no device connected
    PortStatus& = DeviceData(DataIndex).ConnectionData.ThisConnectionStatus(0) ' save some typing!
    If PortStatus& = 1 Then
        ThisDevice = DeviceData(DataIndex).ConnectionData.DeviceAddress(0)
        DeviceData(DataIndex).DeviceHandle = Handle&
        End If
    ' Create an indented display so that Hubs and their connections are easily seen
    Indent$ = " ": For i& = 1 To HubDepth: Indent$ = Indent$ & ".": Next i&
    DeviceName$ = ThreeDecimalCharacters$(ThisDevice) & Indent$ & "       Port["
    Mid$(DeviceName$, 10) = ":"
    
    If PortStatus& <> 1 Then ' There is not a valid device on this port, tell user
        Device_Display.AddItem DeviceName$ & PortIndex & "] = " & ConnectionStatus$(PortStatus&)
        Else ' have a Device or a Hub connected to this port
        
        If DeviceData(DataIndex).ConnectionData.DeviceIsHub Then
'
'   Need to discover how many ports are supported on this hub.
'   Follow the same proceedure as we did for the root hub = get it's name, "open" it and get the node information
            ExternalHubName$ = GetExternalHubName(PortIndex&, Handle&)
            ExternalHubHandle& = OpenConnection(ExternalHubName$)
            Call GetNodeInformation(ExternalHubHandle&)
            DeviceData(DataIndex).DeviceType = 2 'Hub
'   LAST thing we do is update the display status of this device connection
            Device_Display.AddItem DeviceName$ & PortIndex & "] = Hub Connected"
'
'   Discover what, if anything, is connected to the ports of this Root Hub
            Level& = GetPortData(ExternalHubHandle&, DeviceData(DataIndex - 1).NodeData.NodeDescriptor.PortCount, HubDepth& + 1)

        Else 'we have a device connected to this port
            DeviceData(DataIndex).DeviceType = 3 'IODevice
            Device_Display.AddItem DeviceName$ & PortIndex & "] = IO Device Connected"
            End If 'USBDeviceInfo.DeviceIsHub
        End If 'PortStatus& <> 1
    Next PortIndex&
End Function

Private Sub Device_Display_Click()
' User has selected a device
Selected& = Device_Display.ListIndex
Entry$ = Device_Display.List(Selected)
DeviceID& = Val(Left$(Entry$, 3))
If DeviceID& = 0 Then
    StatusBox.Text = "There is no device connected to this node, please choose another"
Else
    StatusBox.Text = "Fetching descriptors"
    Call CollectDescriptors(Selected&)
    Call Display_Descriptors.Initialize
    End If
End Sub
Private Sub CollectDescriptors(Selected&)
' Collect all of the descriptors from the selected device and store them in the DescriptorData byte array
' Start with the Device Descriptor
For i& = 1 To 18: DescriptorData(i&) = DeviceData(Selected&).ConnectionData.ThisDevice.Contents(i& - 1): Next i&
Nexti& = 18
' Now get local copies of some key variables
Dim Configuration As Byte: Dim StringIndex As Byte
Handle& = DeviceData(Selected&).DeviceHandle
ConnectionIndex& = DeviceData(Selected&).ConnectionData.ConnectionIndex
ConfigurationCount = DeviceData(Selected).ConnectionData.ThisDevice.Contents(17)
For Configuration = 1 To ConfigurationCount
    TotalLength& = GetConfigurationDescriptor(Handle&, ConnectionIndex&, Configuration - 1)
' Copy the Configuration Descriptor into the common data buffer
    For i& = 1 To TotalLength&: DescriptorData(Nexti& + i&) = PCHostRequest.ConfigurationDescriptor(i& - 1): Next i&
    Nexti& = Nexti& + TotalLength&: Next Configuration
' Check for Strings
StringIndex = 0
Do While TotalLength& <> 0
    TotalLength = GetStringDescriptor(Handle&, ConnectionIndex&, StringIndex)
    StringIndex = StringIndex + 1
    For i& = 1 To TotalLength&: DescriptorData(Nexti& + i&) = PCHostRequest.ConfigurationDescriptor(i& - 1): Next i&
    Nexti& = Nexti& + TotalLength&: Loop
End Sub
Private Function GetStringDescriptor&(Handle&, ConnectionIndex&, StringIndex As Byte)
PCHostRequest.ConnectionIndex = ConnectionIndex
PCHostRequest.PacketData.wValueLo = StringIndex: PCHostRequest.PacketData.wValueHi = 3 ' = type
If StringIndex = 0 Then
    PCHostRequest.PacketData.wIndex = 0
    Else: PCHostRequest.PacketData.wIndex = &H409: End If ' This SHOULD be read from String 0
PCHostRequest.PacketData.wLength = 254 ' = Max string length
Status& = DeviceIoControl(Handle&, &H220410, PCHostRequest.ConnectionIndex, 286, PCHostRequest.ConnectionIndex, 286, BytesReturned&, 0)
If Status = 0 Then BytesReturned = 12 ' No string, so return TotalLength = 0
GetStringDescriptor& = BytesReturned& - 12
End Function
Private Function GetConfigurationDescriptor&(Handle&, ConnectionIndex&, ConfigurationID As Byte)
PCHostRequest.ConnectionIndex = ConnectionIndex
PCHostRequest.PacketData.wValueLo = ConfigurationID: PCHostRequest.PacketData.wValueHi = 2 ' = type
PCHostRequest.PacketData.wIndex = 0: PCHostRequest.PacketData.wLength = 9
' First read just the Configuration Descriptor to discover 'Total Length'
' Note 21 = 13(Size of PCHostRequest) + 8(Size of PacketData)
Status& = DeviceIoControl(Handle&, &H220410, PCHostRequest.ConnectionIndex, 21, PCHostRequest.ConnectionIndex, 21, BytesReturned&, 0)
If Status = 0 Then ErrorExit ("Could not get initial Configuration Data")
' Now read Configuration+Interface+Endpoint+Class
TotalLength = 256 * PCHostRequest.ConfigurationDescriptor(3) + PCHostRequest.ConfigurationDescriptor(2)
PCHostRequest.ConnectionIndex = ConnectionIndex
PCHostRequest.PacketData.wValueLo = ConfigurationID: PCHostRequest.PacketData.wValueHi = 2 ' = type
PCHostRequest.PacketData.wIndex = 0: PCHostRequest.PacketData.wLength = TotalLength
Status& = DeviceIoControl(Handle&, &H220410, PCHostRequest.ConnectionIndex, TotalLength + 13, PCHostRequest.ConnectionIndex, TotalLength + 13, BytesReturned&, 0)
If Status = 0 Then ErrorExit ("Could not get complete Configuration Data")
If BytesReturned& > 2000 Then ErrorExit ("Buffer Overflow for Configuration Descriptor")
GetConfigurationDescriptor& = BytesReturned& - 12
End Function