USB口的条形码扫描器接口编程(VB) 转

目前的条形码扫描器有点类似外接键盘（其实从消息传送上它就相当于一个键盘），把输入焦点定位到可输入的控件上，一扫描相应的条形码信息就输入到文本框中去了，但是如果没有输入焦点，或另一个不相干的程序获得输入焦点，那就有点乱套了。我想实现的是，不管什么情况，只要扫描器一工作，我的程序就能自动激活，并能获得当前输入的条形码信息。

实现思路：我用的USB口的条形码扫描器，仔细分析了一下，扫描成功后，以键盘按键消息的形式把条形码输入信息通知给系统。这样通过键盘钩子就可以方便的获得该信息了。但是，怎样区分信息是键盘还是条形码输入的哪？

很简单，条形码扫描器在很短的时间内输入了至少3个字符以上信息，并且以“回车”作为结束字符，在这种思想指引下，很完美的实现了预定功能。

以下程序要在Win2000/Win XP 下才能运行成功。

 

form1 中的代码：

'*************************************************************************

Option Explicit

Private Sub Form_Load()
   SetHook
End Sub

Private Sub Form_Unload(Cancel As Integer)
   UnHook
End Sub

Private Sub tmrScan_Timer()
    Dim strBarCode As String
    strBarCode = GetBarCode
    If Len(strBarCode) > 0 Then
        MsgBox "条形码:" & strBarCode
    End If
End Sub
模块中的代码：

'*************************************************************************
'**模 块 名：basBarCode
'**描    述：获取条形码数据
'**版    本：V1.0.0
'*************************************************************************
Option Explicit

Private Type KeyboardBytes
    kbByte(0 To 255) As Byte
End Type
Dim kbArray As KeyboardBytes

Private Declare Function GetKeyboardState Lib "user32" (pbKeyState As KeyboardBytes) As Long
Private Declare Function ToAscii Lib "user32" (ByVal uVirtKey As Long, ByVal uScanCode As Long, lpbKeyState As KeyboardBytes, lpwTransKey As Long, ByVal fuState As Long) As Long

Private Declare Function CallNextHookEx Lib "user32" (ByVal hHook As Long, ByVal ncode As Long, ByVal wParam As Long, lParam As Any) As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (lpvDest As Any, ByVal lpvSource As Long, ByVal cbCopy As Long)
Private Declare Function GetKeyNameText Lib "user32" Alias "GetKeyNameTextA" (ByVal lParam As Long, ByVal lpBuffer As String, ByVal nSize As Long) As Long

Private Type EVENTMSG
    message As Long
    paramL As Long
    paramH As Long
    Time As Long
    hwnd As Long
End Type

Private Type BARCODES
    VirtKey As Long         '虚拟码
    ScanCode As Long           '扫描码
    KeyName As String       '键的名称
    AscII As Long           'AscII
    Chr As String           '字符
   
    BarCode As String      '扫描码信息
    Time As Date            '扫描时间
    bGetFlag As Boolean     '是否已获取扫描码
End Type

Private Declare Function SetWindowsHookEx Lib "user32" Alias "SetWindowsHookExA" (ByVal idHook As Long, ByVal lpfn As Long, ByVal hmod As Long, ByVal dwThreadId As Long) As Long
Private Declare Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As Long) As Long
Private Declare Function GetCurrentTime Lib "kernel32" Alias "GetTickCount" () As Long

Private Const WH_KEYBOARD_LL = 13
Private m_lHook As Long
Public g_BarCode As BARCODES

'*************************************************************************
'**函 数 名：SetHook / UnHook
'**输    入：无
'**输    出：无
'**功能描述：装卸钩子
'**全局变量：
'**调用模块：
'**版    本：V1.0.0
'*************************************************************************
Public Sub SetHook()
    m_lHook = SetWindowsHookEx(WH_KEYBOARD_LL, AddressOf CallHookProc, App.hInstance, 0)
End Sub

Public Sub UnHook()
    If m_lHook <> 0 Then
        UnhookWindowsHookEx m_lHook
    End If
End Sub

'*************************************************************************
'**函 数 名：GetBarCode
'**输    入：无
'**输    出：(String) -
'**功能描述：获取扫描码
'**全局变量：
'**调用模块：
'**版    本：V1.0.0
'*************************************************************************
Public Function GetBarCode() As String
    If g_BarCode.bGetFlag = True Then
        g_BarCode.bGetFlag = False
        GetBarCode = g_BarCode.BarCode
    Else
        GetBarCode = ""
    End If
End Function

'*************************************************************************
'**函 数 名：CallHookProc
'**输    入：ByVal code(Long)   -
'**        ：ByVal wParam(Long) -
'**        ：ByVal lParam(Long) -
'**输    出：(Long) -
'**功能描述：
'**全局变量：
'**调用模块：
'**版    本：V1.0.0
'*************************************************************************
Private Function CallHookProc(ByVal code As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
    Dim msg As EVENTMSG
    Dim strKeyName As String
    Dim lngKey As Long
    Static lngTime As Long
    Static strBarCode As String

If code = 0 Then
        CopyMemory msg, lParam, LenB(msg)
        If wParam = &H100 Then   'WM_KEYDOWN
            g_BarCode.VirtKey = msg.message And &HFF           '虚拟码
            g_BarCode.ScanCode = msg.paramL And &HFF              '扫描码
           
            strKeyName = Space(255)
            If GetKeyNameText(g_BarCode.ScanCode * 65536, strKeyName, 255) > 0 Then  '键名
                g_BarCode.KeyName = Trim(strKeyName)
            Else
                g_BarCode.KeyName = ""
            End If

'---------------------------------------
            Call GetKeyboardState(kbArray)
            If ToAscii(g_BarCode.VirtKey, g_BarCode.ScanCode, kbArray, lngKey, 0) > 0 Then
                g_BarCode.AscII = lngKey
                g_BarCode.Chr = Chr(lngKey)
            End If

'--------------------
            If Abs(GetCurrentTime - lngTime) > 50 Then
                strBarCode = g_BarCode.Chr
            Else
                If (msg.message And &HFF) = 13 And Len(strBarCode) > 3 Then '回车
                    g_BarCode.BarCode = strBarCode
                    g_BarCode.Time = Now
                    g_BarCode.bGetFlag = True
                End If
                strBarCode = strBarCode & g_BarCode.Chr
            End If
            lngTime = GetCurrentTime
            '---------------------------------------
            '测试代码
            ’Call ShowKeyInfo
            '---------------------------------------
        End If

End If

CallHookProc = CallNextHookEx(m_lHook, code, wParam, lParam)
End Function

'显示调试信息
Public Sub ShowKeyInfo()
    frmDemo.txtKey(0) = g_BarCode.KeyName
    frmDemo.txtKey(1) = g_BarCode.VirtKey
    frmDemo.txtKey(2) = g_BarCode.ScanCode

frmDemo.txtKey(3) = g_BarCode.AscII
    frmDemo.txtKey(4) = g_BarCode.Chr
    frmDemo.txtBarCode = g_BarCode.BarCode