If this is your first visit, be sure to
check out the
FAQ
by clicking the
link above. You may have to
register
before you can post: click the register link above to proceed. To start viewing messages,
select the forum that you want to visit from the selection below.
i have a project now with using USB Cable.. and i want to write an app using vb6.. i found some .bas from net...
HID Interface
Code:
' This module is common to all of the Example programs
' It declares the {Open, Read, Write, Close} calls for the USB device
' These user-calls are translated into OS system calls
' This module also contains several support routines used by all of the examples
' Declare module-wide variables
Private HidHandle As Long
Public Function OpenUSBdevice(NameOfDevice$) As Boolean
' This function searches the system HID tables for NameOfDevice$
' If found then it opens the device and returns TRUE, else it returns FALSE
Dim HidGuid As Guid: Dim Success As Boolean: Dim Openned As Boolean: Dim Buffer(256) As Byte
Dim DeviceInterfaceData As Device_Interface_Data
Dim FunctionClassDeviceData As Device_Interface_Detail
' First, get the HID class identifier
Call HidD_GetHidGuid(HidGuid.Data(0))
' Get a handle for the Plug and Play node, request currently active HID devices
PnPHandle& = SetupDiGetClassDevs(HidGuid.Data(0), 0, 0, &H12)
If (PnPHandle& = -1) Then ErrorExit ("Could not attach to PnP node")
HidEntry& = 0: Openned = False
DeviceInterfaceData.cbsize = 28 'Length of data structure in bytes
' Look through the table of HID devices
Do While SetupDiEnumDeviceInterfaces(PnPHandle&, 0, HidGuid.Data(0), HidEntry&, DeviceInterfaceData.cbsize)
' There is a device here, get it's name
FunctionClassDeviceData.cbsize = 5
Success = SetupDiGetDeviceInterfaceDetail(PnPHandle&, DeviceInterfaceData.cbsize, _
FunctionClassDeviceData.cbsize, UBound(FunctionClassDeviceData.DataPath), BytesReturned&, 0)
If (Success = 0) Then ErrorExit ("Could not get the name of this HID device")
' Convert returned C string to Visual Basic String
hidname$ = "": i& = 0
Do While FunctionClassDeviceData.DataPath(i&) <> 0
hidname$ = hidname$ & Chr$(FunctionClassDeviceData.DataPath(i&)): i& = i& + 1: Loop
' Can now open this HID device
Dim SA As Security_Attributes
HidHandle& = CreateFile(hidname$, &HC0000000, 3, SA, 3, 0, 0)
If (HidHandle = -1) Then ErrorExit ("Could not open HID device")
' Is it OUR HID device?
If HidD_GetProductString(HidHandle&, AddressFor(Buffer(0)), UBound(Buffer)) Then
DeviceName$ = "": i& = 0
Do While Buffer(i&) <> 0: DeviceName$ = DeviceName$ & Chr$(Buffer(i&)): i& = i& + 2: Loop
If (StrComp(DeviceName$, NameOfDevice$) = 0) Then
Openned = True: Exit Do: End If
End If 'HidD_GetProductString
Call CloseHandle(HidHandle&) ' Was not OUR HID device
HidEntry& = HidEntry& + 1 ' Check next entry
Loop 'SetupDiEnumDeviceInterfaces returns FALSE when there are no more entries
SetupDiDestroyDeviceInfoList (PnPHandle&)
OpenUSBdevice = Openned
End Function
Public Sub ReadUSBdevice(BufferPtr&, ByteCount&)
' This subroutine "reads" from an openned USB device
' This routine gets an Input Report from the USB device and returns the data
' NOTE that ReadFile is a BLOCKING system call, ie it will wait for the USB device to respond
' Do not configure the USB device to "Generate report only on change" since the program
' will appear to 'hang'
' Use a local buffer so that the ReportID (=0) at ReportBuffer(0) may be removed
Dim ReportBuffer(256) As Byte
If ByteCount& > 254 Then ErrorExit ("Maximum ByteCount for ReadUSBdevice is 254")
If ByteCount& < 1 Then ErrorExit ("Minimum ByteCount for ReadUSBdevice is 1")
Success = ReadFile(HidHandle&, AddressFor(ReportBuffer(0)), ByteCount& + 1, BytesReturned&, 0)
If (Success = 0) Then ErrorExit ("Could not get an Input Report")
Call CopyBuffer(AddressFor(ReportBuffer(1)), BufferPtr&, BytesReturned& - 1)
End Sub
Public Sub WriteUSBdevice(BufferPtr&, ByteCount&)
' This subroutine "writes" to an openned USB device
' Copy the user buffer into a local buffer so that a ReportID (=0) may be prepended
' The first byte will contain the ReportID (=0)
Dim ReportBuffer(256) As Byte
If ByteCount& > 254 Then ErrorExit ("Maximum ByteCount for WriteUSBdevice is 254")
Call CopyBuffer(BufferPtr&, AddressFor(ReportBuffer(1)), ByteCount&)
ReportBuffer(0) = 0 ' ReportID
Success = WriteFile(HidHandle&, AddressFor(ReportBuffer(0)), ByteCount& + 1, BytesWritten&, 0)
If (Success = 0) Then ErrorExit ("Could not write an Output Report")
End Sub
Public Sub CloseUSBdevice()
' This subroutine closes the USB device that we have been using
Call CloseHandle(HidHandle&)
End Sub
Public Function ReturnHexByte(Text$) As Byte
' Converts the first two characters of text$ into a byte
Dim Value As Byte
Utext$ = UCase(Text$) ' Convert to uppercase for search
HexString$ = "0123456789ABCDEF" ' Non-Hex characters = 0
Value = 0
For i& = 0 To 15
If Mid(Utext$, 1, 1) = Mid(HexString$, i& + 1, 1) Then Value = Value + (16 * i&)
If Mid(Utext$, 2, 1) = Mid(HexString$, i& + 1, 1) Then Value = Value + i&
Next i&
ReturnHexByte = Value
End Function
Public Function TwoHexCharacters$(Value As Byte)
HexString$ = "0123456789ABCDEF"
TwoHexCharacters$ = Mid(HexString$, Int(Value / 16) + 1, 1) & Mid(HexString$, Int(Value And &HF) + 1, 1)
End Function
Public Function TwoDecimalCharacters$(Value As Byte)
DecimalString$ = "0123456789"
Tens& = Int(Value / 10): Units& = Value - (10 * Tens&)
TwoDecimalCharacters$ = Mid(DecimalString$, Tens& + 1, 1) & Mid(DecimalString$, Units& + 1, 1)
End Function
Public Function ThreeDecimalCharacters$(Value As Byte)
h& = Int(Value / 100): t& = Int((Value - (100 * h&)) / 10): u& = Value - (100 * h&) - (10 * t&)
ThreeDecimalCharacters$ = h& & t& & u&
End Function
Public Sub ErrorExit(Reason$)
ErrorCode = GetLastError()
Call MsgBox(Reason$, vbCritical)
If ErrorCode <> 0 Then
End If
End Sub
OS Interface
Code:
' This module is common to all of the Example programs
' It declares the data types and system calls required to access the Windows operating system
Public Type Security_Attributes: nLength As Long: lpSecurityDescriptor As Long: bInheritHandle As Long: End Type
Public Type Guid: Data(3) As Long: End Type 'A GUID is 16 bytes long
Public Type Device_Interface_Data
cbsize As Long: InterfaceClassGuid As Guid: Flags As Long: ReservedPtr As Long: End Type
Public Type Device_Interface_Detail: cbsize As Long: DataPath(256) As Byte: End Type
Public Type ConfigurationDataType: cookie As Long: cbsize As Long: RingBuffersize As Long: End Type
Public Type HidD_Attributes
cbsize As Long: VendorID(1) As Byte: ProductID(1) As Byte: VersionNumber(1) As Byte: Pad(10) As Byte: End Type
' Declare the functions from Dan Appleman's "Programmers Guide to the Win32 API"
Declare Function AddressFor Lib "apigid32.dll" Alias "agGetAddressForObject" (PassedByReference As Any) As Long
Declare Sub CopyBuffer Lib "apigid32.dll" Alias "agCopyData" (ByVal SourcePtr&, ByVal DestPtr&, ByVal ByteCount&)
' Declare the API calls that I am using
Declare Sub HidD_GetHidGuid Lib "HID.dll" (GuidPtr&)
Declare Function SetupDiGetClassDevs Lib "setupapi.dll" Alias "SetupDiGetClassDevsA" _
(GuidPtr&, ByVal EnumPtr&, ByVal HwndParent&, ByVal Flags&) As Long
Declare Function SetupDiDestroyDeviceInfoList Lib "setupapi.dll" (ByVal DeviceInfoSet&) As Boolean
Declare Function SetupDiEnumDeviceInterfaces Lib "setupapi.dll" _
(ByVal Handle&, ByVal InfoPtr&, GuidPtr&, ByVal MemberIndex&, InterfaceDataPtr&) As Boolean
Declare Function SetupDiGetDeviceInterfaceDetail Lib "setupapi.dll" Alias "SetupDiGetDeviceInterfaceDetailA" _
(ByVal Handle&, InterfaceDataPtr&, InterfaceDetailPtr&, ByVal DetailLength&, _
ReturnedLengthPtr&, ByVal DevInfoDataPtr&) As Boolean
Declare Function GetLastError Lib "kernel32" () As Long
Declare Function CreateFile Lib "kernel32" Alias "CreateFileA" _
(ByVal lpFileName$, ByVal dwDesiredAccess&, ByVal dwShareMode&, lpSecurityAttributes As Security_Attributes, _
ByVal dwCreationDisposition&, ByVal dwFlagsAndAttributes&, ByVal hTemplateFile&) As Long
Declare Sub CloseHandle Lib "kernel32" (ByVal HandleToClose As Long)
Declare Function ReadFile Lib "kernel32" _
(ByVal Handle&, ByVal BufferPtr&, ByVal ByteCount&, BytesReturnedPtr&, ByVal OverlappedPtr&) As Long
Declare Function WriteFile Lib "kernel32" _
(ByVal Handle&, ByVal BufferPtr&, ByVal ByteCount&, BytesReturnedPtr&, ByVal OverlappedPtr&) As Long
Declare Function DeviceIoControl Lib "kernel32" _
(ByVal hDevice&, ByVal dwIoControlCode&, lpInBuffer&, ByVal nInBufferSize&, _
lpOutBuffer&, ByVal nOutBufferSize&, lpBytesReturned&, lpOverlapped&) As Long
Declare Function HidD_GetPreparsedData Lib "HID.dll" (ByVal Handle&, ByVal BufferPtr&) As Long
Declare Function HidD_GetAttributes Lib "HID.dll" (ByVal Handle&, BufferPtr&) As Long
Declare Function HidD_GetManufacturerString Lib "HID.dll" (ByVal Handle&, ByVal BufferPtr&, ByVal Length&) As Long
Declare Function HidD_GetProductString Lib "HID.dll" (ByVal Handle&, ByVal BufferPtr&, ByVal Length&) As Long
Declare Function HidD_GetSerialNumberString Lib "HID.dll" (ByVal Handle&, ByVal BufferPtr&, ByVal Length&) As Long
Declare Function HidD_GetIndexedString Lib "HID.dll" (ByVal Handle&, ByVal index&, ByVal BufferPtr&, ByVal Length&) As Long
Declare Function HidD_GetConfiguration Lib "HID.dll" (ByVal Handle&, ByVal BufferPtr&, ByVal Length&) As Long
Declare Function HidD_SetConfiguration Lib "HID.dll" (ByVal Handle&, ByVal BufferPtr&, ByVal Length&) As Long
Declare Function HidD_GetPhysicalDescriptor Lib "HID.dll" (ByVal Handle&, ByVal BufferPtr&, ByVal Length&) As Long
now i tried to open some of my usb device tru HID just for my opinion..
in Form1 i put this in form load
Code:
text1.text = OpenUSBdevice("USB\VID344_433&PID_0431a")
but it says Could not open HID device...
anybody can help me..
Advertiser Disclosure:
Some of the products that appear on this site are from companies from which TechnologyAdvice receives compensation. This compensation may impact how and where products appear on this site including, for example, the order in which they appear. TechnologyAdvice does not include all companies or all types of products available in the marketplace.
