www.pudn.com > the PC Host examples .zip > CollectData.frm
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