When any program or user modifies the system time, the system will use the WM_TIMECHANGE message to all the processes, our program can capture the message, then restore the system time to the status before the modification, so you can run in our program. The correctness of the system time, the code is as follows:
'Form1 (requires a Timer Control, Interval = 1000):
PRIVATE SUB FORM_LOAD () Timer1_timerRegisterWindow me.hwnd 'Set subclavils for the window END SUB
Private Sub Form_Unload (Cancel AS Integer) UnregisterWindow Me.hWnd 'Cancel Window Sub-class End Sub
Private sub timer1_timer () oldtime = nownd Sub
'Module MODLE1:
Option ExplicitPublic Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As LongPublic Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As LongPublic Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As LongPublic 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 LongPublic Declare Function RegisterWindowMessage Lib "user32" Alias "RegisterWindowMessageA" (ByVal lpString As String) As LongPublic oldTime As StringPublic ChangeFlag AS Booleanpublic const WM_TIMECHANGE AS long = & h1E 'When the system time changes, this message is sent to all top window Public OldProc As LongPrivate Type SystemTime Wyear As Integer WMONTH AS INTEGER wDayOfWeek As Integer wDay As Integer wHour As Integer wMinute As Integer wSecond As Integer wMilliseconds As IntegerEnd TypePrivate Declare Function SetLocalTime Lib "kernel32" (lpSystemTime As SYSTEMTIME) As LongPublic Function RegisterWindow (hwnd As Long) As LongIf hwnd <> 0 Then oldproc = SetWindowLong (hwnd, -4, addressof winproc) end ifend functionpublic function unregisterWindow (hwnd as long) As long if hwnd <> 0 THEN SETWINDOWLONG HWND, -4, OldProcend IF
End FunctionPublic Function WinProc (Byval Hwnd As Long, Byval Msg As Long, BYVAL WPARA AS Long) AS Long
DIM I, MyTT
If msg = wm_timechange and changeflag = false the 'system time is modified and is not modified in this program
Changeflag = true 'This program needs to modify the system time
Call settooldtime 'modified system time
EXIT FUNCTION
END IF
Changeflag = false
WinProc = CallWindowProc (Oldproc, HWND, MSG, LPARA, WPARA)
End FunctionPublic Function SetToOldTime () As String 'will return to the state before the time set Dim tmp As Stringtmp = OldTime' system time taken before modification Dim lpSystemTime As SYSTEMTIME lpSystemTime.wYear = Year (tmp) from the stored time 'taken year lpSystemTime.wMonth = month (tmp) 'withdrawn month lpSystemTime.wDayOfWeek = -1 lpSystemTime.wDay = day (tmp)' taken daily lpSystemTime.wHour = hour (tmp) 'withdrawn hours lpSystemTime.wMinute = minute (tmp)' withdrawn min LpsystemTime.WSecond = Second (TMP) 'Remove the second lpsystemtime.wmilliseconds = 0' set the new time setlocaltime lpsystemtime end function
'The procedure is completed, try it.
'My email: ppgg2002@sina.com
'QQ: 55051552
'Msn: mmcgzs@hotmail.com
