clsPresenceMon

clspresencemon

Kelas mandiri dan berulir untuk memantau kehadiran pengguna dalam beberapa cara

Ini adalah kelas sederhana yang memantau untuk 3 acara: status monitor (OFF, ON, atau redup), pesan 'Pengguna' sistem ', dan, jika Anda menggunakan laptop, status tutupnya (terbuka, tutup). Ia melakukan ini di kelas yang sepenuhnya mandiri- komplikasi dengan ini muncul karena peristiwa ini dikirim dalam bentuk pesan WM_POWERBROADCAST , berequring jendela untuk menerimanya. Tapi saya tidak ingin membatasi kelas untuk aplikasi grafis dan hanya subkelas formulir hwnd, meskipun demi kelengkapan aplikasi demo menunjukkan cara melakukannya juga. Jadi kelas membuat jendela tersembunyi yang sepenuhnya khusus, di utas terpisah untuk menghindari loop pesan yang memblokir loop pesan formulir jika ada.

Menyiapkan segalanya

Kelas mengambil keuntungan dari konstruktor Twinbasic yang diparameterisasi untuk menentukan argumen yang tersedia tepat di kata kunci baru; Di sini itu argumen opsional untuk acara mana yang harus ditingkatkan dan Hinstance untuk mendaftar di bawah ( App.hInstance 99% dari waktu; jika Anda menghilangkannya, itu akan menggunakan GetModuleHandleW() , yang mengembalikan nilai yang sama dengan App.hInstance tanpa membuat ketergantungan pada WinnativeForms). Kemudian kita sampai ke salah satu kesenangan besar TB: Memanggil CreateThread tanpa peretasan rumit yang diperlukan, sekeren mereka di VB6. ThreadProc sendiri hanya memanggil kode lainnya.

    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 dan CreateWindowEx digunakan hanya dalam rutinitas normal untuk membuat jendela tersembunyi, dengan WNDPROC menjadi fungsi di dalam kelas berkat AddressOf pendukung TB di sini. Bagian penting terakhir dari pengaturan adalah bahwa kami harus mendaftar untuk acara yang kami inginkan; Mereka semua dikirim sebagai pesan PBT_POWERSETTINGCHANGE . Kita perlu menangani masing -masing sebagai variabel kelas, tetapi pendaftaran langsung; Tbshelllib menyediakan API dan Guids:

    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

Menerima pesan

Seperti yang telah disebutkan, mereka dikirim oleh UMSG WM_POWERBROADCAST dengan WPARAM PBT_POWERSETTINGCHANGE ; Kami tahu dari MSDN LPARAM kemudian menunjuk ke POWERBROADCAST_SETTING udt. Tapi kami mengalami masalah:

 typedef struct {
  GUID  PowerSetting;
  DWORD DataLength;
  UCHAR Data[1];
} POWERBROADCAST_SETTING, *PPOWERBROADCAST_SETTING;

Itu array bergaya-C, bukan SAFEARRAY ; Data segera mengikuti dalam memori, di mana array panjang variabel dalam TB (saat ini) hanya dapat menjadi SAFEARRAY dengan struktur yang sama sekali berbeda. Solusi yang digunakan Tbshelllib agak kikuk;

 [ 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

Idenya adalah untuk menyalin bagian tetap, kemudian menggunakan panjang untuk redim bagian variabel, dan lakukan salinan terpisah ke varptr (data (0)). Kelas ini mengambil jalan pintas; Karena kami hanya bekerja dengan DWORD 4-byte tunggal untuk properti yang kami minati, sepertinya ini:

            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()

Kami menyalin bagian tetap sehingga kami dapat memeriksa panduan untuk acara mana kali ini, tetapi kemudian hanya menyalin 4 byte mulai dari offset Data (Guid adalah 16 byte, ditambah panjang 4 byte, = 20) langsung ke variabel yang mewakili enum nilai yang mungkin. Semuanya selain baris terakhir disediakan oleh tbshelllib, termasuk PointerAdd generik, yang dengan aman melakukan tambahan yang tidak ditandatangani. Kemudian kami hanya memeriksa apakah penelepon menginginkan acara tersebut, dan menaikkannya. Anehnya, memanggil Raungan Raungan dari luar utas seperti ini bekerja tanpa penanganan khusus dan belum jatuh, dan saya telah meninggalkan kelas berjalan selama 6+ jam peregangan dengan banyak acara yang diangkat.

Catatan

Anda akan menerima status saat ini saat Anda pertama kali mendaftar untuk acara. Jadi itu akan mengirim 'monitor' meskipun monitor tidak hanya dihidupkan.

Membersihkan

Kelas menyediakan metode Destroy() untuk mematikan pemantauan dan menyingkirkan jendela tersembunyi. Diperlukan Anda memanggil ini sebelum mencoba mengaturnya menjadi Nothing jika aplikasi Anda berencana untuk terus berjalan (jika keluar Anda dapat membiarkan sistem menghancurkan segalanya). Utas ada di loop pesannya, jadi tidak akan keluar untuk menggunakan loop pesan keluar, jadi untuk melakukan itu, jendela perlu dihancurkan. Anda tidak dapat menghubungi DestroyWindow di jendela di utas yang berbeda, jadi apa yang Anda lakukan adalah mengirim WM_CLOSE dengan PostMessage , dan jendela menghancurkan dirinya sendiri, dan tidak mendaftar peristiwa:

            Case WM_CLOSE
                DestroyWindow m_hWnd
            
            Case WM_DESTROY
                UnregisterEvents
                PostQuitMessage 0

Selain itu kami memberikan utas beberapa detik untuk dimatikan, lalu lepaskan kelas jendela khusus kami. Setelah itu, semuanya dibersihkan dan kelas itu sendiri siap untuk dihancurkan.

    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

---

Dan hanya itu yang ada di sana! Semuanya sangat mudah, tetapi layak ditulis karena banyak hal baru untuk keseluruhan hal 'multithreading'.