校准系统时间的VBS代码.doc

　　更新为自动判断时间格式，WIN7 XP测试通过，WIN8待测试，主要是通过获取百度的相关信息然后跟系统时间进行比较
　　代码如下:
　　'VBS校准系统时间 BY BatMan 
　　Dim objXML, Url, Message 
　　Message = "恭喜你，本机时间非常准确无需校对！" 
　　Set objXML = CreateObject("MSXML2.XmlHttp") 
　　Url = "
　　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