::让 Windows 将 BIOS 硬件时间视为协调世界时( UTC ): 解决和 Win Mac 双系统 时间不同步的问题
reg add "HKLM\SYSTEM\CurrentControlSet\Control\TimeZoneInformation" /v "RealTimeIsUniversal" /t REG_DWORD /d 1 /f
我用的是这一条没啥问题啊,改完以后重新用 vbs 同步下时间
'VBS 校准系统时间 BY Yu2n 2019.05.26
http://www.bathome.net/viewthread.php?tid=60369Option Explicit
RunAsAdminX64
Main
'************************************************************************
Sub Main()
'************************************************************************
Dim dtNet, dtLocal1, dtLocal2, lngOffset1, lngOffset2, strMessage
dtNet = GetNetTime("
http://www.microsoft.com")
dtLocal1 = Now()
lngOffset1 = Abs(DateDiff("s", dtNet, dtLocal1))
If lngOffset1 > 1 Then
SetDateTime dtNet
dtLocal2 = Now()
lngOffset2 = Abs(DateDiff("s", dtNet, dtLocal2))
strMessage = " [校准前] " & vbCrLf _
& "标准北京时间为:" & vbTab & dtNet & vbCrLf _
& "本机系统时间为:" & vbTab & dtLocal1 & vbCrLf _
& "与标准时间相差:" & vbTab & lngOffset1 & "秒" & vbCrLf & vbCrLf _
& " [校准后] " & vbCrLf _
& "标准北京时间为:" & vbTab & dtNet & vbCrLf _
& "本机系统时间为:" & vbTab & dtLocal2 & vbCrLf _
& "与标准时间相差:" & vbTab & lngOffset2 & "秒"
Else
strMessage = " [无需校准] " & vbCrLf _
& "标准北京时间为:" & vbTab & dtNet & vbCrLf _
& "本机系统时间为:" & vbTab & dtLocal1 & vbCrLf _
& "与标准时间相差:" & vbTab & lngOffset1 & "秒"
End If
WScript.Echo strMessage
End Sub
'************************************************************************
'获取网络上指定的 HTTP 服务器时间
'************************************************************************
Function GetNetTime(ByVal Url)
Dim Bias, DateLine '时间偏移(分钟)
Dim dtGMT, dtLocal, dtBegin
On Error Resume Next
With CreateObject("WScript.Shell")
'[ActiveTimeBias]:该键值存储当前系统时间相对格林尼治标准时间的偏移(以分钟为单位)
'[Bias]:该键值存储当前本地时间相对格林尼治标准时间的偏移(以分钟为单位)
Bias = .RegRead("HKLM\SYSTEM\CurrentControlSet\Control\TimeZoneInformation\ActiveTimeBias")
End With
With CreateObject("Microsoft.XMLHTTP")
dtBegin = Now()
.Open "POST", Url, False
.Send
If Err.Number = 0 Then
dtGMT = Split(Replace(.getResponseHeader("Date"), " GMT", ""), ",")(1)
If IsDate(dtGMT) Then
dtLocal = DateAdd("n", -CLng(Bias), CDate(dtGMT)) '北京时间:GMT+8
dtLocal = DateAdd("s", DateDiff("s", dtBegin, Now()), dtLocal) '时间损耗
GetNetTime = dtLocal
End If
End If
End With
End Function
'************************************************************************
'设定电脑的时间
'************************************************************************
Function SetDateTime(ByVal dt1)
Dim WmiService, ComputerName, OSList, OSEnum, OS, DateTime
ComputerName = "."
Set WmiService = GetObject("winmgmts:{impersonationLevel=impersonate, (Systemtime)}!//" + ComputerName + "/root/cimv2")
Set OSList = WmiService.InstancesOf ("Win32_OperatingSystem")
Set DateTime = CreateObject("WbemScripting.SWbemDateTime")
For Each OSEnum In OSList
DateTime.Value = OSEnum.LocalDateTime
DateTime.Year = Year(dt1)
DateTime.Month = Month(dt1)
DateTime.Day = Day(dt1)
DateTime.Hours = Hour(dt1)
DateTime.Minutes = Minute(dt1)
DateTime.Seconds = Second(dt1)
If (OSEnum.SetDateTime(DateTime.Value) <> 0) Then
'WScript.Echo "警告:设置系统时间失败!"
SetDateTime = False
Else
'WScript.Echo "提示:设置成功。当前时间:" & DateTime.GetVarDate()
SetDateTime = True
End If
Next
End Function
'************************************************************************
'初始化 RunAsAdminX64 For Win10 x64
'************************************************************************
Function RunAsAdminX64()
Dim wso, fso, dwx, sSFN, sSD32, sSF32, vArg, sArgs, oShell, sDWX
Set wso = CreateObject("WScript.Shell")
Set fso = CreateObject("Scripting.filesystemobject")
RunAsAdminX64 = False
'获取 WSH 参数
For Each vArg In WScript.Arguments
sArgs = sArgs & " " & """" & vArg & """"
Next
'获取 32 位 WSH 目录
sSFN = fso.GetFile(WScript.FullName).Name
sSD32 = wso.ExpandenVironmentStrings("%windir%\SysWOW64")
If Not fso.FileExists(sSD32 & "\" & sSFN ) Then
sSD32 = wso.ExpandenVironmentStrings("%windir%\System32")
End If
'以 32 位 WSH 运行
If UCase(WScript.FullName) <> UCase(sSD32 & "\" & sSFN) Then
wso.Run sSD32 & "\" & sSFN & " """ & WScript.ScriptFullName & """" & sArgs, 1, False
WScript.Quit
End If
'以管理员权限运行 WSH
If Not WScript.Arguments.Named.Exists("ADMIN") Then
Set oShell = CreateObject("Shell.Application")
oShell.ShellExecute WScript.FullName, """" & WScript.ScriptFullName & """ " & sArgs & " /ADMIN:1 ", "", "runas", 6
WScript.Quit
End If
End Function