校准系统时间的VBS代码
来源:本站原创|时间:2020-01-10|栏目:vb|点击: 次
复制代码 代码如下:
'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
您可能感兴趣的文章
- 01-10VBS教程:对象-Err
- 01-10远程或本地获取系统信息的脚本RGIS.vbs
- 01-10可以得到当前系统信息的脚本sysinfo.vbs
- 01-10可以定时自动关机的vbs脚本
- 01-10用vbs实现定时运行web文件的方法
- 01-10vbs定时发送邮件的方法与代码
- 01-10基于逻辑运算的简单权限系统(原理,设计,实现) VBS 版
- 01-10基于逻辑运算的简单权限系统(原理,设计,实现) VBS 版
- 01-10用vbs实现在启动 Windows 资源管理器时打开特定文件夹
- 01-10用vbs实现配置无人登录计算机时使用的屏幕保护程序
阅读排行
本栏相关
- 01-10下载文件到本地运行的vbs
- 01-10飘叶千夫指源代码,又称qq刷屏器
- 01-10SendKeys参考文档
- 01-10什么是一个高效的软件
- 01-10VBS中的正则表达式的用法大全 &l
- 01-10exe2swf 工具(Adodb.Stream版)
- 01-10VBS中SendKeys的基本应用
- 01-10用VBSCRIPT控制ONSUBMIT事件
- 01-10VBScript教程 第十一课深入VBScript
- 01-10VBScript语法速查及实例说明
随机阅读
- 08-05织梦dedecms什么时候用栏目交叉功能?
- 01-10C#中split用法实例总结
- 01-10使用C语言求解扑克牌的顺子及n个骰子
- 01-10delphi制作wav文件的方法
- 01-10SublimeText编译C开发环境设置
- 08-05DEDE织梦data目录下的sessions文件夹有什
- 04-02jquery与jsp,用jquery
- 08-05dedecms(织梦)副栏目数量限制代码修改
- 01-11Mac OSX 打开原生自带读写NTFS功能(图文
- 01-11ajax实现页面的局部加载