clsPresenceMon
1.0.0
Una clase autónoma y roscada para monitorear la presencia del usuario de varias maneras
Esta es una clase simple que monitorea para 3 eventos: el estado del monitor (apagado, encendido o atenuado), el mensaje 'presente' del usuario 'del sistema y, si está en una computadora portátil, el estado de la tapa (abierto, cierre). Hace esto en una clase completamente autónoma: surge la complicación con esto porque estos eventos se envían en forma de un mensaje WM_POWERBROADCAST , que requería una ventana para recibirlo. Pero no quería limitar la clase a aplicaciones gráficas y simplemente subclase un formulario HWND, aunque en aras de la integridad, la aplicación de demostración muestra cómo hacerlo también. Entonces, la clase crea su propia ventana oculta completamente personalizada, en un hilo separado para evitar el bucle de mensaje bloqueando el bucle de mensaje del formulario si está presente.
La clase aprovecha los constructores parametrizados de Twinbasic para especificar el derecho de los argumentos disponibles en la nueva palabra clave; Aquí son argumentos opcionales para qué eventos recaudar y la hinstancia para registrarse en ( App.hInstance el 99% del tiempo; si lo omite, usará GetModuleHandleW() , que devuelve el mismo valor que App.hInstance sin crear una dependencia de WinnativeForms). Luego llegamos a uno de los grandes placeres de TB: llamar CreateThread sin ningún hacks elaborados necesarios, tan geniales como en VB6. Threadproc en sí simplemente llama al resto del código.
Sub New(Optional ByVal dwNotifyMask As CPMonEventNotify = CPMEN_ALL, Optional ByVal hInst As LongPtr)
m_hInst = If(hInst = 0, GetModuleHandleW(), hInst)
If dwNotifyMask = CPMEN_ERROR Then Exit Sub
m_Mask = dwNotifyMask
tConfig.hInst = m_hInst
tConfig.Mask = m_Mask
m_hThread = CreateThread(ByVal 0, 0, AddressOf CPMonProc, tConfig, 0, m_idThread)
End Sub
RegisterClassEx y CreateWindowEx se usan en una rutina normal para crear una ventana oculta, con el WNDPROC una función dentro de la clase gracias a AddressOf de apoyo de TB aquí. La última parte importante de la configuración es que tenemos que registrarnos para los eventos que queremos; Todos están entregados como mensajes PBT_POWERSETTINGCHANGE . Necesitamos mantener un mango para cada uno como una variable de clase, pero el registro es sencillo; TBShellLib proporciona la API y GUID:
Private Function RegisterEvents() As Boolean
m_hEventM = RegisterPowerSettingNotification(m_hWnd, GUID_SESSION_DISPLAY_STATUS, DEVICE_NOTIFY_WINDOW_HANDLE)
m_hEventP = RegisterPowerSettingNotification(m_hWnd, GUID_SESSION_USER_PRESENCE, DEVICE_NOTIFY_WINDOW_HANDLE)
m_hEventL = RegisterPowerSettingNotification(m_hWnd, GUID_LIDSWITCH_STATE_CHANGE, DEVICE_NOTIFY_WINDOW_HANDLE)
If m_hEventM Then Return True
End Function
Como ya se mencionó, son entregados por UMSG WM_POWERBROADCAST con WPARAM PBT_POWERSETTINGCHANGE ; Sabemos por MSDN el LPARAM y luego apunta a un POWERBROADCAST_SETTING UDT. Pero nos encontramos con un problema:
typedef struct {
GUID PowerSetting;
DWORD DataLength;
UCHAR Data[1];
} POWERBROADCAST_SETTING, *PPOWERBROADCAST_SETTING;
Esa es una matriz de estilo C, no un SAFEARRAY ; Los datos se siguen inmediatamente en la memoria, donde las matrices de longitud variable en TB (actualmente) solo pueden ser una SAFEARRAY con una estructura completamente diferente. La solución que usa Tbshelllib es un poco torpe;
[ Description ("WARNING: You can't use this directly due to the SAFEARRAY. To receive, fill the first 20 bytes, then the data in the array. To send, create a byte buffer excluding the safearray member.") ]
Public Type POWERBROADCAST_SETTING
PowerSetting As UUID
DataLength As Long
Data() As Byte
End Type
La idea es copiar la parte fija, luego usar la longitud para redimir la parte variable y hacer una copia separada en VARPTR (datos (0)). Sin embargo, esta clase toma un atajo; Dado que solo estamos trabajando con un solo DWORD de 4 bytes para las propiedades que nos interesan, parece esto:
Case WM_POWERBROADCAST
If wParam = PBT_POWERSETTINGCHANGE Then
Dim pSetting As POWERBROADCAST_SETTING
CopyMemory pSetting, ByVal lParam, 20
If IsEqualGUID(pSetting.PowerSetting, GUID_SESSION_DISPLAY_STATUS) Then
Dim pState As MONITOR_DISPLAY_STATE
CopyMemory pState, ByVal PointerAdd(lParam, 20), 4
Select Case pState
Case PowerMonitorOff
If (m_Mask And CPMEN_MONITOROFF) Then RaiseEvent MonitorOff()
Copiamos la parte fija para que podamos verificar el GUID para el evento que es esta vez, pero solo copiar 4 bytes a partir de la compensación de Data (un GUID es 16 bytes, más los 4 bytes de largo, = 20) directamente a una variable que representa el enum de los posibles valores. Tbshelllib proporciona todo además de la última línea, incluido el genérico PointerAdd , que realiza una adición sin firmar de manera segura. Luego, simplemente verificamos si la persona que llama quiere el evento y lo recaudamos. Sorprendentemente, llamar a Raiseevent desde fuera del hilo como este funcionó sin manejo especial y aún no se ha estrellado, y he dejado la clase funcionando durante más de 6 horas, con muchos eventos planteados.
Nota
Recibirá el estado actual cuando se registre por primera vez para eventos. Por lo tanto, enviará 'monitor en' a pesar de que el monitor no solo se ha activado.
La clase proporciona un método Destroy() para apagar el monitoreo y deshacerse de la ventana oculta. Se requiere que llame a esto antes de intentar establecerlo en Nothing si su aplicación planea seguir funcionando (si sale, puede dejar que el sistema destruya todo). El hilo está en su bucle de mensajes, por lo que no saldrá a utilizar el bucle de mensaje, por lo que para hacerlo, la ventana debe ser destruida. No puede llamar DestroyWindow en la ventana en un hilo diferente, así que lo que hace es enviar WM_CLOSE con PostMessage , y la ventana se destruye a sí misma y no registra los eventos:
Case WM_CLOSE
DestroyWindow m_hWnd
Case WM_DESTROY
UnregisterEvents
PostQuitMessage 0
Además de eso, le damos el hilo unos segundos para apagar, luego no registrar nuestra clase de ventana personalizada. Después de eso, todo se limpia y la clase en sí está lista para ser destruida.
Public Sub Destroy()
If m_hWnd Then PostMessageW(m_hWnd, WM_CLOSE, 0, ByVal 0)
Dim lRet As WaitForObjOutcomes = WaitForSingleObject(m_hThread, 5000)
Debug.Print "Wait outcome=" & lRet
Dim hr As Long = UnregisterClassW(StrPtr(wndClass), m_hInst)
Debug.Print "Unregister hr=" & hr & ", lastErr=" & Err.LastDllError
End Sub
¡Y eso es todo lo que hay! Todo es bastante sencillo, pero vale la pena escribir, ya que muchos son nuevos en todo el asunto de 'fácil de leer múltiples'.
