Advertisement
Not a member of Pastebin yet?
Sign Up,
it unlocks many cool features!
- Option Explicit
- Type TIME_OF_DAY_INFO
- tod_elapsedt As Long
- tod_msecs As Long
- tod_hours As Long
- tod_mins As Long
- tod_secs As Long
- tod_hunds As Long
- tod_timezone As Long
- tod_tinterval As Long
- tod_day As Long
- tod_month As Long
- tod_year As Long
- tod_weekday As Long
- End Type
- Declare Function NetRemoteTOD Lib "NetApi32" (ByRef UncServerName As Any, ByRef BufferPtr As Any) As Long
- Private LogBuffer As BStr
- '====================================================================
- Public Sub Main()
- asRegisterAppPath
- InitCommonControls
- If Not asIsInIDE Then asSetWindowResIconAll asGetThunderMainHandle(), IDI_APPICON
- Dim Cmd As BStr
- Dim MachineNames() As BStr
- Dim TMP As Variant
- Dim Success As Boolean
- Cmd = asTrimEx(Command)
- Cmd = asDestroyDoubleSpaces(Cmd)
- Cmd = UCase(Cmd)
- If Cmd = "" Then
- ShowUsage
- Exit Sub
- End If
- MachineNames = Split(Cmd, " ")
- Success = False
- For Each TMP In MachineNames
- TMP = asTrimEx2(CStr(TMP), True, True, True, True, True)
- If TMP <> "" Then
- If TryToFixTime(TMP) Then
- Success = True
- Exit For
- End If
- End If
- Next TMP
- If Not Success Then LogEvent "All tries were failed."
- DumpLog Success
- End Sub
- '====================================================================
- Private Sub LogEvent(ByVal Text As BStr)
- Dim Lines() As BStr
- Dim TMP As Variant
- Lines = Split(Text, CRLF)
- For Each TMP In Lines
- TMP = asTrimEx(CStr(TMP))
- If TMP <> "" Then
- LogBuffer = LogBuffer & "[" & asSystemTimeToStringTime2(Now) & "] " & _
- "[" & asSystemTimeToStringDate2(Now, False) & "] " & _
- TMP & CRLF
- End If
- Next TMP
- End Sub
- Private Sub DumpLog(ByVal Success As Boolean)
- If Success Then
- asLogInfo asTrimCRLF(LogBuffer)
- Else
- asLogError asTrimCRLF(LogBuffer)
- End If
- End Sub
- '====================================================================
- Private Function TryToFixTime(ByVal sMachineName As BStr) As Boolean
- Dim TOD As TIME_OF_DAY_INFO
- Dim lpTOD As Long
- Dim MachineName() As Byte
- Dim RC As Long
- Dim ST As SYSTEMTIME
- Dim TXT As BStr
- ' На всякий пожарный...
- TryToFixTime = False
- LogEvent "Trying machine " & sMachineName & "."
- #If SIMULATE_ERROR Then
- LogEvent "Error simulation mode."
- MachineName = StrConv(sMachineName & NUL, vbFromUnicode)
- #Else
- MachineName = sMachineName & NUL
- #End If
- RC = NetRemoteTOD(MachineName(0), lpTOD)
- If RC <> 0 Then
- LogEvent "NetRemoteTOD() failed. " & _
- "Error " & asGetErrorNumber(RC) & ": " & _
- asGetAPIErrorMessage(RC)
- Else
- ' On return a pointer to the return information structure
- ' TIME_OF_DAY_INFO is returned in the address pointed to
- ' by BufferPtr.
- If lpTOD = 0 Then
- LogEvent "NetRemoteTOD() returns NULL pointer."
- Else
- CopyMemory TOD.tod_elapsedt, ByVal lpTOD, Len(TOD)
- GetSystemTime ST
- TXT = "Local date & time: " & ST.wDay & "." & _
- Format(ST.wMonth, "00") & "." & _
- Format(ST.wYear, "0000") & " " & _
- ST.wHour & ":" & _
- Format(ST.wMinute, "00") & ":" & _
- Format(ST.wSecond, "00") & "." & _
- ST.wMilliseconds & CRLF & _
- "Remote date & time: " & TOD.tod_day & "." & _
- Format(TOD.tod_month, "00") & "." & _
- Format(TOD.tod_year, "0000") & " " & _
- TOD.tod_hours & ":" & _
- Format(TOD.tod_mins, "00") & ":" & _
- Format(TOD.tod_secs, "00") & "." & _
- TOD.tod_hunds & CRLF & _
- "Please note both times are in UTC format."
- Debug.Print TXT
- LogEvent TXT
- If Not asSetPrivilegeForProcess(SE_SYSTEMTIME_NAME, True) Then
- LogEvent "Failed to set SE_SYSTEMTIME_NAME privilege."
- End If
- ST.wDay = TOD.tod_day
- ST.wDayOfWeek = 0
- ST.wHour = TOD.tod_hours
- ST.wMilliseconds = TOD.tod_hunds
- ST.wMinute = TOD.tod_mins
- ST.wMonth = TOD.tod_month
- ST.wSecond = TOD.tod_secs
- ST.wYear = TOD.tod_year
- If SetSystemTime(ST) = C_FALSE Then
- LogEvent "SetSystemTime() failed."
- Else
- LogEvent "System time was updated successfully."
- TryToFixTime = True
- End If
- End If
- End If
- End Function
- '====================================================================
- Private Sub ShowUsage()
- MsgBox "Usage: " & App.EXEName & "[.EXE] HostName [HostName [HostName [...]]]", vbInformation
- End Sub
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement