ChgCompTimeDate

Option Explicit

Private 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 Integer
End Type

Private Declare Function SetSystemTime Lib "kernel32" _
(lpSystemTime As SYSTEMTIME) As Long
Private Const WM_TIMECHANGE = &H1E

Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" _
(ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, _
lParam As Any) As Long

Private Const HWND_TOPMOST = -1

Private Sub Command1_Click()
Dim dwret As Long
Dim st As SYSTEMTIME

With st
.wYear = 1999
.wMonth = 9
.wDay = 1
.wHour = 16
.wMinute = 0
.wSecond = 0
.wMilliseconds = 0
End With

dwret = SetSystemTime(st)
If dwret = 1 Then
'

' This updates the Windows displaying the system time

'

Call SendMessage(HWND_TOPMOST, WM_TIMECHANGE, 0, 0)
End If
End Sub