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