Part two:
'______________________________________________________________________________
'
Function GetDeviceInfo(ByRef Device As String) As Long
Dim zClassName As zString * 128
Dim wGuidTxt As wString * 39 'LPOLESTR lpsz
Dim DeviceInfoData As SP_DEVINFO_DATA
Dim hDeviceInfoSet As HDEVINFO
Dim RequiredSize As DWord
Dim DevCount As Long
Dim Retval As Long
zClassName = Device
DevCount = 0
'The SetupDiClassGuidsFromName Function retrieves the GUID(s) associated with the specIfied class name.
'This list is built based on the classes currently installed on the system.
Retval = SetupDiClassGuidsFromName(zClassName, ByVal 0, ByVal 0, @RequiredSize) 'Ask FOR array size, returns TRUE If successful.
EditAdd(" - SetupDi devices")
EditAdd(LineSeparator)
REDIM GuidArray(1 TO RequiredSize) As GUID
Retval = SetupDiClassGuidsFromName(zClassName, @GuidArray(1), _ 'Ask FOR GUID associated with the class name
ByVal SizeOf(GUID) * RequiredSize, @RequiredSize)
'SetupDiGetClassDevs retrieves a device information set that contains all devices of a specIfied class.
'Get info by ClassGUID, like GUID$("{4D36E978E325-11CE-BFC1-08002BE10318})
hDeviceInfoSet = SetupDiGetClassDevs(@GuidArray(1), ByVal Null, ByVal Null, DIGCF_PRESENT)
EditAdd("hDeviceInfoSet: " & HTab & "0x" & Hex(hDeviceInfoSet))
If hDeviceInfoSet <> INVALID_HANDLE_VALUE THEN
DeviceInfoData.cbSize = SizeOf(DeviceInfoData)
Do 'Loop to get all devices of a class
'Get a device based on DevCount, exit If no more
If SetupDiEnumDeviceInfo(hDeviceInfoSet, DevCount, @DeviceInfoData) THEN 'Return True if success
EditAdd(LineSeparator)
EditAdd("ClassName: " & HTab & zClassName)
StringFromGUID2(@GuidArray(1), @wGuidTxt, 38 * 2)
EditAdd("GUID: " & HTab & HTab & wGuidTxt)
EditAdd(SetupDiGetDeviceRegistryPropertyCall(hDeviceInfoSet, DeviceInfoData, SPDRP_FRIENDLYNAME, "FriEndlyName: "))
EditAdd(SetupDiGetDeviceRegistryPropertyCall(hDeviceInfoSet, DeviceInfoData, SPDRP_DEVICEDESC, "Desc: "))
EditAdd(SetupDiGetDeviceRegistryPropertyCall(hDeviceInfoSet, DeviceInfoData, SPDRP_DRIVER, "Driver: "))
EditAdd(SetupDiGetDeviceRegistryPropertyCall(hDeviceInfoSet, DeviceInfoData, SPDRP_HARDWAREID, "HardId: "))
EditAdd(SetupDiGetDeviceRegistryPropertyCall(hDeviceInfoSet, DeviceInfoData, SPDRP_ENUMERATOR_NAME, "Enum: "))
EditAdd(SetupDiGetDeviceRegistryPropertyCall(hDeviceInfoSet, DeviceInfoData, SPDRP_MFG, "MFG: "))
EditAdd(SetupDiGetDeviceRegistryPropertyCall(hDeviceInfoSet, DeviceInfoData, SPDRP_SERVICE, "Servcice: "))
EditAdd(SetupDiGetDeviceRegistryPropertyCall(hDeviceInfoSet, DeviceInfoData, SPDRP_PHYSICAL_DEVICE_OBJECT_NAME, "PhyObj: "))
Function = TRUE
Else
EXIT DO
End If
DevCount += 1
LOOP
SetupDiDestroyDeviceInfoList(hDeviceInfoSet)
End If
EditAdd(LineSeparator)
EditAdd(LineSeparator)
End Function
'______________________________________________________________________________
Function WndProc(ByVal hWnd As HWND, ByVal uMsg As UINT, ByVal wParam As WPARAM, ByVal lParam As LPARAM) As Integer
Static hButtonExit As HWND
Static hButtonTextClear As HWND
Static hFont As HFONT
Select Case (uMsg)
Case WM_CREATE
'Controls creations -----------------------------------------------------
Dim NotClientMetrics As NONCLIENTMETRICS
NotClientMetrics.cbSize = SizeOf(NONCLIENTMETRICS)
SystemParametersInfo(SPI_GETNONCLIENTMETRICS, NotClientMetrics.cbSize, @NotClientMetrics, 0)
hFont = CreateFontIndirect(@NotClientMetrics.lfMessageFont)
g->hEdit = CreateWindowEx(WS_EX_CLIENTEDGE, "Edit", "", _
WS_CHILD Or WS_VISIBLE Or WS_TABSTOP Or WS_CLIPSIBLINGS Or _
WS_TABSTOP Or WS_VSCROLL Or ES_LEFT Or ES_AUTOHSCROLL Or _
ES_MULTILINE Or ES_WANTRETURN Or ES_NOHIDESEL, _
10, 10, 205, 310, _
hWnd, Cast(HMENU, Edit), _
hInstance, Null)
SendMessage(g->hEdit, WM_SETFONT, Cast(WPARAM, hFont), True)
hButtonTextClear = CreateWindowEx(0, "Button", "Text &clear", _
WS_CHILD Or WS_VISIBLE Or BS_CENTER Or WS_TABSTOP Or _
BS_NOTIfY Or BS_TEXT Or BS_VCENTER, _
10, 325, 95, 30, _
hWnd, Cast(HMENU, ButtonTextClear), _
hInstance, Null)
SendMessage(hButtonTextClear, WM_SETFONT, Cast(WPARAM, hFont), True)
hButtonExit = CreateWindowEx(0, "Button", "E&xit", _
WS_CHILD Or WS_VISIBLE Or BS_CENTER Or WS_TABSTOP Or _
BS_NOTIfY Or BS_TEXT Or BS_VCENTER, _
105, 325, 95, 30, _
hWnd, Cast(HMENU, ButtonExit), _
hInstance, Null)
SendMessage(hButtonExit, WM_SETFONT, Cast(WPARAM, hFont), True)
'Get SetupDi infos -------------------------------------------------------
GetDeviceInfo("Mouse") ' "keyboard/Mouse"
'Get raw input infos -----------------------------------------------------
'The devices returned from this function are the mouse, the keyboard, and other human interface device (HID) devices.
EditAdd("- Raw info")
EditAdd(LineSeparator)
Dim RawInputDevCount As Long
GetRawInputDeviceList(ByVal Null, @RawInputDevCount, SizeOf(RAWINPUTDEVICELIST)) 'Get hid count
EditAdd("Found " & STR(RawInputDevCount) & " raw input devices in total")
Dim RawInputDevList(0 TO RawInputDevCount - 1) As RAWINPUTDEVICELIST 'Prepare hid array
GetRawInputDeviceList(@RawInputDevList(0), @RawInputDevCount, ByVal SizeOf(RAWINPUTDEVICELIST)) 'Get array of all devices
Dim RawInputDev(0 To RawInputDevCount - 1) As RAWINPUTDEVICE 'Prepare hid register array
Dim MouseCount As Long = 0
Dim index As Long
FOR Index = 0 To RawInputDevCount - 1
Dim wDeviceName As wString * 128
Dim RidDeviceInfoSize As DWord = SizeOf(wDeviceName)
GetRawInputDeviceInfo(RawInputDevList(index).hDevice, RIDI_DEVICENAME, @wDeviceName, @RidDeviceInfoSize) 'Get hid info
Dim DataSize As Long = 0
Dim RidDeviceInfo As RID_DEVICE_INFO
RidDeviceInfoSize = SizeOf(RID_DEVICE_INFO)
Select Case RawInputDevList(index).dwType '0 = mouse, 1 = keyboard, 2 = other.
Case RIM_TYPEMOUSE
EditAdd("Handle " & wChr(9, 9, 9) & "0x" & Hex(RawInputDevList(index).hDevice, 8))
EditAdd("DeviceType " & wChr(9) & _
FieldGet("RIM_TYPEMOUSE,RIM_TYPEKEYBOARD,RIM_TYPEHID", ",", RawInputDevList(index).dwType + 1))
EditAdd("DeviceName " & wChr(9) & wDeviceName)
Dim indexRef As Long
For indexRef = 0 To 1 'Match SetupDi mouse HardId to Raw DeviceName
If Mid(g->HardId(indexRef), 6, 18) = Mid(wDeviceName, 9, 18) Then
g->DeviceName(indexRef) = wDeviceName
g->Handle(indexRef) = RawInputDevList(index).hDevice
End If
Next
GetRawInputDeviceInfo(RawInputDevList(index).hDevice, RIDI_DEVICEINFO, @RidDeviceInfo, @RidDeviceInfoSize)
EditAdd("Mouse id " & wChr(9, 9) & Str(RidDeviceInfo.mouse.dwId))
EditAdd("Mouse button count " & wChr(9) & Str(RidDeviceInfo.mouse.dwNumberOfButtons))
EditAdd("Mouse data points/second " & wChr(9) & Str(RidDeviceInfo.mouse.dwSampleRate))
EditAdd("Mouse has horizontal wheel " & wChr(9) & Str(RidDeviceInfo.mouse.fHasHorizontalWheel))
DataSize = GetRawInputDeviceInfo(RawInputDevList(index).hDevice, RIDI_PREPARSEDDATA, Null, @DataSize)
Dim sData As String = String(DataSize, 0)
DataSize = GetRawInputDeviceInfo(RawInputDevList(index).hDevice, RIDI_PREPARSEDDATA, Null, @DataSize)
EditAdd("Preparsed data byte count " & wChr(9) & Str(DataSize))
RawInputDev(MouseCount).usUsagePage = 1
RawInputDev(MouseCount).usUsage = 2
RawInputDev(MouseCount).dwFlags = RIDEV_EXINPUTSINK 'Always capture
RawInputDev(MouseCount).hwndTarget = hWnd
MouseCount += 1
EditAdd(LineSeparator)
Case RIM_TYPEKEYBOARD
Case RIM_TYPEHID 'Not a keyboard, nor a mouse but joystrick, etc...
End Select
Next
EditAdd(LineSeparator)
EditAdd(" - WM_INPUT")
EditAdd(LineSeparator)
'Registers the devices to get WM_INPUT data.
RegisterRawInputDevices(@RawInputDev(0), MouseCount, SizeOf(RAWINPUTDEVICE)) 'Register hids
Case WM_INPUT
STATIC zRawInput As String * 1024 'Faster than building a String every time
Dim pRawInput As RAWINPUT Pointer
Dim ByteCount As Long
Dim ByteCountF As Long
pRawInput = Cast(RAWINPUT Pointer, @zRawInput)
ByteCount = Len(zRawInput)
ByteCountF = GetRawInputData(Cast(HRAWINPUT, LPARAM), RID_INPUT, pRawInput, @ByteCount, SizeOf(RAWINPUTHEADER))'Get hid input
If GetForegroundWindow <> hWnd THEN
If pRawInput->data.mouse.usButtonFlags THEN
EditAdd("RawInput->Header.hDevice = " & HTab & HTab & HEX(pRawInput->header.hDevice, 8))
Dim index As Long
FOR index = 0 TO 1
If g->Handle(index) = pRawInput->header.hDevice Then
EditAdd("Mouse = " & HTab & HTab & HTab & HTab & Str(index))
End If
NEXT
EditAdd("RawInput->Header.dwType = " & HTab & HTab & _
FieldGet("RIM_TYPEMOUSE,RIM_TYPEKEYBOARD,RIM_TYPEHID", ",", pRawInput->header.dwType + 1))
EditAdd("RawInput->Header.wParam = " & HTab & HTab & HEX(pRawInput->header.wParam, 8)) 'The value passed in the wParam parameter of the WM_INPUT message.
EditAdd("RawInput->data.mouse.usFlags = " & HTab & MouseStateGet(pRawInput->data.mouse.usFlags)) '
EditAdd("RawInput->data.mouse.usButtonFlags = " & HTab & MouseTransitionStateGet(pRawInput->data.mouse.usButtonFlags)) '
EditAdd("RawInput->data.mouse.usButtonData = " & HTab & "0x" & HEX(pRawInput->data.mouse.usButtonData, 4)) '
'EditAdd("RawInput->data.mouse.ulRawButtons = " & HTab & Format(pRawInput->data.mouse.ulRawButtons)) 'Reserved
'EditAdd("RawInput->data.mouse.lLastX = " & HTab & Format(pRawInput->data.mouse.lLastX)) 'The motion in the X direction. This is signed relative motion or absolute motion, depEnding on the value of usFlags.
'EditAdd("RawInput->data.mouse.lLastY = " & HTab & Format(pRawInput->data.mouse.lLastY)) 'The motion in the Y direction. This is signed relative motion or absolute motion, depEnding on the value of usFlags.
'EditAdd("RawInput->data.mouse.ulExtraInfo = " & HTab & "0x" & HEX(pRawInput->data.mouse.ulExtrainformation)) '
Dim CurPos As Point
GetCursorPos(@CurPos)
EditAdd("Cursor: " & HTab & HTab & HTab & HTab & Format(CurPos.x) & " x " & Format(CurPos.x))
Dim As hWnd hFromPoint = WindowFromPointEx(CurPos)
Dim As hWnd hFromPointAncestor = GetAncestor(hFromPoint, GA_ROOT)
EditAdd("WindowFromPointEx = " & HTab & HTab & "0x" & HEX(hFromPoint))
Dim zClassName As wString * MAX_CLASS_NAME_LEN
GetClassName(hFromPoint, zClassName, SizeOf(zClassName))
EditAdd("Control className = " & HTab & HTab & zClassName)
Dim zText As String
Dim As Long TextLen = 1 + SendMessage(hFromPoint, WM_GETTEXTLENGTH, 0, 0)
IF TextLen > 1 Then 'We got something
zText = String(TextLen * 2 + 2, 0)
TextLen = Len(zText)
SendMessageA(hFromPoint, WM_GETTEXT, TextLen, Cast(lParam, StrPtr(zText)))
zText = Trim(Left(zText, 50)) '50 is enough
EditAdd("Control text = " & HTab & HTab & HTab & zText)
Else
EditAdd("Control text = " & HTab & HTab & HTab & "[none]")
End If
If hFromPoint <> hFromPointAncestor Then 'Get main window
EditAdd("Ancestor handle = " & HTab & HTab & HTab & "0x" & Hex(hFromPointAncestor))
GetClassName(hFromPointAncestor, zClassName, SizeOf(zClassName))
EditAdd("Ancestor classname = " & HTab & HTab & zClassName)
TextLen = 1 + SendMessage(hFromPointAncestor, WM_GETTEXTLENGTH, 0, 0)
zText = String(TextLen * 2 + 2, 0)
SendMessageA(hFromPointAncestor, WM_GETTEXT, TextLen, Cast(lParam, StrPtr(zText)))
EditAdd("Ancestor caption = " & HTab & HTab & HTab & zText)
End If
EditAdd(LineSeparator)
End If
End If
DefWindowProc(hWnd, uMsg, wParam, lParam) 'ok
Function = 0 : EXIT Function
Case WM_INPUT_DEVICE_CHANGE 'RIDEV_DEVNOTIfY Sent to the window that registered to receive raw input.
'wParam This parameter can be one of the following values.
' GIDC_ARRIVAL 1 A new device has been added to the system.
' GIDC_REMOVAL 2 A device has been removed from the system.
'lParam The handle to the raw input device. Call GetRawInputDeviceInfo to get more information regarding the device.
Case WM_COMMAND
Dim Code As Word = HiWord(wParam)
Dim ControlId As Word = LoWord(wParam)
Select Case ControlId
Case ButtonTextClear
If Code = BN_CLICKED Or Code = 1 Then
EditClear()
EndIf
Case ButtonExit, IDCANCEL
If Code = BN_CLICKED Or Code = 1 Then
Function = ControlId
PostMessage(hWnd, WM_CLOSE, 0, 0)
Exit Function
EndIf
End Select
Case WM_SIZE
If wParam <> SIZE_MINIMIZED Then
Dim As Long SizeX = LOWORD(LPARAM)
Dim As Long SizeY = HIWORD(LPARAM)
MoveWindow(g->hEdit, 10, 10, SizeX - 20, SizeY - 50, True)
MoveWindow(hButtonTextClear, 10, SizeY - 35, SizeX / 2 - 20, 30, True)
MoveWindow(hButtonExit, SizeX / 2 + 10, SizeY - 35, SizeX / 2 - 20, 30, True)
End If
Case WM_DESTROY
DeleteObject(hFont)
PostQuitMessage(0)
Exit Function
End Select
Function = DefWindowProc(hWnd, uMsg, wParam, lParam)
End Function
'_____________________________________________________________________________
Function WinMain(ByVal hInstance As HINSTANCE, ByVal hPrevInst As HINSTANCE, _
ByVal CmdLine As wString Ptr, ByVal CmdShow As Integer) As UINT
Dim WinClass As WNDCLASS
Dim WindowSize As SIZEL
Dim wsAppName As wString * 128
Dim hWnd As HWND
Dim wMsg As MSG
Dim gVar As GlobalType
g = @gVar
wsAppName = AppName & " - " & SizeOf(UInteger) * 8
WindowSize.cx = 900
WindowSize.cy = 700
WinClass.hIcon = ExtractIcon(hInstance, "%SystemRoot%\system32\shell32.dll", 293)
WinClass.style = CS_HREDRAW Or CS_VREDRAW
WinClass.lpfnWndProc = ProcPtr(WndProc)
WinClass.cbClsExtra = 0
WinClass.cbWndExtra = 0
WinClass.hInstance = hInstance
WinClass.hCursor = LoadCursor(Null, IDC_ARROW)
WinClass.hbrBackground = Cast(HGDIOBJ, COLOR_BTNFACE + 1) 'Default color
WinClass.lpszMenuName = Null
WinClass.lpszClassName = @wsAppName
If (RegisterClass(@WinClass)) Then
hWnd = CreateWindowEx(WS_EX_WINDOWEDGE, _
wsAppName, wsAppName, _
WS_OVERLAPPED Or WS_CLIPCHILDREN Or WS_DLGFRAME Or WS_BORDER Or WS_VISIBLE Or WS_CAPTION Or _
WS_MAXIMIZEBOX Or WS_MINIMIZEBOX Or WS_SIZEBOX Or WS_SYSMENU , _
(GetSystemMetrics(SM_CXSCREEN) - WindowSize.cx) / 2, _ 'PosX
(GetSystemMetrics(SM_CYSCREEN) - WindowSize.cy) / 2, _ 'PosY
WindowSize.cx, WindowSize.cy, _ 'SizeX, SizeY
Null, Null, hInstance, Null)
ShowWindow(hWnd, SW_SHOW)
UpdateWindow(hWnd)
While GetMessage(@wMsg, ByVal Null, 0, 0) > 0
If IsDialogMessage(hWnd, @wMsg) = 0 Then
TranslateMessage(@wMsg)
DispatchMessage(@wMsg)
End If
Wend
End If
DestroyIcon(WinClass.hIcon)
Function = wMsg.message
End Function
'_____________________________________________________________________________
End WinMain(hInstance, Null, Command(), SW_NORMAL) 'Call main() and return the error code to the OS
'_____________________________________________________________________________
'
