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
   

USB口的條碼掃描器介面編程(VB) 轉