Code: (Select All)
' some code to attempt to change the system date.
' returns error:
' a required privilege is not held by the client.
DefLng A-Z
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
Declare Dynamic Library "kernel32"
Function GetLocalTime& (lpSystemTime As SYSTEMTIME)
Function SetLocalTime& (lpSystemTime As SYSTEMTIME)
Function GetSystemTime& (lpSystemTime As SYSTEMTIME)
Function SetSystemTime& (lpSystemTime As SYSTEMTIME)
Function GetLastError& ()
Function FormatMessageA& (ByVal f As Long, f$, Byval e As Long, Byval d As Long, g$, Byval s As Long, h$)
End Declare
Dim Shared SysTime As SYSTEMTIME
Dim Shared ErrorBuffer As String * 260
Print "Current date: "; Date$
Print "Enter date(mm-dd-yyyy)";
Input z$
z$ = LTrim$(RTrim$(z$))
If Len(z$) Then
z = ValidDate(z$)
If z Then
' mm-dd-yyyy
x = GetLocalTime(SysTime)
SysTime.wMonth = Int(Val(Left$(z$, 2)))
SysTime.wDay = Int(Val(Mid$(z$, 4, 2)))
SysTime.wYear = Int(Val(Right$(z$, 4)))
x = SetLocalTime(SysTime)
If x = 0 Then
Print "Error Date reset: "; z$
Print DisplayWinError$(x)
Else
Print "Date reset to: "; z$
End If
Else
Print "Invalid date."
End If
End If
End
Function ValidDate (Var$)
' mm-dd-yyyy
Var$ = RTrim$(Var$)
If Len(Var$) <> 10 Then
ValidDate = False
Exit Function
End If
For Var = 1 To 10
V$ = Mid$(Var$, Var, 1)
Select Case Var
Case 1, 2, 4, 5, 7, 8, 9, 10
If V$ >= "0" And V$ <= "9" Then
Eat$ = ""
Else
ValidDate = False
Exit Function
End If
Case Else
If V$ <> "-" Then
ValidDate = False
Exit Function
End If
End Select
Next
M = Int(Val(Mid$(Var$, 1, 2)))
D = Int(Val(Mid$(Var$, 4, 2)))
Y = Int(Val(Mid$(Var$, 7, 4)))
If M >= 1 And M <= 12 Then
If D >= 1 And D <= 31 Then
If Y >= 1980 And Y <= 2079 Then
L = 0
If Y / 4 = Y \ 4 Then
L = -1
End If
If Y / 100 = Y \ 100 Then
L = 0
End If
If Y / 400 = Y \ 400 Then
L = -1
End If
Select Case M
Case 1, 3, 5, 7, 8, 10, 12
If D <= 31 Then
ValidDate = -1
Exit Function
End If
Case 4, 6, 9, 11
If D <= 30 Then
ValidDate = -1
Exit Function
End If
Case 2
If L Then
If D <= 29 Then
ValidDate = -1
Exit Function
End If
End If
If D <= 28 Then
ValidDate = -1
Exit Function
End If
End Select
End If
End If
End If
ValidDate = 0
End Function
' display windows error message
Function DisplayWinError$ (x)
' define error message value
v& = GetLastError
' call windows error message routine
x& = FormatMessageA&(&H1200, "", v&, 0, ErrorBuffer$, 260, "")
If x& Then
DisplayWinError$ = Left$(ErrorBuffer$, x& - 2)
Else
DisplayWinError$ = "Unknown error 0x" + Hex$(v&) + "."
End If
x = -1
End FunctionCompile, Run as Admin. Lasts X seconds until system sync occurs on the net. Unplug your internet connection when trying it, I guess.