Binaryworld - How to run system clock slower/faster ? ... [ VB -> System ]

In this article we will have lots of fun with system clock. I will explain you how to retrive and change your system clock setting to make your system clock slower/faster using SetSystemTimeAdjustment and GetSystemTimeAdjustment APIs. You will also learn how to assign special privilege to an application to perform specific task.

Let's start with GetSystemTimeAdjustment function.

The GetSystemTimeAdjustment function determines whether the system is applying periodic time adjustments to its time-of-day clock at each clock interrupt, along with the value and period of any such adjustments. Note that the period of such adjustments is equivalent to the time period between clock interrupts.

Click here to copy the following block

Private Declare Function GetSystemTimeAdjustment Lib "kernel32" ( _
    lpTimeAdjustment As Long, _
    lpTimeIncrement As Long, _
    lpTimeAdjustmentDisabled As Long) As Long

lpTimeAdjustment : Indicates system's current periodic time adjustment which is number of 100-nanosecond units added to the time-of-day clock at each clock interrupt
lpTimeIncrement : Indicates system's current interrupt frequency (number of 100-nanosecond units). This value tells you how often your system receive interrupt. You should set lpTimeAdjustment to lpTimeIncrement for 100% accurate system clock.
lpTimeAdjustmentDisabled : Indicates whether periodic time adjustment is in effect.

Now what if you want to set your system clock time adjustment value ????

The SetSystemTimeAdjustment function enables or disables periodic time adjustments to the system's time-of-day clock. Such time adjustments are used to synchronize the time of day with some other source of time information. When periodic time adjustments are enabled, they are applied at each clock interrupt.

Click here to copy the following block

Private Declare Function SetSystemTimeAdjustment Lib "kernel32.dll" ( _
ByVal dwTimeAdjustment As Long, _
ByVal bTimeAdjustmentDisabled As Boolean) As Long

dwTimeAdjustment : Number of 100-nanosecond units added to the time-of-day clock at each clock interrupt if periodic time adjustment is enabled.
bTimeAdjustmentDisabled : Time adjustment mode that the system is to use. Periodic system time adjustments can be disabled or enabled.

Note : An application must have system-time privilege (the SE_SYSTEMTIME_NAME privilege) for this function to succeed. The SE_SYSTEMTIME_NAME privilege is disabled by default. Use the AdjustTokenPrivileges function to enable the privilege before calling SetSystemTimeAdjustment, and then to disable the privilege after the SetSystemTimeAdjustment call.

Step-By-Step Example

- Create a standard exe project
- Add four textbox controls (Set Multiline=True and Scrollbar=Verticle for Text1) on the form1
- Add one checkbox and one timer control on the form1
- Add the following code in form1

Click here to copy the following block

Option Explicit

'/////////////////////////////////////////////////////////
'//API declaration to set Privilege
'/////////////////////////////////////////////////////////
Private Const SE_PRIVILEGE_ENABLED = &H2
Private Const SE_SYSTEMTIME_NAME = "SeSystemtimePrivilege"
Private Const TOKEN_ADJUST_PRIVILEGES = &H20
Private Const TOKEN_QUERY = &H8

Private Type LARGE_INTEGER
  LowPart As Long
  HighPart As Long
End Type

Private Type LUID
  LowPart As Long
  HighPart As Long
End Type

Private Type LUID_AND_ATTRIBUTES
  pLuid As LUID
  Attributes As Long
End Type

Private Type TOKEN_PRIVILEGES
  PrivilegeCount As Long
  Privileges(1) As LUID_AND_ATTRIBUTES
End Type

Private Declare Function AdjustTokenPrivileges Lib "advapi32.dll" ( _
    ByVal TokenHandle As Long, _
    ByVal DisableAllPrivileges As Long, _
    ByRef NewState As TOKEN_PRIVILEGES, _
    ByVal BufferLength As Long, _
    ByRef PreviousState As TOKEN_PRIVILEGES, _
    ByRef ReturnLength As Long) As Long

Private Declare Function LookupPrivilegeValue Lib "advapi32.dll" Alias "LookupPrivilegeValueA" ( _
    ByVal lpSystemName As String, _
    ByVal lpName As String, _
    ByRef lpLuid As LUID) As Long

Private Declare Function OpenProcessToken Lib "advapi32.dll" ( _
    ByVal ProcessHandle As Long, _
    ByVal DesiredAccess As Long, _
    ByRef TokenHandle As Long) As Long

Private Declare Function GetCurrentProcess Lib "kernel32.dll" () As Long

'/////////////////////////////////////////////////////////
'//API declaration for system time
'/////////////////////////////////////////////////////////
Private Const LOCALE_SYSTEM_DEFAULT& = &H800
Private Const LOCALE_USER_DEFAULT& = &H400

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 Type TIME_ZONE_INFORMATION
  Bias As Long
  StandardName As String * 64
  StandardDate As SYSTEMTIME
  StandardBias As Long
  DaylightName As String * 64
  DaylightDate As SYSTEMTIME
  DaylightBias As Long
End Type

Private Declare Function GetSystemTime Lib "kernel32" ( _
    lpSystemTime As SYSTEMTIME) As Long

Private Declare Function GetLocalTime Lib "kernel32" ( _
    lpSystemTime As SYSTEMTIME) As Long

Private Declare Function GetSystemTimeAdjustment Lib "kernel32" ( _
    lpTimeAdjustment As Long, _
    lpTimeIncrement As Long, _
    lpTimeAdjustmentDisabled As Long) As Long

Private Declare Function GetTimeZoneInformation Lib "kernel32" ( _
    lpTimeZoneInformation As TIME_ZONE_INFORMATION) As Long

Private Declare Function SetSystemTimeAdjustment Lib "kernel32.dll" ( _
    ByVal dwTimeAdjustment As Long, _
    ByVal bTimeAdjustmentDisabled As Boolean) As Long

Private Declare Function GetTimeFormat Lib "kernel32" Alias "GetTimeFormatA" ( _
    ByVal Locale As Long, _
    ByVal dwFlags As Long, _
    lpTime As SYSTEMTIME, _
    ByVal lpFormat As Long, _
    ByVal lpTimeStr As String, _
    ByVal cchTime As Long) As Long

Private Sub Check1_Click()
  Dim ret
  '//SetSystemTimeAdjustment requires SE_SYSTEMTIME_NAME Privilege to be granted for calling application

  If SetPrivilege(SE_SYSTEMTIME_NAME, True) Then
    '//Number of 100-nanosecond units added to the time-of-day clock at each clock interrupt
    Dim TimeAdjustment As Currency
    If Check1.Value = 1 Then
      TimeAdjustment = MiliToNeno(CDbl(Text4) / 100)
      ret = SetSystemTimeAdjustment(TimeAdjustment, True)
    Else
      TimeAdjustment = MiliToNeno(CDbl(Text4) / 100)
      ret = SetSystemTimeAdjustment(TimeAdjustment, False)
      If Err.LastDllError = 1314 Then
        MsgBox "Application does not have enough Privilege to change the AdjustTime setting"
      End If
    End If
  Else
    MsgBox "Failed to set SE_SYSTEMTIME_NAME Privilege for current application"
  End If
End Sub

Function MiliToNeno(v) As Long
  'Second << Mili << Micro << Neno
  MiliToNeno = v * 1000000
End Function
Function NenoToMili(v) As Currency
  'Second << Mili << Micro << Neno
  NenoToMili = v / (1000000)
End Function

Public Function SetPrivilege(ByVal strPrivilege As String, _
               ByVal booEnable As Boolean) As Boolean
  Dim lngRet As Long
  Dim hToken As Long
  Dim tLUID As LUID
  Dim tTP As TOKEN_PRIVILEGES
  Dim tTP_Prev As TOKEN_PRIVILEGES
  Dim lngReturnLength As Long

  SetPrivilege = False

  If Not CBool(OpenProcessToken(GetCurrentProcess(), _
      TOKEN_ADJUST_PRIVILEGES Or _
      TOKEN_QUERY, _
      hToken)) Then
    Exit Function
  End If

  If LookupPrivilegeValue("", strPrivilege, tLUID) = 0 Then Exit Function

  With tTP
    .PrivilegeCount = 1
    .Privileges(0).pLuid = tLUID
    If booEnable Then
      .Privileges(0).Attributes = SE_PRIVILEGE_ENABLED
    Else
      .Privileges(0).Attributes = 0
    End If
  End With

  Call AdjustTokenPrivileges(hToken, _
      False, _
      tTP, _
      Len(tTP_Prev), _
      tTP_Prev, _
      lngReturnLength)

  If Err.LastDllError = 0 Then SetPrivilege = True
End Function

Private Sub Form_Load()
  Call LoadInfo

  Timer1.Enabled = True
  Timer1.Interval = 100
End Sub

Sub LoadInfo()
  Dim myTZ As TIME_ZONE_INFORMATION
  Dim myAdj As Long, myIncr As Long, myDisabled As Long
  Dim strMsg As String, dl As Long, s As String

  Dim ClockInterruptTime As Double, ClockAdjTime As Double
  Dim strClockIntRate As String
  Text1 = ""

  GetSystemTimeAdjustment myAdj, myIncr, myDisabled

  '//
  ClockInterruptTime = NenoToMili(myIncr * 100)
  strClockIntRate = CStr(Format(ClockInterruptTime, "##.##0"))

  ClockAdjTime = NenoToMili(myAdj * 100)
  Text4 = Format(ClockAdjTime, "##.##0")

  If myDisabled = 0 Then
    strMsg = strMsg & "InterruptRate: " & strClockIntRate & " ms (i.e. one interrupt every " & strClockIntRate & " ms)" & vbCrLf
    strMsg = strMsg & "AutoAdjust : Periodic time adjustment is disabled" & vbCrLf
    Check1.Value = 0
  Else
    strMsg = strMsg & "InterruptRate: " & strClockIntRate & " ms (i.e. one interrupt every " & strClockIntRate & " ms)" & vbCrLf
    strMsg = strMsg & "AutoAdjust : " & "Every " & strClockIntRate & " ms, computer adds " & Text4 & " ms to your time-of-day clock." & vbCrLf
    Check1.Value = 1
  End If

  dl = GetTimeZoneInformation(myTZ)

  strMsg = strMsg & "Bias     : " & CInt(myTZ.Bias / 60) & " hours (This is UTC and Local Time difference)" & vbCrLf
  strMsg = strMsg & "StandardName : " & Replace(StrConv(myTZ.StandardName, vbFromUnicode), vbNullChar, "") & vbCrLf
  strMsg = strMsg & "DaylightName : " & Replace(StrConv(myTZ.DaylightName, vbFromUnicode), vbNullChar, "") & vbCrLf
  strMsg = strMsg & "DaylightBias : " & myTZ.DaylightBias & vbCrLf

  Text1.Text = strMsg
  If ClockInterruptTime < ClockAdjTime Then
    Me.Caption = "Your System Clock is running " & (ClockInterruptTime / ClockAdjTime) * 100 & "% faster"
  ElseIf ClockInterruptTime > ClockAdjTime Then
    Me.Caption = "Your System Clock is running " & (ClockAdjTime / ClockInterruptTime) * 100 & "% slower"
  Else
    Me.Caption = "Your System Clock is OK [ every " & ClockInterruptTime & " ms system is adding " & ClockAdjTime & " ms ]"
  End If
End Sub

'//Obtain the system and local time and display them
Private Sub Timer1_Timer()
  Dim myTime As SYSTEMTIME, s As String, dl As Long

  GetLocalTime myTime

  s = String$(255, Chr$(0))
  dl = GetTimeFormat&(LOCALE_SYSTEM_DEFAULT, 0, myTime, 0, s, 254)
  Text2 = s

  GetSystemTime myTime

  s = String$(255, Chr$(0))
  dl = GetTimeFormat&(LOCALE_SYSTEM_DEFAULT, 0, myTime, 0, s, 254)
  Text3 = s
End Sub