读书人

VB6做USB接口遇到很诡异的有关问题

发布时间: 2012-12-23 11:28:15 作者: rapoo

VB6做USB接口,遇到很诡异的问题,大神进来帮我看看呀。
我通过一个定时器,1s的循环去读USB设备上缓存区,然后返回数据。

Private Sub tmrData_Timer() '数据数据收发
Dim i As Integer, j As Integer

SendBuffer(0) = 0 '缓冲区的第一个字节数 Report ID
SendBuffer(1) = &HB4
SendBuffer(2) = 0
SendBuffer(3) = 0
SendBuffer(4) = 0
SendBuffer(5) = DepID

ReadBuffer(2) = 0

Call VBtoUSB

If ReadBuffer(2) <> 0 Then '已接收到数据
Text1.Text = ReadBuffer(2)
ReadBuffer(2) = 0
End If
ReadBuffer(2) = 0
End Sub

现在的问题是:设备上每次被USB上位机读走后都会清除掉缓存区的数据。。。但是VB中的ReadBuffer一直有数据,这是什么原因呀?如果我把VB关掉再重新打开,就读不到了,显然是设备上的缓存区是没有数据的。

然后我用了很多ReadBuffer(2) = 0想去强制把它清空,但是经过Call VBtoUSB 后,ReadBuffer(2) <> 0,感觉相当的诡异,无端端怎么还会保存第一次的数据呢?有什么办法能看到我是哪里没有清除ReadBuffer???

Public Sub WriteReport()
result = WriteFile(HidDevice, SendBuffer(0), 65, 0, 0)
End Sub

Public Sub tmrDelay_Timer()
Timeout = True
SetHosMsg.tmrDelay = False
End Sub

Public Sub ReadReport()
result = ReadFile(HidDevice, ReadBuffer(0), 65, 0, 0)
End Sub

Public Sub VBtoUSB()
Call WriteReport '发送

Timeout = False
SetHosMsg.tmrDelay.Interval = 5
SetHosMsg.tmrDelay.Enabled = True
Do
DoEvents
Loop While Timeout = True

Call ReadReport '接收
End Sub


[最优解释]


'Example Name: Using DeviceIoControl

'------------------------------------------

'BAS Module Code
'------------------------------------------

Option Explicit

Public Const DRIVE_REMOVABLE = 2
Public Const DRIVE_CDROM = 5
Public Const INVALID_HANDLE_VALUE As Long = -1&
Public Const GENERIC_READ As Long = &H80000000
Public Const FILE_SHARE_READ As Long = &H1
Public Const FILE_SHARE_WRITE As Long = &H2


Public Const FILE_ANY_ACCESS As Long = &H0
Public Const FILE_READ_ACCESS As Long = &H1
Public Const FILE_WRITE_ACCESS As Long = &H2
Public Const OPEN_EXISTING As Long = 3
Public Const IOCTL_STORAGE_MEDIA_REMOVAL As Long = &H2D4804

Public Type PREVENT_MEDIA_REMOVAL
PreventMediaRemoval As Byte
End Type

Public Declare Function GetLogicalDriveStrings Lib "kernel32" _
Alias "GetLogicalDriveStringsA" _
(ByVal nBufferLength As Long, _
ByVal lpBuffer As String) As Long

Public Declare Function GetDriveType Lib "kernel32" _
Alias "GetDriveTypeA" _
(ByVal lpRootPathName As String) As Long

Public Declare Function DeviceIoControl Lib "kernel32" _
(ByVal hDevice As Long, _
ByVal dwIoControlCode As Long, _
lpInBuffer As Any, _
ByVal nInBufferSize As Long, _
lpOutBuffer As Any, _
ByVal nOutBufferSize As Long, _
lpBytesReturned As Long, _
lpOverlapped As Any) As Long

Public Declare Function CreateFile Lib "kernel32" _
Alias "CreateFileA" _
(ByVal lpFileName As String, _
ByVal dwDesiredAccess As Long, _
ByVal dwShareMode As Long, _
lpSecurityAttributes As Any, _
ByVal dwCreationDisposition As Long, _
ByVal dwFlagsAndAttributes As Long, _
ByVal hTemplateFile As Long) As Long

Public Declare Function CloseHandle Lib "kernel32" _
(ByVal hObject As Long) As Long

Public Function DeviceLock(sDrive As String, fLock As Boolean) As Boolean

Dim hDevice As Long
Dim PMR As PREVENT_MEDIA_REMOVAL
Dim bytesReturned As Long
Dim success As Long

'the drive letter has to be passed
'to CreateFile without a trailing slash (ie 'G:')
sDrive = UnQualifyPath(sDrive)

'obtain a handle to the device
'using the correct device syntax
hDevice = CreateFile("\\.\" & sDrive, _
GENERIC_READ, _
FILE_SHARE_READ Or FILE_SHARE_WRITE, _
ByVal 0&, _


OPEN_EXISTING, _
0&, 0&)


If hDevice <> INVALID_HANDLE_VALUE Then

'assign the fLock value to the
'PREVENT_MEDIA_REMOVAL type
PMR.PreventMediaRemoval = CByte(Abs(fLock))

'If the operation succeeds,
'DeviceIoControl returns a nonzero value
success = DeviceIoControl(hDevice, _
IOCTL_STORAGE_MEDIA_REMOVAL, _
PMR, _
Len(PMR), _
ByVal 0&, _
0&, _
bytesReturned, _
ByVal 0&)

End If

Call CloseHandle(hDevice)
DeviceLock = success

End Function


Private Function UnQualifyPath(ByVal sPath As String) As String

'removes any trailing slash from the path
sPath = Trim$(sPath)

If Right$(sPath, 1) = "\" Then
UnQualifyPath = Left$(sPath, Len(sPath) - 1)
Else: UnQualifyPath = sPath
End If

End Function
'--end block--'
'------------------------------------------
'Form Code
'
'Add a listbox (List1), a command button array (Command1(0), Command1(1)),
'and a label (Label1) to a form. The third button shown (End) is optional.
'Add the following code to the form:


'------------------------------------------

Option Explicit

Private Sub Form_Load()

'load the removable drives and
'disable the command buttons until
'a drive is selected
LoadAvailableDrives List1
Command1(0).Enabled = False
Command1(1).Enabled = False

End Sub


Private Sub List1_Click()

Command1(0).Enabled = List1.ListIndex > -1
Command1(1).Enabled = List1.ListIndex > -1

End Sub


Private Sub Command1_Click(Index As Integer)

Dim fLock As Boolean
Dim result As Boolean
Dim sDrive As String

'nothing to do if a drive's not selected
If List1.ListIndex > -1 Then

'get the selected drive
sDrive = List1.List(List1.ListIndex)

'DeviceIoControl requires the
'IOCTL_STORAGE_MEDIA_REMOVAL
'control code and a Boolean
'indicating the lock state.
'Passing False unlocks the device;
'passing True locks it. This handily
'corresponds to the 0/1 indices of
'the Command button array.
fLock = CBool(Index)
result = DeviceLock(sDrive, fLock)

'display result
If result Then

Select Case Index
Case 0: Label1.Caption = "Device " & sDrive & " is unlocked."
Case 1: Label1.Caption = "Device " & sDrive & " is locked."
End Select

Else: Label1.Caption = "Call failed - perhaps no media in device."
End If

End If

End Sub


Private Sub LoadAvailableDrives(lst As ListBox)

Dim lpBuffer As String
Dim drvType As Long
Dim currDrive As String

'get list of available drives
lpBuffer = GetDriveString()

'Separate the drive strings
'and add to the combo. StripNulls


'will continually shorten the
'string. Loop until a single
'remaining terminating null is
'encountered.
Do Until lpBuffer = Chr(0)

'strip off one drive item
'and check for removable (or CD) status,
'and add to the combo
currDrive = StripNulls(lpBuffer)
drvType = GetDriveType(currDrive)

If (drvType = DRIVE_CDROM) Or _
(drvType = DRIVE_REMOVABLE) Then

lst.AddItem currDrive

End If

Loop

End Sub


Private Function StripNulls(startstr As String) As String

'Take a string separated by chr$(0)
'and split off 1 item, shortening the
'string so next item is ready for removal.
Dim pos As Long

pos = InStr(startstr, Chr$(0))

If pos Then

StripNulls = Mid$(startstr, 1, pos - 1)
startstr = Mid$(startstr, pos + 1, Len(startstr))

End If

End Function


Private Function GetDriveString() As String

'returns of available drives each
'separated by a null
Dim sBuffer As String

'possible 26 drives, three characters each, plus trailing null
sBuffer = Space$(26 * 4)

If GetLogicalDriveStrings(Len(sBuffer), sBuffer) Then

'trim string but do not
'remove trailing null
GetDriveString = Trim$(sBuffer)

End If

End Function


[其他解释]
该回复于2012-12-08 14:15:47被管理员删除
[其他解释]
http://download.csdn.net/detail/veron_04/1673828
[其他解释]
楼上好东西啊

读书人网 >VB

热点推荐