?
Solved

Device Manager in VB

Posted on 2007-07-30
6
Medium Priority
?
4,820 Views
Last Modified: 2008-05-28
I want to make Device Manager in VB. I found the similar code in VC++ in the following site
http://www.codeproject.com/system/DevMgr.asp

But I want to develop the same thing in VB
0
Comment
Question by:retinax
  • 2
4 Comments
 
LVL 41

Expert Comment

by:graye
ID: 19593718
You can get a lot of that functionality by using Windows Management Instrumentation (WMI).

I've got quite a few examples in VB.Net (but I assume you're asking for VB6?)
0
 
LVL 28

Accepted Solution

by:
Ark earned 2000 total points
ID: 19632970
Here is a way to start:
'======bas module code=======
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_INTERFACE_DISK As String = "{53f56307-b6bf-11d0-94f2-00a0c91efb8b}"
Public Const DEVICE_INTERFACE_COMPACT_DISC As String = "{53f56308-b6bf-11d0-94f2-00a0c91efb8b}"
Public Const DEVICE_INTERFACE_TAPE As String = "{53f5630b-b6bf-11d0-94f2-00a0c91efb8b}"

Public Const DIGCF_DEFAULT As Integer = &H1
Public Const DIGCF_DEVICEINTERFACE As Integer = &H10
Public Const DIGCF_PRESENT As Integer = &H2
Public Const DIGCF_ALLCLASSES As Integer = &H4
Public Const DIGCF_PROFILE As Integer = &H8

Private Type Guid
    Data1 As Long
    Data2 As Integer
    Data3 As Integer
    Data4(0 To 7) As Byte
End Type

Private Type SP_DEVICE_INTERFACE_DATA
    cbSize As Long
    InterfaceGuid As Guid
    Flag As Long
    Reserved As Long
End Type

Private Type SP_DEVINFO_DATA
    cbSize As Long
    ClassGuid As Guid
    DevInstance As Long
    Reserved As Long
End Type

Private Type SP_DEVICE_INTERFACE_DETAIL_DATA
    cbSize As Long
    DevicePath As String
End Type

Private Type SP_DEVINFO_LIST_DETAIL_DATA
    cbSize As Long
    Id As Guid
    Handle As Long
    DevName As String
End Type

Private Declare Function SetupDiCreateDeviceInfoList Lib "setupapi.dll" _
        (ByRef Class As Any, ByVal Handle As Long) As Long

Private Declare Function SetupDiCreateDeviceInfoListEx Lib "setupapi.dll" _
        Alias "SetupDiCreateDeviceInfoListExW" _
        (ByRef Class As Any, ByVal Handle As Long, ByVal Machine As String, _
        ByVal Reserved As Long) As Long

Private Declare Function SetupDiDestroyDeviceInfoList Lib "setupapi.dll" _
        (ByVal List As Long) As Boolean

Private Declare Function SetupDiGetClassDevs Lib "setupapi.dll" _
        Alias "SetupDiGetClassDevsW" _
        (ByRef Class As Any, ByVal Enumerator As String, _
        ByVal Parent As Long, ByVal Flag As Long) As Long

Private Declare Function SetupDiGetClassDevsEx Lib "setupapi.dll" _
        Alias "SetupDiGetClassDevsExW" _
        (ByRef Class As Any, ByVal Enumerator As String, _
        ByVal Parent As Long, ByVal Code As Long, _
        ByVal List As Long, ByVal Machine As String, ByVal Reserved As Long) As Long

Private Declare Function SetupDiEnumDeviceInfo Lib "setupapi.dll" _
        (ByVal List As Long, ByVal Index As Long, _
        ByRef Device As SP_DEVINFO_DATA) As Boolean

Private Declare Function SetupDiEnumDeviceInterfaces Lib "setupapi.dll" _
        (ByVal List As Long, _
        ByRef Device As SP_DEVICE_INTERFACE_DATA, ByRef Class As Guid, _
        ByVal Index As Long, _
        ByRef Interface As SP_DEVICE_INTERFACE_DATA) As Boolean

Private Declare Function SetupDiGetDeviceInterfaceDetail Lib "setupapi.dll" _
        Alias "SetupDiGetDeviceInterfaceDetailW" _
        (ByVal List As Long, _
        ByRef Interface As SP_DEVICE_INTERFACE_DATA, _
        ByRef Detail As Long, _
        ByVal Size As Long, _
        ByRef Length As Long, _
        ByRef Device As SP_DEVICE_INTERFACE_DATA) As Boolean

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

Private Declare Function QueryDosDevice Lib "KERNEL32.DLL" _
        Alias "QueryDosDeviceW" _
        (ByVal Device As String, ByVal Path As String, ByVal Length As Long) As Long
   
Private Type DeviceStructure
    Result As Long
    List As Long
    Class As Guid
    Flag As Long
    Machine As String
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 String, pclsid As Guid) As Long
Private Declare Function IsEqualGUID Lib "ole32" (rguid1 As Guid, rguid2 As Guid) As Boolean
Private Const INVALID_HANDLE_VALUE = -1
Private Const INTERFACE_DETAIL_SIZE = 1024

Public Function EnumAllDevices(tv As TreeView)
   Dim hDevInfo As Long
   Dim gd As Guid
   Dim devinfo As SP_DEVINFO_DATA
   Dim nCount As Long, n As Long
   Dim bResult As Boolean
   Dim sClass As String, sGUID, sDevice As String
   
   hDevInfo = SetupDiGetClassDevs(ByVal 0&, vbNullString, 0, DIGCF_PRESENT Or DIGCF_PROFILE Or DIGCF_ALLCLASSES)
   tv.Nodes.Add , , "Root", Environ$("COMPUTERNAME")
   If hDevInfo = INVALID_HANDLE_VALUE Then Exit Function
   nCount = 0: bResult = True
   devinfo.cbSize = Len(devinfo)

   Do While bResult
      n = SetupDiEnumDeviceInfo(hDevInfo, nCount, devinfo)
      bResult = CBool(n)
      If bResult Then
         sGUID = GetSetupRegSetting(hDevInfo, devinfo, SPDRP_CLASSGUID)
         If Not NodeExists(tv, sGUID) Then
            sClass = GetSetupRegSetting(hDevInfo, devinfo, SPDRP_CLASS)
            tv.Nodes.Add tv.Nodes("Root"), tvwChild, sGUID, sClass
         Else
            sDevice = GetSetupRegSetting(hDevInfo, devinfo, SPDRP_FRIENDLYNAME)
            If sDevice = "" Then sDevice = GetSetupRegSetting(hDevInfo, devinfo, SPDRP_DEVICEDESC)
            tv.Nodes.Add tv.Nodes(sGUID), tvwChild, "", sDevice
         End If
      End If
      nCount = nCount + 1
   Loop
   Call SetupDiDestroyDeviceInfoList(hDevInfo)
   tv.Nodes("Root").Expanded = True
   EnumAllDevices = nCount
End Function

Public Function GetSetupRegSetting(ByVal hDevInfo As Long, _
  DID As SP_DEVINFO_DATA, ByVal RegSetting As DEVICEPROPERTYINDEX) As String
 
  Dim BuffStr As String
  Dim BuffLng As Long
  Dim BufferLen As Long
  Dim RegType As REGPROPERTYTYPES
  Dim SE As SetupErrors
  Dim Retval As Long
     
   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
         GetSetupRegSetting = Left$(BuffStr, BufferLen - 1)
       Else
         MsgBox "Error while dermitting Regestryproperty"
       End If
               
    ElseIf SE <> ERROR_INVALID_DATA Then
      MsgBox "Error, can't get Regestryproperty"
    End If
  End If
End Function

Private Function NodeExists(tv As TreeView, ByVal sKey As String) As Boolean
   Dim nd As Node
   On Error Resume Next
   Set nd = tv.Nodes(sKey)
   NodeExists = (Err = 0)
   Set nd = Nothing
End Function

'=======form code=====
'Add treeview on form
Private Sub Form_Load()
   Call EnumAllDevices(TreeView1)
End Sub
0
 
LVL 28

Expert Comment

by:Ark
ID: 19632997
Oops, sorry, EnumAllDevice function should be


Public Function EnumAllDevices(tv As TreeView)
   Dim hDevInfo As Long
   Dim gd As Guid
   Dim devinfo As SP_DEVINFO_DATA
   Dim ifData As SP_DEVICE_INTERFACE_DATA
   Dim ifDetails As SP_DEVICE_INTERFACE_DETAIL_DATA
   Dim nCount As Long, n As Long
   Dim bResult As Boolean
   Dim sClass As String, sGUID, sDevice As String
   
   hDevInfo = SetupDiGetClassDevs(ByVal 0&, vbNullString, 0, DIGCF_PRESENT Or DIGCF_PROFILE Or DIGCF_ALLCLASSES)
   tv.Nodes.Add , , "Root", Environ$("COMPUTERNAME")
   If hDevInfo = INVALID_HANDLE_VALUE Then Exit Function
   nCount = 0: bResult = True
   devinfo.cbSize = Len(devinfo)

   Do While bResult
      n = SetupDiEnumDeviceInfo(hDevInfo, nCount, devinfo)
      bResult = CBool(n)
      If bResult Then
         sGUID = GetSetupRegSetting(hDevInfo, devinfo, SPDRP_CLASSGUID)
         If Not NodeExists(tv, sGUID) Then
            sClass = GetSetupRegSetting(hDevInfo, devinfo, SPDRP_CLASS)
            tv.Nodes.Add tv.Nodes("Root"), tvwChild, sGUID, sClass
         End If
         sDevice = GetSetupRegSetting(hDevInfo, devinfo, SPDRP_FRIENDLYNAME)
         If sDevice = "" Then sDevice = GetSetupRegSetting(hDevInfo, devinfo, SPDRP_DEVICEDESC)
         tv.Nodes.Add tv.Nodes(sGUID), tvwChild, "", sDevice
      End If
      nCount = nCount + 1
   Loop
   Call SetupDiDestroyDeviceInfoList(hDevInfo)
   tv.Nodes("Root").Expanded = True
   EnumAllDevices = nCount
End Function
0
 
LVL 1

Expert Comment

by:Computer101
ID: 20343789
Forced accept.

Computer101
EE Admin
0

Featured Post

Free Tool: Port Scanner

Check which ports are open to the outside world. Helps make sure that your firewall rules are working as intended.

One of a set of tools we are providing to everyone as a way of saying thank you for being a part of the community.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

I was working on a PowerPoint add-in the other day and a client asked me "can you implement a feature which processes a chart when it's pasted into a slide from another deck?". It got me wondering how to hook into built-in ribbon events in Office.
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…
This lesson covers basic error handling code in Microsoft Excel using VBA. This is the first lesson in a 3-part series that uses code to loop through an Excel spreadsheet in VBA and then fix errors, taking advantage of error handling code. This l…
Suggested Courses

864 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