#Region "API's"
Public Const CR_SUCCESS As Int32 = &H0
Public Const DIGCF_PRESENT As Int32 = &H2
Public Const DIGCF_ALLCLASSES As Int32 = &H4
Public Const SPDRP_DEVICEDESC As Int32 = &H0
Public Const SPDRP_FRIENDLYNAME As Int32 = &HC
Public Const SPDRP_CLASS As Int32 = &H7
Public Const SPDRP_CLASSGUID As Int32 = &H8
Public Const ERROR_INSUFFICIENT_BUFFER As Int32 = 122
Public Const ERROR_INVALID_DATA As Int32 = 13
Public Const DN_HAS_PROBLEM As Int32 = &H400
Public Const CM_PROB_DISABLED As Int32 = &H16
Public Const CM_PROB_HARDWARE_DISABLED As Int32 = &H1D
Public Const DN_DISABLEABLE As Int32 = &H2000
Public Const DICS_DISABLE As Int32 = &H2
Public Const DICS_ENABLE As Int32 = &H1
Public Const DIF_PROPERTYCHANGE As Int32 = &H12
Public Const DICS_FLAG_GLOBAL As Int32 = &H1
Public Const SPDRP_DEVTYPE As Int32 = &H19
Public Declare Auto Function SetupDiGetDeviceRegistryProperty Lib "setupapi.dll" (ByVal DeviceInfoSet As IntPtr, ByVal DeviceInfoData As IntPtr, ByVal [Property] As Int32, ByRef PropertyRegDataType As Int32, ByVal PropertyBuffer As String, ByVal PropertyBufferSize As Int32, ByRef RequiredSize As Int32) As Boolean
Public Declare Ansi Function SetupDiGetDeviceInstanceIdA Lib "setupapi.dll" (ByVal DeviceInfoSet As IntPtr, ByVal DeviceInfoData As IntPtr, ByRef DeviceInstanceId As Int32, ByVal DeviceInstanceIdSize As Int32, Optional ByRef RequiredSize As Int32 = 0) As Boolean
Public Declare Auto Function SetupDiGetClassDevs Lib "setupapi.dll" (ByVal CassGuid As IntPtr, ByVal Enumerator As IntPtr, ByVal hwndParent As Int32, ByVal Flags As Int32) As IntPtr
Public Declare Auto Function SetupDiEnumDeviceInfo Lib "setupapi.dll" (ByVal hDevInfo As IntPtr, ByVal index As Int32, ByVal DeviceInfoData As IntPtr) As Boolean
Public Declare Auto Function CM_Get_DevNode_Status Lib "setupapi.dll" (ByRef pulStatus As Int32, ByRef pulProblemNumber As Int32, ByVal dnDevInst As Int32, ByVal ulFlags As Int32) As Int32
Public Declare Auto Function GetLastError Lib "kernel32.dll" () As Int32
Public Declare Unicode Function SetupDiSetClassInstallParamsW Lib "setupapi.dll" (ByVal DeviceInfoSet As IntPtr, ByVal DeviceInfoData As IntPtr, ByVal ClassInstallParams As IntPtr, ByVal ClassInstallParamsSize As Int32) As Boolean
'Public Declare Unicode Function SetupDiSetClassInstallParamsW Lib "setupapi.dll" (ByVal DeviceInfoSet As IntPtr, ByVal DeviceInfoData As IntPtr, ByVal DeviceInstallParams As IntPtr, ByRef ClassInstallParams As Byte(), ByVal ClassInstallParamsSize As Int32) As Boolean
Public Declare Auto Function SetupDiCallClassInstaller Lib "setupapi.dll" (ByVal InstallFunction As Int32, ByVal DeviceInfoSet As IntPtr, ByVal DeviceInfoData As IntPtr) As Boolean
<Serializable(), StructLayout(LayoutKind.Sequential, Pack:=1)> _
Public Structure GUID
Dim Data1 As Int32
Dim Data2 As Int16
Dim Data3 As Int16
<MarshalAs(UnmanagedType.ByValArray, SizeConst:=8)> Dim Data4() As Byte
Public Sub init()
ReDim Data4(7)
End Sub
Public Function CompareTo(ByVal obj As GUID) As Boolean
If Data1 <> obj.Data1 Then Return False
If Data2 <> obj.Data2 Then Return False
If Data3 <> obj.Data3 Then Return False
Dim i As Int16
For i = 0 To 7
If Data4(i) <> obj.Data4(i) Then Return False
Next
Return True
End Function
End Structure
<Serializable(), StructLayout(LayoutKind.Sequential, Pack:=1)> _
Public Structure SP_DEVINFO_DATA
Dim cbSize As Int32
Dim ClassGuid As GUID
Dim DevInst As Int32 '// DEVINST handle
Dim Reserved As Int32
Public Sub init()
ClassGuid.init()
cbSize = 28
End Sub
End Structure
<StructLayout(LayoutKind.Sequential, Pack:=1)> _
Public Structure SP_CLASSINSTALL_HEADER
Dim cbSize As Int32
Dim InstallFunction As Int32
Public Sub init()
cbSize = 8
End Sub
End Structure
<StructLayout(LayoutKind.Sequential, Pack:=1)> _
Public Structure SP_PROPCHANGE_PARAMS
Dim ClassInstallHeader As SP_CLASSINSTALL_HEADER
Dim StateChange As Int32
Dim Scope As Int32
Dim HwProfile As Int32
Public Sub init()
ClassInstallHeader.init()
End Sub
End Structure
#End Region
данное сообщение получено с www.gotdotnet.ru
ссылка на оригинальное сообщение
вспомогательные классы
Public Class DeviceCollection
Inherits CollectionBase
Default Public Property Item(ByVal index As Integer) As Device
Get
Return CType(innerList(index), Device)
End Get
Set(ByVal Value As Device)
innerList(index) = Value
End Set
End Property
Public Function Add(ByVal Value As Device) As Integer
Return MyBase.InnerList.Add(Value)
End Function
End Class
<Serializable()> _
Public Class Device
Private _dev_data As SP_DEVINFO_DATA
Private _Name As String
Private _State As Config.eState
Public Property Dev_Data() As Object
Get
Return _dev_data
End Get
Set(ByVal Value As Object)
_dev_data = CType(Value, SP_DEVINFO_DATA)
End Set
End Property
Public Property Name() As String
Get
Return _Name
End Get
Set(ByVal Value As String)
_Name = Value
End Set
End Property
Public Property State() As Config.eState
Get
Return _State
End Get
Set(ByVal Value As Config.eState)
_State = Value
End Set
End Property
End Class
данное сообщение получено с www.gotdotnet.ru
ссылка на оригинальное сообщение
Private UnknownDevice As String = "<Unknown Device>"
Private hDevInfo As IntPtr
Public DeviceList As New DeviceCollection()
'получение списка всех устройств
Public Function RefreshDevices() As Boolean
Dim i, Status, Problem As Integer
Dim DeviceInfoData As IntPtr
Dim dev_data As SP_DEVINFO_DATA
dev_data.init()
hDevInfo = SetupDiGetClassDevs(IntPtr.Zero, IntPtr.Zero, 0, DIGCF_PRESENT Or DIGCF_ALLCLASSES)
If hDevInfo.ToInt32 < 0 Then
MsgBox("Hе удаётся получить информацию об устройствах")
Return False
End If
'// Clean off all the items in a TreeView.
DeviceList.Clear()
'// Enumerate though all the devices.
DeviceInfoData = Marshal.AllocHGlobal(Marshal.SizeOf(dev_data))
Marshal.StructureToPtr(dev_data, DeviceInfoData, True)
i = 0
While SetupDiEnumDeviceInfo(hDevInfo, i, DeviceInfoData)
dev_data = Marshal.PtrToStructure(DeviceInfoData, GetType(SP_DEVINFO_DATA))
' // Should we display this device, or move onto the next one.
If CR_SUCCESS <> CM_Get_DevNode_Status(Status, Problem, dev_data.DevInst, 0) Then
'MsgBox("Get_DevNode_Status")
GoTo EndWhile
End If
Dim buf As String = UnknownDevice
ConstructDeviceName(hDevInfo, DeviceInfoData, buf, buf.Length)
Dim idx As Integer = DeviceList.Add(New Device())
DeviceList(idx).Dev_Data = dev_data
DeviceList(idx).Name = buf
DeviceList(idx).State = Config.eState.Uncknown
If IsDisabled(dev_data) Then
DeviceList(idx).State = Config.eState.Off
ElseIf IsDisableable(dev_data) Then
DeviceList(idx).State = Config.eState.On
End If
EndWhile:
i += 1
End While
Marshal.FreeHGlobal(DeviceInfoData)
Return True
End Function
Private Function ConstructDeviceName(ByVal DeviceInfoSet As IntPtr, ByVal DeviceInfoData As IntPtr, ByRef Buffer As String, ByVal Length As Int32) As Boolean
'If Not GetRegistryProperty(DeviceInfoSet, DeviceInfoData, SPDRP_FRIENDLYNAME, Buffer, Length) Then
If Not GetRegistryProperty(DeviceInfoSet, DeviceInfoData, SPDRP_DEVICEDESC, Buffer, Length) Then
If Not GetRegistryProperty(DeviceInfoSet, DeviceInfoData, SPDRP_CLASS, Buffer, Length) Then
If Not GetRegistryProperty(DeviceInfoSet, DeviceInfoData, SPDRP_CLASSGUID, Buffer, Length) Then
End If
End If
End If
'End If
Return True
End Function
Private Function GetRegistryProperty(ByVal DeviceInfoSet As IntPtr, ByVal DeviceInfoData As IntPtr, ByVal Prop As Int32, ByRef Buffer As String, ByVal Length As Int32) As Boolean
Dim RecLen As Int32
While Not SetupDiGetDeviceRegistryProperty(DeviceInfoSet, DeviceInfoData, Prop, vbNull, Buffer, Buffer.Length, RecLen)
If (GetLastError() = ERROR_INSUFFICIENT_BUFFER) Then
'// We need to change the buffer size.
Buffer &= Space(RecLen — Buffer.Length)
Else
'// Unknown Failure.
If (GetLastError() <> ERROR_INVALID_DATA) Then
'MsgBox("GetDeviceRegistryProperty")
Return False
End If
End If
End While
Return RecLen
End Function
Private Function IsDisabled(ByVal dev_data As SP_DEVINFO_DATA) As Boolean
Dim Status, Problem As Integer
If CR_SUCCESS <> CM_Get_DevNode_Status(Status, Problem, dev_data.DevInst, 0) Then
MsgBox("Get_DevNode_Status")
Return False
End If
Return (Status And DN_HAS_PROBLEM) And (CM_PROB_DISABLED = Problem)
End Function
Private Function IsDisableable(ByVal dev_data As SP_DEVINFO_DATA) As Boolean
Dim Status, Problem As Integer
If CR_SUCCESS <> CM_Get_DevNode_Status(Status, Problem, dev_data.DevInst, 0) Then
MsgBox("Get_DevNode_Status")
Return False
End If
Return (Status And DN_DISABLEABLE) And (CM_PROB_HARDWARE_DISABLED <> Problem)
End Function
'включение
Public Function setOn(ByVal cGuid As GUID) As Boolean
Dim idx As Integer = FindIndex(cGuid)
If idx < 0 Then Return False
Return StateChange(DICS_ENABLE, CType(DeviceList(idx).Dev_Data, SP_DEVINFO_DATA))
End Function
'выключение
Public Function setOff(ByVal cGuid As GUID) As Boolean
Dim idx As Integer = FindIndex(cGuid)
If idx < 0 Then Return False
Return StateChange(DICS_DISABLE, CType(DeviceList(idx).Dev_Data, SP_DEVINFO_DATA))
End Function
Private Function StateChange(ByVal NewState As Int32, ByVal dev_data As SP_DEVINFO_DATA) As Boolean
Dim PropChangeParams As SP_PROPCHANGE_PARAMS
PropChangeParams.init()
'// Set the PropChangeParams structure.
PropChangeParams.ClassInstallHeader.InstallFunction = DIF_PROPERTYCHANGE
PropChangeParams.Scope = DICS_FLAG_GLOBAL
PropChangeParams.StateChange = NewState
Dim DeviceInfoData As IntPtr = Marshal.AllocHGlobal(Marshal.SizeOf(dev_data))
Marshal.StructureToPtr(dev_data, DeviceInfoData, True)
Dim PropParams As IntPtr = Marshal.AllocHGlobal(Marshal.SizeOf(PropChangeParams))
Marshal.StructureToPtr(PropChangeParams, PropParams, True)
If Not SetupDiSetClassInstallParamsW(hDevInfo, DeviceInfoData, PropParams, Marshal.SizeOf(PropChangeParams)) Then
MsgBox("SetClassInstallParams")
Return False
End If
'// Call the ClassInstaller and perform the change.
If Not SetupDiCallClassInstaller(DIF_PROPERTYCHANGE, hDevInfo, DeviceInfoData) Then
MsgBox("SetClassInstallParams")
Return False
End If
Marshal.FreeHGlobal(DeviceInfoData)
Marshal.FreeHGlobal(PropParams)
RefreshDevices()
Return True
End Function
Public Function Verify(ByVal dev As GUID) As Boolean
Dim i As Integer
For i = 0 To DeviceList.Count — 1
If _config.Name = DeviceList(i).Name Then
If CType(DeviceList(i).Dev_Data, SP_DEVINFO_DATA).ClassGuid.CompareTo(dev) Then Return True
End If
Next
Return False
End Function
Public Function FindIndex(ByVal Dev As GUID) As Integer
Dim i As Integer
For i = 0 To DeviceList.Count — 1
If CType(DeviceList(i).Dev_Data, SP_DEVINFO_DATA).ClassGuid.CompareTo(Dev) Then
Return i
End If
Next
Return -1
End Function
Public Function FreeHandle()
Marshal.FreeHGlobal(hDevInfo)
DeviceList.Clear()
DeviceList = Nothing
End Function
End Module
данное сообщение получено с www.gotdotnet.ru
ссылка на оригинальное сообщение
Не могли бы вы мне помочь?? Либо перевести код в вб либо послать проэкт на мыло. Заранее благодарен!
