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