华域联盟 vbs 校准系统时间的VBS代码

校准系统时间的VBS代码

复制代码 代码如下:

'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


您可能感兴趣的文章:

本文由 华域联盟 原创撰写:华域联盟 » 校准系统时间的VBS代码

转载请保留出处和原文链接:https://www.cnhackhy.com/16328.htm

本文来自网络,不代表华域联盟立场,转载请注明出处。

作者: sterben

发表回复

联系我们

联系我们

2551209778

在线咨询: QQ交谈

邮箱: [email protected]

工作时间:周一至周五,9:00-17:30,节假日休息

关注微信
微信扫一扫关注我们

微信扫一扫关注我们

关注微博
返回顶部