USB口的红外条形码扫描器的另类使用

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

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

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

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

form1 中的代码：

' *************************************************************************
' **模 块 名：frmDemo
' **说    明：YFsoft 版权所有2006 - 2007(C)
' **创 建 人：叶帆 http://blog.csdn.net/yefanqiu
' **日    期：2006-08-30 14:55:56
' **修 改 人：
' **日    期：
' **描    述：
' **版    本：V1.0.0
' *************************************************************************
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
' **说    明：YFsoft 版权所有2006 - 2007(C)
' **创 建 人：叶帆 http://blog.csdn.net/yefanqiu
' **日    期：2006-08-30 15:02:29
' **修 改 人：
' **日    期：
' **描    述：获取条形码数据
' **版    本：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
' **输    入：无
' **输    出：无
' **功能描述：装卸钩子
' **全局变量：
' **调用模块：
' **作    者：叶帆
' **日    期：2006-08-30 15:11:37
' **修 改 人：
' **日    期：
' **版    本：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) -
' **功能描述：获取扫描码
' **全局变量：
' **调用模块：
' **作    者：叶帆
' **日    期：2006-08-30 16:46:04
' **修 改 人：
' **日    期：
' **版    本：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) -
' **功能描述：
' **全局变量：
' **调用模块：
' **作    者：叶帆
' **日    期：2006-08-30 15:03:47
' **修 改 人：
' **日    期：
' **版    本：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
    
    frmDemo.lblTime  =  g_BarCode.Time
End Sub