校准系统时间的VBS代码

【#文档大全网# 导语】以下是®文档大全网的小编为您整理的《校准系统时间的VBS代码》，欢迎阅读！





更新为自动判断时间格式，WIN7 XP测试通过，WIN8待测试，主要是通过获取百度的相关信息然后跟系统时间进行比较 代码如下:

'VBS校准系统时间 BY BatMan  Dim objXML, Url, Message 

Message = "恭喜你，本机时间非常准确无需校对！"  Set objXML = CreateObject("MSXML2.XmlHttp")  Url = "http://open.baidu.com/special/time/"  objXML.open "GET", Url, False  objXML.send() 

Do Until objXML.readyState = 4 : WScript.Sleep 200 : Loop  Dim objStr, LocalDate 

objStr = objXML.responseText  LocalDate = Now()  Set objXML = Nothing  Dim objREG, regNum 

Set objREG = New RegExp  objREG.Global = True  objREG.IgnoreCase = True 

objREG.Pattern = "window.baidu_time\((\d{13,}\)" 

regNum = Int(objREG.Execute(objStr)(0).Submatches(0)) /1000  Dim OldDate, BJDate, Num, Num1  OldDate = "1970-01-01 08:00:00" 

BJDate = DateAdd("s", regNum, OldDate)  Num = DateDiff("s", LocalDate, BJDate)  If Abs(Num) >=1 Then  Dim DM, DT, TM, objSHELL  DM = DateAdd("S", Num, Now())  DT = DateValue(DM)  TM = TimeValue(DM)  If InStr(Now, "午") Then  Dim Arr, Arr1, h24  Arr = Split(TM, " ")  Arr1 = Split(Arr(1), ":")  h24 = Arr1(0) 

If Arr(0) = "下午" Then  h24 = h24 + 12  Else 

If h24 = 12 Then h24 = 0  End If 

TM = h24 & ":" & Arr1(1) & ":" & Arr1(2)  End If 


Set objSHELL = CreateObject("Wscript.Shell") 

objSHELL.Run "cmd /cdate " & DT, False, True  objSHELL.Run "cmd /ctime " & TM, False, True  Num1 = Abs(DateDiff("s", Now(), BJDate))  Message = "【校准前】" & vbCrLf _ 

& "标准北京时间为：" & vbTab & BJDate & vbCrLf _  & "本机系统时间为：" & vbTab & LocalDate & vbCrLf _ 

& "与标准时间相差：" & vbTab & Abs(Num) & "秒" & vbCrLf & vbCrLf _ 

& "【校准后】" & vbCrLf _ 

& "本机系统时间为：" & vbTab & Now() & vbCrLf _  & "与标准时间相差：" & vbTab & Num1 & "秒"  Set objSHELL = Nothing  End If 

WScript.Echo Message 

本文来源：https://www.wddqxz.cn/6bae4c44a0c7aa00b52acfc789eb172dec63990d.html