Memonitor Perubahan Waktu System

Source ini berfungsi untuk memonitoring perubahan waktu/tanggal pada system. Dimana fungsi tersebut dapat memberitahu kita apabila tanggal system dirubah.

Selain itu cara ini biasanya digunakan oleh program-program yang bersifat trial, untuk menjaga lamanya penggunaan sebuah program yang dibatasi oleh waktu.

Ada banyak cara untuk memonitoring waktu system, tapi kali ini saya akan mencoba memberikan sedikit pengetahuan.

Fungsi yang digunakan kali ini ialah:

- SetWindowLong
- CallWindowProc
- Serta WM_TIMECHANGE untuk mendapatkan perubahaan waktu system.


Ok, langsung aja.. berikut kodingnya..:

1. Buatlah sebuah module yang isinya :

Option Explicit

Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" _
(ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong _
As Long) As Long
Private Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" _
(ByVal lpPrevWndFunc As Long, ByVal hwnd As Long, ByVal Msg As _
Long, ByVal wParam As Long, ByVal lParam As Long) As Long

Const WM_TIMECHANGE = &H1E
Const GWL_WNDPROC = (-4)
Dim PrevProc As Long

Public Sub HookForm(Frm As Form)
PrevProc = SetWindowLong(Frm.hwnd, GWL_WNDPROC, AddressOf WindowProc)
End Sub

Public Sub UnHookForm(Frm As Form)
SetWindowLong Frm.hwnd, GWL_WNDPROC, PrevProc
End Sub
Private Function WindowProc(ByVal hwnd As Long, ByVal uMsg As Long, _
ByVal wParam As Long, ByVal lParam As Long) As Long
WindowProc = CallWindowProc(PrevProc, hwnd, uMsg, wParam, lParam)
If uMsg = WM_TIMECHANGE Then
MsgBox "Tanggal/Waktu System Berubah"
End If
End Function
Blog Advertising



Fungsi yang ditulis diatas adalah procedure untuk melihat perintah rutinitas yang dijalankan pada sebuah form. dimana jika perubahan yang terjadi pada uMsg sama dengan nilai WM_TIMECHANGE maka ini artinya waktu pd system berubah.

Untuk penggunaan fungsi tersebut tidaklah terlalu sulit, yang diperlukan adalah sebuah form, yang berisi code berikut ini:


Private Sub Form_Load()
HookForm Me 'Mulai monitoring pada form aktif
End Sub

Private Sub Form_Unload(Cancel As Integer)
UnHookForm Me 'Berhenti Monitoring proses
End Sub

No comments:

Post a Comment