VBA ve GetRawInputDeviceList

Question

Access 2013'te çalışıyorum ve başarılı bir şekilde VBA için GetRawInputDeviceList, GetRawInputDeviceInfo, RegisterRawInputDevices ve GetRawInputData eşdeğerlerini almaya çalışıyorum. Bir barkod tarayıcısı seçmek için bilgisayara bağlı HID ​​aygıtlarının bir listesini almak için bir yordam, işlev veya modül için boş yere de aradım. Bu üçüncü haftanın başlangıcıdır, bu yüzden dizlerimde yardım için yalvarıyorum. Herhangi birinizin paylaşmaya hazır olduğunuz bir modülünüz var mı, bununla ilgili bir web sitesine bir bağlantı mı? Herhangi bir yardım büyük beğeni topluyor.

Answer 1

VBA'dan GetRawInputDeviceList API'sini kullanmak pRawInputDeviceList parametresi nedeniyle oldukça zor olabilir. Kendi belleğinizi yönetmek ve RAWINPUTDEVICELIST'in ham belleğindeki el ile işlemek için bir ton çemberin içinden atlamak istemediğiniz sürece, başka bir yönden bu konuda daha iyi olursunuz.

Çoğu barkod tarayıcısını, Windows'a bir klavye olarak sunmayı düşünüyorum.

Private Sub ShowKeyboardInfo() 
    Dim WmiServer As Object 
    Dim ResultSet As Object 
    Dim Keyboard As Object 
    Dim Query As String 

    Query = "SELECT * From Win32_Keyboard" 
    Set WmiServer = GetObject("winmgmts:root/CIMV2") 
    Set ResultSet = WmiServer.ExecQuery(Query) 

    For Each Keyboard In ResultSet 
     Debug.Print Keyboard.Name & vbTab & _ 
        Keyboard.Description & vbTab & _ 
        Keyboard.DeviceID & vbTab & _ 
        Keyboard.Status 
    Next Keyboard 
End Sub 

Not: Yukarısı açılmıyorsa, sen CIM_USBDevice sorgulayarak USB cihazların tüm numaralandırabilmesidir: Query = "SELECT * From Win32_Keyboard"

Olası bir çözüm ekli Win32_Keyboard cihazları sıralamak için bir WMI sorgusu kullanmak olacaktır

DÜZENLEME: Yukarıdaki yorumlar, yukarıdaki kodlar ham giriş olaylarını almak için kaydolmak için gereken tanıtıcıyı döndürmez. Bu, ancak başlamanız gerekir - RegisterRawInputDevices ve GetRawInputData yönleri kolayca bir cevapta gidecek ne kapsamı dışındadır. Bir hack atın ve herhangi bir sorunla karşılaşırsanız kodunuzu başka bir soruya gönderin.

Tanımlamalar: GetRawInputDeviceInfo cihaz isimleri alınmasıyla

Private Type RawInputDeviceList 
    hDevice As Long 
    dwType As Long 
End Type 

Private Type RidKeyboardInfo 
    cbSize As Long 
    dwType As Long 
    dwKeyboardMode As Long 
    dwNumberOfFunctionKeys As Long 
    dwNumberOfIndicators As Long 
    dwNumberOfKeysTotal As Long 
End Type 

Private Enum DeviceType 
    TypeMouse = 0 
    TypeKeyboard = 1 
    TypeHID = 2 
End Enum 

Private Enum DeviceCommand 
    DeviceName = &H20000007 
    DeviceInfo = &H2000000B 
    PreParseData = &H20000005 
End Enum 

Private Declare Function GetRawInputDeviceList Lib "user32" (_ 
    ByVal pRawInputDeviceList As Long, _ 
    ByRef puiNumDevices As Long, _ 
    ByVal cbSize As Long) As Long 

Private Declare Function GetRawInputDeviceInfo Lib "user32" Alias "GetRawInputDeviceInfoW" (_ 
    ByVal hDevice As Long, _ 
    ByVal uiCommand As Long, _ 
    ByVal pData As Long, _ 
    ByRef pcbSize As Long) As Long 

Private Declare Function GetLastError Lib "kernel32"() As Long 

Örnek:

yan kaydırma yaklaşık

Private Sub SampleCode() 
    Dim devices() As RawInputDeviceList 

    devices = GetRawInputDevices 
    Dim i As Long 
    For i = 0 To UBound(devices) 
     'Inspect the type - only looking for a keyboard. 
     If devices(i).dwType = TypeKeyboard Then 
      Dim buffer As String 
      Dim size As Long 
      'First call with a null pointer returns the string length in size. 
      If GetRawInputDeviceInfo(devices(i).hDevice, DeviceName, 0&, size) = -1 Then 
       Debug.Print "GetRawInputDeviceInfo error " & GetLastError() 
      Else 
       'Size the string buffer. 
       buffer = String(size, Chr$(0)) 
       'The second call copies the name into the passed buffer. 
       If GetRawInputDeviceInfo(devices(i).hDevice, DeviceName, StrPtr(buffer), size) = -1 Then 
        Debug.Print "GetRawInputDeviceInfo error " & GetLastError() 
       Else 
        Debug.Print buffer 
       End If 
      End If 
     End If 
    Next i 

End Sub 

Private Function GetRawInputDevices() As RawInputDeviceList() 
    Dim devs As Long 
    Dim output() As RawInputDeviceList 

    'First call with a null pointer returns the number of devices in devs 
    If GetRawInputDeviceList(0&, devs, LenB(output(0))) = -1 Then 
     Debug.Print "GetRawInputDeviceList error " & GetLastError() 
    Else 
     'Size the output array. 
     ReDim output(devs - 1) 
     'Second call actually fills the array. 
     If GetRawInputDeviceList(VarPtr(output(0)), devs, LenB(output(0))) = -1 Then 
      Debug.Print "GetRawInputDeviceList error " & GetLastError() 
     Else 
      GetRawInputDevices = output 
     End If 
    End If 
End Function 

yazık ki.