使用 VBS 实现时间校准

效果还是很不错,大家可以参考一下,适合对于时间有特殊要求使用。比如:使用当地时区却不使用当地时间
如果想实现定时校时可以添加一个定时任务,这里建议Windows7以上使用SYSTEM权限,可以实现用户未登录也能自动校时。

'----- 设置部分,按照需求进行修改 -----
'获取时间的网站,建议选择相近的服务器
GetUrl = "http://www.baidu.com/"
'以 GMT 时区为基准偏移时间,单位:分。例如北京时间:8*60
OffsetMinute = 8*60

'----- 程序部分,非必要请不要修改 -----
On Error Resume Next
Set WMI = GetObject("winmgmts:{(Systemtime)}\\.\root\cimv2")

'----- 获取服务器时区 -----
Set Query = WMI.ExecQuery("Select * From Win32_ComputerSystem")
For Each Rows In Query
    CurrentTimezone = Rows.CurrentTimezone
Next
Set Query = Nothing
If CurrentTimezone>0 Then
    CurrentTimezone = "+" & Right("000" & CurrentTimezone, 3)
ElseIf CurrentTimezone<0 Then
    CurrentTimezone = "-" & Right("000" & (-1*CurrentTimezone), 3)
Else
    CurrentTimezone = "+000"
End If

'----- 获取远程时间 -----
For T=1 To 5 '5次内获取耗时小于1秒的时间
    Set XMLHTTP = CreateObject("Microsoft.XMLHTTP")
    GetStart = Timer
    XMLHTTP.Open "HEAD", GetUrl, False
    XMLHTTP.Send
    'NewTime = Replace(Split(XMLHTTP.getResponseHeader("Date"), ",")(1), " GMT", "")
    NewTime = XMLHTTP.getResponseHeader("Date")
    GetEnd = Timer
    Set XMLHTTP = Nothing
    If GetEnd>=GetStart And GetEnd-GetStart<1 Then
        Exit For
    Else
        NewTime = "Connect Timeout."
        WScript.Sleep 5000 '暂停5秒
    End If
Next

'----- 提取时间 -----
Set TimeRe = New RegExp
TimeRe.Global = False
TimeRe.MultiLine = False
TimeRe.IgnoreCase = False
TimeRe.Pattern = "^[A-Z][a-z]{2}\,\s(\d{2}\s[A-Z][a-z]{2}\s\d{4}\s\d{2}\:\d{2}\:\d{2})\sGMT$"
Set Matches = TimeRe.Execute(NewTime)
If Matches.Count>0 Then
    NewTime = Matches(0).SubMatches(0)
    NewTime = DateAdd("n", OffsetMinute, NewTime)
    WMITime = Year(NewTime) & Right("0" & Month(NewTime), 2) & Right("0" & Day(NewTime), 2)
    WMITime = WMITime & Right("0" & Hour(NewTime), 2) & Right("0" & Minute(NewTime), 2) & Right("0" & Second(NewTime), 2)
    WMITime = WMITime & ".000000" & CurrentTimezone
    '----- 设置时间 (需要管理员或SYSTEM权限) -----
    Set Query = WMI.ExecQuery("Select * From Win32_OperatingSystem")
    For Each Rows In Query
        Rows.SetDateTime WMITime
    Next
    Set Query = Nothing
End If
Set Matches = Nothing
Set TimeRe = Nothing
Set WMI = Nothing

发表评论

电子邮件地址不会被公开。 必填项已用*标注