Solved

Problem`s detecting USB devices

Posted on 2006-11-24
7
917 Views
Last Modified: 2008-01-09

   Hi I`ve a big problem I need how to detect and catch all the information from an USB device such as printers,plotters,projector but all this have to be by vb code.

But I haven`t found any api or dll or module that could help me with this. someone has the same problem o some solution or orientation for me, I have  spent two weeks searching anf trying code samples but noone fit or help me
0
Comment
Question by:pedro_arzac
7 Comments
 
LVL 10

Expert Comment

by:Clif
Comment Utility
What about using the SysInfo control and it's DeviceArrival Event?
0
 
LVL 41

Expert Comment

by:graye
Comment Utility
There really isn't a single API for all of the possible USB devices...   most devices (thinking about printers) merely use USB as a the "transport" and then use the printer APIs to discover the features of the printer.

Tell us more about what you're trying to do...  perhaps we can offer an alternative approach.
0
 
LVL 3

Accepted Solution

by:
Obadah_HighTech earned 250 total points
Comment Utility
Hello,

Here is a way to list all USB devices currently present with their properties, you need to add 2 TreeView controls (in the Microsoft Windows Common Controls) and then add this code to the Form code view(just copy and past):

Const REG_USB_KEYS_PATH = "SYSTEM\CurrentControlSet\Enum\USB"
Const HKEY_LOCAL_MACHINE = &H80000002
Const REG_SZ = 1
Const REG_EXPAND_SZ = 2
Const REG_BINARY = 3
Const REG_DWORD = 4
Const REG_MULTI_SZ = 7
Public objReg
Private Sub Form_Load()
Dim myNode As Node
Const HKEY_LOCAL_MACHINE = &H80000002
strComputer = "."
Set objReg = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" _
    & strComputer & "\root\default:StdRegProv")
objReg.EnumKey HKEY_LOCAL_MACHINE, REG_USB_KEYS_PATH, arrSubKeys
Set myNode = TreeView1.Nodes.Add(, , , "USB Devices")
myNode.Expanded = True
USBKeys2Tree myNode.index, REG_USB_KEYS_PATH
End Sub
Sub USBKeys2Tree(ByVal index As Integer, subPath As String)
    Dim myNode As Node
    objReg.EnumKey HKEY_LOCAL_MACHINE, subPath, arrSubKeys
    If TypeName(arrSubKeys) <> "Null" Then
        For Each subkey In arrSubKeys
            Set myNode = TreeView1.Nodes.Add(index, 4, , subkey)
            USBKeys2Tree myNode.index, subPath & "\" & subkey
        Next
    End If
End Sub
Private Sub TreeView1_NodeClick(ByVal Node As MSComctlLib.Node)
    Dim myNode As Node
    strKeyPath = Right$(TreeView1.SelectedItem.FullPath, Len(TreeView1.SelectedItem.FullPath) - Len(TreeView1.SelectedItem.Root))
    objReg.EnumValues HKEY_LOCAL_MACHINE, REG_USB_KEYS_PATH & strKeyPath, arrValueNames, arrValueTypes
    TreeView2.Nodes.Clear
    If TypeName(arrValueNames) <> "Null" Then
        For I = 0 To UBound(arrValueNames)
            Set myNode = TreeView2.Nodes.Add(, , , arrValueNames(I))
            myNode.Expanded = True
            Select Case arrValueTypes(I)
                Case REG_SZ
                    objReg.GetStringValue HKEY_LOCAL_MACHINE, REG_USB_KEYS_PATH & strKeyPath, arrValueNames(I), valueData
                    TreeView2.Nodes.Add myNode.index, 4, , valueData
                Case REG_EXPAND_SZ
                    objReg.GetExpandedStringValue HKEY_LOCAL_MACHINE, REG_USB_KEYS_PATH & strKeyPath, arrValueNames(I), valueData
                    TreeView2.Nodes.Add myNode.index, 4, , valueData
                Case REG_BINARY
                    objReg.GetBinaryValue HKEY_LOCAL_MACHINE, REG_USB_KEYS_PATH & strKeyPath, arrValueNames(I), valueData
                    TreeView2.Nodes.Add myNode.index, 4, , valueData
                Case REG_DWORD
                    objReg.GetDWORDValue HKEY_LOCAL_MACHINE, REG_USB_KEYS_PATH & strKeyPath, arrValueNames(I), valueData
                    TreeView2.Nodes.Add myNode.index, 4, , valueData
                Case REG_MULTI_SZ
                    objReg.GetMultiStringValue HKEY_LOCAL_MACHINE, REG_USB_KEYS_PATH & strKeyPath, arrValueNames(I), valueDatas
                    For Each x In valueDatas
                        valueData = valueData & ", " & x
                    Next
                    TreeView2.Nodes.Add myNode.index, 4, , valueData
            End Select
        Next
    End If
End Sub
0
 
LVL 27

Assisted Solution

by:Ark
Ark earned 250 total points
Comment Utility
If you prefer pure API way:

'==========bas module code=======
'Some classes GUIDs for testing - you can find other classes by digging the net
Public Const DEVICE_CLASS_DISK As String = "{4d36e967-e325-11ce-bfc1-08002be10318}"
Public Const DEVICE_CLASS_COMPACT_DISC As String = "{4d36e965-e325-11ce-bfc1-08002be10318}"
Public Const DEVICE_CLASS_TAPE As String = "{6d807884-7d21-11cf-801c-08002be10318}"
Public Const DEVICE_CLASS_USB_HUB As String = "{f18a0e88-c30c-11d0-8815-00a0c906bed8}"
Public Const DEVICE_CLASS_USB_DEVICE As String = "{A5DCBF10-6530-11D2-901F-00C04FB951ED}"
Public Const DEVICE_CLASS_USB_HOSTCONTROLLER As String = "{3ABF6F2D-71C4-462a-8A92-1E6861E6AF27}"
Public Const DEVICE_CLASS_USB_WMI_STD_DATA As String = "{4E623B20-CB14-11D1-B331-00A0C959BBD2}"
Public Const DEVICE_CLASS_USB_WMI_STD_NOTIFICATION As String = "{4E623B20-CB14-11D1-B331-00A0C959BBD2}"
Public Const DEVICE_CLASS_USB_INTERFACE As String = "{36FC9E60-C465-11CF-8056-444553540000}"

Public Declare Function SetupDiGetClassDevs Lib "setupapi.dll" _
  Alias "SetupDiGetClassDevsA" ( _
  ByRef ClassGuid As GUID, _
  ByVal Enumerator As String, _
  ByVal hwndParent As Long, _
  ByVal flags As DEVICEFLAGS) As Long

Public Declare Function SetupDiDestroyDeviceInfoList Lib "setupapi.dll" ( _
  ByVal DeviceInfoSet As Long) As Long

Public Declare Function SetupDiGetDeviceRegistryProperty Lib "setupapi.dll" _
  Alias "SetupDiGetDeviceRegistryPropertyA" ( _
  ByVal DeviceInfoSet As Long, _
  ByRef DeviceInfoData As SP_DEVINFO_DATA, _
  ByVal Property As DEVICEPROPERTYINDEX, _
  ByRef PropertyRegDataType As REGPROPERTYTYPES, _
  ByVal PropertyBuffer As String, _
  ByVal PropertyBufferSize As Long, _
  ByRef RequiredSize As Long) As Long

Public Declare Function SetupDiEnumDeviceInfo Lib "setupapi.dll" ( _
  ByVal DeviceInfoSet As Long, _
  ByVal MemberIndex As Long, _
  ByRef DeviceInfoData As SP_DEVINFO_DATA) As Long

Public Type GUID
  Data1 As Long
  Data2 As Integer
  Data3 As Integer
  Data4(0 To 7) As Byte
End Type

Public Enum DEVICEFLAGS
  DIGCF_ALLCLASSES = &H4&
  DIGCF_DEVICEINTERFACE = &H10
  DIGCF_PRESENT = &H2
  DIGCF_PROFILE = &H8
End Enum

Public Type SP_DEVINFO_DATA
  cbSize As Long
  ClassGuid As GUID
  DevInst As Long
  Reserved As Long
End Type

Public Enum DEVICEPROPERTYINDEX
  SPDRP_ADDRESS = (&H1C)
  SPDRP_BUSNUMBER = (&H15)
  SPDRP_BUSTYPEGUID = (&H13)
  SPDRP_CAPABILITIES = (&HF)
  SPDRP_CHARACTERISTICS = (&H1B)
  SPDRP_CLASS = (&H7)
  SPDRP_CLASSGUID = (&H8)
  SPDRP_COMPATIBLEIDS = (&H2)
  SPDRP_CONFIGFLAGS = (&HA)
  SPDRP_DEVICEDESC = &H0
  SPDRP_DEVTYPE = (&H19)
  SPDRP_DRIVER = (&H9)
  SPDRP_ENUMERATOR_NAME = (&H16)
  SPDRP_EXCLUSIVE = (&H1A)
  SPDRP_FRIENDLYNAME = (&HC)
  SPDRP_HARDWAREID = (&H1)
  SPDRP_LEGACYBUSTYPE = (&H14)
  SPDRP_LOCATION_INFORMATION = (&HD)
  SPDRP_LOWERFILTERS = (&H12)
  SPDRP_MFG = (&HB)
  SPDRP_PHYSICAL_DEVICE_OBJECT_NAME = (&HE)
  SPDRP_SECURITY = (&H17)
  SPDRP_SECURITY_SDS = (&H18)
  SPDRP_SERVICE = (&H4)
  SPDRP_UI_NUMBER = (&H10)
  SPDRP_UPPERFILTERS = (&H11)
End Enum

Public Enum REGPROPERTYTYPES
  REG_BINARY = 3
  REG_DWORD = 4
  REG_DWORD_BIG_ENDIAN = 5
  REG_DWORD_LITTLE_ENDIAN = 4
  REG_EXPAND_SZ = 2
  REG_MULTI_SZ = 7
  REG_SZ = 1
End Enum

Public Enum SetupErrors
  ERROR_INSUFFICIENT_BUFFER = 122
  ERROR_INVALID_DATA = 13&
  ERROR_NO_MORE_ITEMS = 259&
End Enum
Private Declare Function CLSIDFromString Lib "ole32" (ByVal lpsz As Long, pclsid As GUID) As Long

Public Function OpenDeviceInfoClass(ByVal sDeviceClassGuid As String, Optional ByVal bEnumInterfaces As Boolean) As Long
   Dim gd As GUID
   Dim f As DEVICEFLAGS
   f = DIGCF_PRESENT
   If bEnumInterfaces Then f = f Or DIGCF_DEVICEINTERFACE
   Call CLSIDFromString(StrPtr(sDeviceClassGuid), gd)
   OpenDeviceInfoClass = SetupDiGetClassDevs(gd, vbNullString, 0, f)
End Function

Public Sub CloseDeviceInfoClass(ByVal hDevInfo As Long)
   Call SetupDiDestroyDeviceInfoList(hDevInfo)
End Sub

Public Function GetDeviceInfo(ByVal hDevice As Variant, ByVal DeviceNum As Long, Optional ByVal infoType As DEVICEPROPERTYINDEX = SPDRP_FRIENDLYNAME) As String
   If IsNumeric(hDevice) Then
      GetDeviceInfo = GethDeviceInfo(hDevice, DeviceNum, infoType)
   Else
      If VarType(hDevice) = vbString Then
         hDevice = OpenDeviceInfoClass(hDevice)
         GetDeviceInfo = GethDeviceInfo(hDevice, DeviceNum, infoType)
         CloseDeviceInfoClass hDevice
      End If
   End If
End Function

Public Function GethDeviceInfo(ByVal hDevInfo As Long, ByVal idx As Long, Optional ByVal infoType As DEVICEPROPERTYINDEX = SPDRP_FRIENDLYNAME) As String
    Dim ret As Long
    Dim DID As SP_DEVINFO_DATA
    GethDeviceInfo = "Unavailable"
    DID.cbSize = Len(DID)
    ret = SetupDiEnumDeviceInfo(hDevInfo, idx, DID)
    If ret <> 0 Then GethDeviceInfo = GetSetupRegSetting(hDevInfo, DID, infoType)
End Function

Public Function GetSetupRegSetting(ByVal hDevInfo As Long, _
   DID As SP_DEVINFO_DATA, ByVal RegSetting As DEVICEPROPERTYINDEX) As String
 
   Dim BuffStr As String, s As String
   Dim BuffLng As Long
   Dim BufferLen As Long
   Dim RegType As REGPROPERTYTYPES
   Dim Retval As Long, SE As Long
   
   s = "Error getting registry value"
   Retval = SetupDiGetDeviceRegistryProperty(hDevInfo, DID, RegSetting, RegType, "", 0&, BufferLen)
   If Retval = 0 Then
      SE = Err.LastDllError
      If SE = ERROR_INSUFFICIENT_BUFFER Then
         Select Case RegType
                Case REG_SZ, REG_MULTI_SZ, REG_EXPAND_SZ, REG_BINARY
                     BuffStr = Space$(BufferLen)
                     Retval = SetupDiGetDeviceRegistryProperty(hDevInfo, DID, RegSetting, _
                     RegType, BuffStr, Len(BuffStr), BufferLen)
                Case REG_DWORD, REG_DWORD_BIG_ENDIAN, REG_DWORD_LITTLE_ENDIAN
                     Retval = SetupDiGetDeviceRegistryProperty(hDevInfo, DID, RegSetting, RegType, _
                     BuffLng, Len(BuffLng), BufferLen)
                     BuffStr = CStr(BuffLng)
                     BuffLng = BuffLng + 1
         End Select
         If Retval <> 0 Then s = Left$(BuffStr, BufferLen - 1)
      ElseIf SE = ERROR_INVALID_DATA Then
         s = "Property not found"
      End If
   End If
   If s = "" Then s = "Empty string"
   GetSetupRegSetting = s
End Function


'Form code
Private Sub Command1_Click()
   Dim hDevInfo As Long, i As Long, f As DEVICEPROPERTYINDEX
   Dim s As String
   hDevInfo = OpenDeviceInfoClass(DEVICE_CLASS_USB_DEVICE)
'   f = SPDRP_PHYSICAL_DEVICE_OBJECT_NAME
'   f = SPDRP_FRIENDLYNAME
   If hDevInfo <> -1 Then
      s = GethDeviceInfo(hDevInfo, i, f)
      Do While s <> "Unavailable"
         Debug.Print s
         i = i + 1
         s = GethDeviceInfo(hDevInfo, i, f)
      Loop
      CloseDeviceInfoClass hDevInfo
   End If
End Sub
0

Featured Post

IT, Stop Being Called Into Every Meeting

Highfive is so simple that setting up every meeting room takes just minutes and every employee will be able to start or join a call from any room with ease. Never be called into a meeting just to get it started again. This is how video conferencing should work!

Join & Write a Comment

When trying to find the cause of a problem in VBA or VB6 it's often valuable to know what procedures were executed prior to the error. You can use the Call Stack for that but it is often inadequate because it may show procedures you aren't intereste…
This article describes some techniques which will make your VBA or Visual Basic Classic code easier to understand and maintain, whether by you, your replacement, or another Experts-Exchange expert.
Get people started with the process of using Access VBA to control Outlook using automation, Microsoft Access can control other applications. An example is the ability to programmatically talk to Microsoft Outlook. Using automation, an Access applic…
Show developers how to use a criteria form to limit the data that appears on an Access report. It is a common requirement that users can specify the criteria for a report at runtime. The easiest way to accomplish this is using a criteria form that a…

772 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

9 Experts available now in Live!

Get 1:1 Help Now