OK
Here it is
Declaration
I've only worked on the first three API Calls so far, so there may be probems in some of the other
Public Structure Device_Interface_Dat
Dim cbsize As Int3
Dim InterfaceClassGuid As Gui
Dim Flags As Int3
Dim ReservedPtr As Lon
End Structur
Public Structure Device_Interface_Detai
Public cbsize As Intege
'<VBFixedArray(256)
Public DataPath() As Byt
'UPGRADE_TODO: "Initialize" must be called to initialize instances of this structure. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1026"
Public Sub Initialize(
ReDim DataPath(256
End Su
End Structur
Public Structure Security_Attribute
Public nLength As Intege
Public lpSecurityDescriptor As Intege
Public bInheritHandle As Intege
End Structur
Public Structure HidD_Attribute
Public Size As Lon
Public VendorID As Shor
Public ProductID As Shor
Public VersionNumber As Shor
End Structur
Public Structure SP_DEVINFO_DAT
Public cbsize As Intege
Public ClassGuid As Gui
Public DevInst As Intege
Public Reserved As Lon
End Structur
Public Class Win3
Declare Sub HidD_GetHidGuid Lib "HID.dll" (ByRef GuidPtr As Guid
Declare Auto Function SetupDiGetClassDevs Lib "setupapi.dll" Alias "SetupDiGetClassDevsA"
(ByRef GuidPtr, ByRef EnumPtr, ByRef HwndParent, ByVal Flags) As Lon
Declare Auto Function SetupDiEnumDeviceInterfaces Lib "setupapi.dll" (ByVal Handle As Long, ByVal InfoPtr As Long, ByRef GuidPtr As Guid, ByVal MemberIndex As Integer, ByRef InterfaceDataPtr As SP_DEVINFO_DATA) As Intege
Declare Auto Function SetupDiGetDeviceInterfaceDetail Lib "setupapi.dll" Alias "SetupDiGetDeviceInterfaceDetailA"
(ByVal Handle, ByRef InterfaceDataPtr, ByRef InterfaceDetailPtr, ByVal DetailLength,
ByRef ReturnedLengthPtr, ByRef DevInfoDataPtr) As Boolea
'UPGRADE_WARNING: Structure Security_Attributes may require marshalling attributes to be passed as an argument in this Declare statement. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1050"
Declare Function CreateFile Lib "kernel32" Alias "CreateFileA" (ByVal lpFileName As String, ByVal dwDesiredAccess As Integer,
ByVal dwShareMode As Integer, ByRef lpSecurityAttributes As Security_Attributes,
ByVal dwCreationDisposition As Integer, ByVal dwFlagsAndAttributes As Integer,
ByVal hTemplateFile As Integer) As Intege
Declare Function HidD_GetAttributes Lib "HID.dll" (ByVal Handle As Integer, ByRef BufferPtr As Integer) As Intege
Declare Sub CloseHandle Lib "kernel32" (ByVal HandleToClose As Integer
Declare Function SetupDiDestroyDeviceInfoList Lib "setupapi.dll" (ByVal DeviceInfoSet As Integer) As Boolea
Declare Function GetLastError Lib "kernel32" () As Intege
Declare Function FormatMessage Lib "kernel32" (ByVal dwFlags As Int32, ByVal lpSource As Int32, ByVal dwMessageId As Int32,
ByVal lpBuffer As Int32, ByVal nSize As Int32, ByVal arguments As Long) As Intege
End Clas
Function I am using. Have not gotten all the way through it so there are probably several things that need fixed. I never got anything to come back from the Win32.SetupDiEnumDeviceInterfaces(PnPHandle, 0, HidGuid, HIDdevice, SpDeviceInfoData) cal
Function OpenUSB() As Boolea
Dim PnPHandle As Int6
Dim HIDdevice As Lon
Dim BytesReturned As Lon
Dim inx As Int1
Dim HidName As Strin
Dim ThisHIDdevice As HidD_Attribute
Dim TempInt As Intege
Dim result As Boolea
Dim strTemp As Strin
Dim DeviceInterfaceData As Device_Interface_Dat
Dim FunctionClassDeviceData As Device_Interface_Detai
Dim SpDeviceInfoData As SP_DEVINFO_DATA
On Error GoTo OpenUSBErrHndlr
OpenUSB = True
' First, get my class identifier
Call Win32.HidD_GetHidGuid(HidGuid)
'strTemp = HidGuid.ToString
'
' Get a handle for the Plug and Play node and request currently active HID devices
PnPHandle = Win32.SetupDiGetClassDevs(HidGuid, 0, 0, &H12)
'If (PnPHandle& = -1) Then ErrorExit ("Could not attach to PnP node")
FunctionClassDeviceData.Initialize()
DeviceInterfaceData.cbsize = 28 'Length of data structure in bytes
'
' Lets look for a maximum of 20 HID devices
For HIDdevice = 0 To 19
' Is there a HID device at this table entry
If Win32.SetupDiEnumDeviceInterfaces(PnPHandle, 0, HidGuid, HIDdevice, SpDeviceInfoData) Then
' There is a device here, get it's name
FunctionClassDeviceData.cbsize = 5
result = Win32.SetupDiGetDeviceInterfaceDetail(PnPHandle, DeviceInterfaceData, FunctionClassDeviceData.cbsize, _
Len(FunctionClassDeviceData), BytesReturned, 0)
' If (Success = 0) Then ErrorExit ("Could not find the system name for this HID device")
' Convert C string to Visual Basic String
HidName = "" : inx = 0
Do While FunctionClassDeviceData.DataPath(inx) <> 0
HidName = HidName & Chr(FunctionClassDeviceData.DataPath(inx))
inx = inx + 1
Loop
' Can now open this HID device
Dim SA As Security_Attributes
HidHandle = Win32.CreateFile(HidName, &HC0000000, 3, SA, 3, 0, 0)
If (HidHandle = -1) Then
' Note that Win2K opens system input devices (mouse, keyboard) for EXCLUSIVE use
strTemp = "System input HID detected"
Else
' Get VID and PID for display
result = Win32.HidD_GetAttributes(HidHandle, ThisHIDdevice.Size)
If (ThisHIDdevice.VendorID = 66) Then
OurDevHndl = HidHandle
Else
Call Win32.CloseHandle(HidHandle)
End If
End If
End If 'SetupDiEnumDeviceInterfaces
Next HIDdevice
Call Win32.SetupDiDestroyDeviceInfoList(PnPHandle)
Exit Function
OpenUSBErrHndlr:
Dim errNum As Int32
errNum = Win32.GetLastError()
OpenUSB = False
End Function
