标题: [原创] VBS校准系统时间 [打印本页]
作者: batman 时间: 2013-1-10 00:49 标题: VBS校准系统时间
本帖最后由 batman 于 2013-1-10 18:23 编辑
更新为自动判断时间格式,WIN7 XP测试通过,WIN8待测试:- 'VBS校准系统时间 BY BatMan http://www.bathome.net
- 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
复制代码
作者: czjt1234 时间: 2013-1-10 08:14
29行,下标越界
作者: batman 时间: 2013-1-10 11:53
回复 2# czjt1234
是因为时间格式的问题,家里的电脑是12小时制。。。
已修改为24小时制,应该大多数系统时间都是24小时制吧。。。
作者: 522235677 时间: 2013-1-10 14:11
本帖最后由 522235677 于 2013-1-10 14:13 编辑
以后就方便了,网上有的校准软件杀毒软件会报毒……
作者: lxningbat 时间: 2013-1-10 16:48
不错,不过可能由于程序的运行获取信息的延时显示会误差1到2秒
作者: 极品小猫 时间: 2013-1-10 16:50
一般系统默认都采用24小时制
这个东西好,每次用系统自身的更新系统时间都巨麻烦,更新前还必须调系统日期才能更新
作者: batman 时间: 2013-1-10 22:57
哼哼哈嘿!快使用WMI:- 'VBS校准系统时间 BY BatMan http://www.bathome.net
- 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, y, M, D, H, MI, S, NewDateTime
- DM = DateAdd("S", Num, Now())
- y = Year(DM)
- M = Right(0 & Month(DM), 2)
- D = Right(0 & Day(DM), 2)
- H = Right(0 & Hour(DM), 2)
- MI = Right(0 & Minute(DM), 2)
- S = Right(0 & Second(DM), 2)
- '将时间转化成UTC格式
- NewDateTime = y & M & D & H & MI & S & ".000000+480"
- Dim objWMI, objItems, objItem
- Set objWMI = GetObject("winmgmts:{(systemtime)}!\\.\Root\Cimv2")
- Set objItems = objWMI.ExecQuery("Select * From Win32_OperatingSystem")
- For Each objItem In objItems
- objItem.SetDateTime NewDateTime
- Next
- Set objWMI = Nothing
- 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
复制代码
作者: yu2n 时间: 2013-1-11 01:01
建议加入 UNC 运行提醒。
JS版- <title>
- EasyX v20120603(beta) 安装向导
- </title>
- <script type="text/javascript">
- function GetSystemVersion() {
- var os = GetObject("winmgmts:").InstancesOf("Win32_OperatingSystem");
- for (var e = new Enumerator(os); ! e.atEnd(); e.moveNext()) {
- var v = e.item().Version;
- var ss = v.split('.');
- return ss[0] + ss[1];
- }
- return - 1;
- }
- if (GetSystemVersion() >= 60) {
- var cmd = location.pathname;
- if (cmd.substring(cmd.length - 4) != ".HTA") {
- var Shell = new ActiveXObject("Shell.Application");
- Shell.ShellExecute("mshta.exe", "\"" + cmd.substring(0, cmd.length - 4) + ".HTA\"", "", "runas", 1);
- window.close();
- exit(0);
- }
- }
- </script>
复制代码
作者: 9zhmke 时间: 2013-7-8 23:12
我也借鉴来写个:
Function Set_Net_DateTime()
Dim attrib,day,month,year,hours
'On Error Resume Next
attrib=Split(getHTTPPage("http://stdtime.gov.hk:13"))'30 JAN 2012 00:04:42 HKT
day=attrib(0)
month=int(instr("JANFEBMARAPRMAYJUNJULAUGSEPOCTNOVDEC",attrib(1))/3)+1
year=attrib(2)
hours=attrib(3)
Set objSWbemDateTime=CreateObject("WbemScripting.SWbemDateTime")
objSWbemDateTime.SetVarDate year&"-"&month&"-"&day&" "&attrib(3),True '"2009-3-30 22:38:00"
Set objWMIService=GetObject("winmgmts:{(Systemtime)}\\.\root\cimv2")
Set colOSes=objWMIService.ExecQuery("Select * From Win32_OperatingSystem")
For Each objOS In colOSes
objOS.SetDateTime objSWbemDateTime.Value
Next
Set objSWbemDateTime=nothing
set objWMIService=nothing
set colOSes=nothing
End Function
作者: yu2n 时间: 2015-11-8 22:27
本帖最后由 yu2n 于 2019-5-26 12:41 编辑
2019.05.26 已更新时间来源,可设置任意网站为时间源。 (自定义 HTTP 服务器可修改代码中的 http://www.microsoft.com )
Win7x64 / Win10x64 测试通过- 'VBS校准系统时间 BY Yu2n 2019.05.26
- Option Explicit
-
- RunAsAdminX64
- Main
-
- '************************************************************************
- Sub Main()
- '************************************************************************
- Dim dtNet, dtLocal1, dtLocal2, lngOffset1, lngOffset2, strMessage
- dtNet = GetNetTime("http://www.microsoft.com")
- dtLocal1 = Now()
- lngOffset1 = Abs(DateDiff("s", dtNet, dtLocal1))
- If lngOffset1 > 1 Then
- SetDateTime dtNet
- dtLocal2 = Now()
- lngOffset2 = Abs(DateDiff("s", dtNet, dtLocal2))
- strMessage = "【校准前】" & vbCrLf _
- & "标准北京时间为:" & vbTab & dtNet & vbCrLf _
- & "本机系统时间为:" & vbTab & dtLocal1 & vbCrLf _
- & "与标准时间相差:" & vbTab & lngOffset1 & "秒" & vbCrLf & vbCrLf _
- & "【校准后】" & vbCrLf _
- & "标准北京时间为:" & vbTab & dtNet & vbCrLf _
- & "本机系统时间为:" & vbTab & dtLocal2 & vbCrLf _
- & "与标准时间相差:" & vbTab & lngOffset2 & "秒"
- Else
- strMessage = "【无需校准】" & vbCrLf _
- & "标准北京时间为:" & vbTab & dtNet & vbCrLf _
- & "本机系统时间为:" & vbTab & dtLocal1 & vbCrLf _
- & "与标准时间相差:" & vbTab & lngOffset1 & "秒"
- End If
- WScript.Echo strMessage
- End Sub
-
-
- '************************************************************************
- '获取网络上指定的HTTP服务器时间
- '************************************************************************
- Function GetNetTime(ByVal Url)
- Dim Bias, DateLine '时间偏移(分钟)
- Dim dtGMT, dtLocal, dtBegin
- On Error Resume Next
- With CreateObject("WScript.Shell")
- '[ActiveTimeBias]:该键值存储当前系统时间相对格林尼治标准时间的偏移(以分钟为单位)
- '[Bias]:该键值存储当前本地时间相对格林尼治标准时间的偏移(以分钟为单位)
- Bias = .RegRead("HKLM\SYSTEM\CurrentControlSet\Control\TimeZoneInformation\ActiveTimeBias")
- End With
- With CreateObject("Microsoft.XMLHTTP")
- dtBegin = Now()
- .Open "POST", Url, False
- .Send
- If Err.Number = 0 Then
- dtGMT = Split(Replace(.getResponseHeader("Date"), " GMT", ""), ",")(1)
- If IsDate(dtGMT) Then
- dtLocal = DateAdd("n", -CLng(Bias), CDate(dtGMT)) '北京时间:GMT+8
- dtLocal = DateAdd("s", DateDiff("s", dtBegin, Now()), dtLocal) '时间损耗
- GetNetTime = dtLocal
- End If
- End If
- End With
- End Function
-
-
- '************************************************************************
- '设定电脑的时间
- '************************************************************************
- Function SetDateTime(ByVal dt1)
- Dim WmiService, ComputerName, OSList, OSEnum, OS, DateTime
- ComputerName = "."
- Set WmiService = GetObject("winmgmts:{impersonationLevel=impersonate, (Systemtime)}!//" + ComputerName + "/root/cimv2")
- Set OSList = WmiService.InstancesOf ("Win32_OperatingSystem")
- Set DateTime = CreateObject("WbemScripting.SWbemDateTime")
- For Each OSEnum In OSList
- DateTime.Value = OSEnum.LocalDateTime
- DateTime.Year = Year(dt1)
- DateTime.Month = Month(dt1)
- DateTime.Day = Day(dt1)
- DateTime.Hours = Hour(dt1)
- DateTime.Minutes = Minute(dt1)
- DateTime.Seconds = Second(dt1)
- If (OSEnum.SetDateTime(DateTime.Value) <> 0) Then
- 'WScript.Echo "警告:设置系统时间失败!"
- SetDateTime = False
- Else
- 'WScript.Echo "提示:设置成功。当前时间:" & DateTime.GetVarDate()
- SetDateTime = True
- End If
- Next
- End Function
-
-
- '************************************************************************
- '初始化 RunAsAdminX64 For Win10 x64
- '************************************************************************
- Function RunAsAdminX64()
- Dim wso, fso, dwx, sSFN, sSD32, sSF32, vArg, sArgs, oShell, sDWX
- Set wso = CreateObject("WScript.Shell")
- Set fso = CreateObject("Scripting.filesystemobject")
- RunAsAdminX64 = False
- '获取 WSH 参数
- For Each vArg In WScript.Arguments
- sArgs = sArgs & " " & """" & vArg & """"
- Next
- '获取 32 位 WSH 目录
- sSFN = fso.GetFile(WScript.FullName).Name
- sSD32 = wso.ExpandenVironmentStrings("%windir%\SysWOW64")
- If Not fso.FileExists(sSD32 & "\" & sSFN ) Then
- sSD32 = wso.ExpandenVironmentStrings("%windir%\System32")
- End If
- '以 32 位 WSH 运行
- If UCase(WScript.FullName) <> UCase(sSD32 & "\" & sSFN) Then
- wso.Run sSD32 & "\" & sSFN & " """ & WScript.ScriptFullName & """" & sArgs, 1, False
- WScript.Quit
- End If
- '以管理员权限运行 WSH
- If Not WScript.Arguments.Named.Exists("ADMIN") Then
- Set oShell = CreateObject("Shell.Application")
- oShell.ShellExecute WScript.FullName, """" & WScript.ScriptFullName & """ " & sArgs & " /ADMIN:1 ", "", "runas", 6
- WScript.Quit
- End If
- End Function
复制代码
作者: Heykuz 时间: 2015-11-9 22:00
都测试了,感谢七楼的版主,仅只测试通过。本人win7 64 网络下载微软官方正版。
感谢其它楼的,家中的老爷机子上通过。win7 64 俄罗斯高人精简版。
作者: yu2n 时间: 2017-2-10 23:38
本帖最后由 yu2n 于 2019-5-26 12:41 编辑
2019.05.26 已更新时间来源,可设置任意网站为时间源。 (自定义 HTTP 服务器可修改代码中的 http://www.microsoft.com )
Js 也来凑热闹了……- //文件名称:SyncNetTime2.js
- //功能说明:同步本机时间与网络时间
- //使用方法:Cscript.exe //nologo SyncNetTime.js
- //测试环境:系统 Win10 x64 时间 18/1/15 用户 Yu2n
- //更新内容:Fix 获取网络时间,从 HTTP SERVER HEADER
-
- //以管理员运行
- function GetSystemVersion() {
- var os = GetObject("winmgmts:").InstancesOf("Win32_OperatingSystem");
- for (var e = new Enumerator(os); ! e.atEnd(); e.moveNext()) {
- var v = e.item().Version;
- var ss = v.split('.');
- return ss[0] + ss[1];
- }
- return - 1;
- }
- if (GetSystemVersion() >= 60) {
- var cmd = WScript.ScriptFullName;
- if (cmd.substring(cmd.length - 3) != ".jS") {
- var Shell = new ActiveXObject("Shell.Application");
- Shell.ShellExecute("wscript.exe", "\"" + cmd.substring(0, cmd.length - 3) + ".jS\"", "", "runas", 1);
- WScript.Quit(0);
- }
- }
-
- //获取网络时间,从 HTTP SERVER HEADER
- var getNetDate = function() {
- var dtGMT = '';
- try{
- var http = new ActiveXObject("Microsoft.XMLHTTP");
- http.open("POST", "http://www.microsoft.com?rnd=" + (new Date()), false);
- http.send();
- dtGMT = http.getResponseHeader("Date");
- if (dtGMT != '') {
- return new Date(dtGMT);
- } else {
- WScript.Echo("警告:获取网络时间失败!")
- WScript.Quit(0);
- };
- }catch(e){};
- };
-
- //设置时间
- function ChangeDate()
- {
- var WmiService, ComputerName, OSList, OSEnum, OS, DateTime;
- ComputerName = ".";
- WmiService = GetObject ("winmgmts:{impersonationLevel=impersonate, (Systemtime)}!//" + ComputerName + "/root/cimv2");
- OSList = WmiService.InstancesOf ("Win32_OperatingSystem");
- DateTime = new ActiveXObject ("WbemScripting.SWbemDateTime");
- OSEnum = new Enumerator (OSList);
- for ( ; !OSEnum.atEnd(); OSEnum.moveNext())
- {
- OS = OSEnum.item();
- var dtNewDate = getNetDate(); //获取网络时间
- DateTime.Value = OS.LocalDateTime;
- DateTime.Year = dtNewDate.getFullYear();
- DateTime.Month = dtNewDate.getMonth() + 1;
- DateTime.Day = dtNewDate.getDate();
- DateTime.Hours = dtNewDate.getHours();
- DateTime.Minutes = dtNewDate.getMinutes();
- DateTime.Seconds = dtNewDate.getSeconds();
- if (OS.SetDateTime(DateTime.Value) != 0) {
- WScript.Echo("警告:设置系统时间失败!");
- } else {
- WScript.Echo("提示:设置成功。当前时间:" + new Date(DateTime.GetVarDate()).toLocaleString());
- };
- }
- }
- ChangeDate();
- WScript.Quit(0);
复制代码
作者: citygun 时间: 2019-4-24 13:24
本帖最后由 citygun 于 2019-4-24 13:51 编辑
Js 也来凑热闹了……
yu2n 发表于 2017-2-10 23:38
之前一直用这个,不过最近貌似服务器地址有变化就失效了。。。目前的地址是http://time1903.beijing-time.org/time.asp还可以用
作者: yu2n 时间: 2019-5-26 12:40
回复 13# citygun
已更新时间来源,可设置任意网站为时间源。
作者: citygun 时间: 2019-7-19 22:25
回复 14# yu2n
一直在用这个js,很方便好用,感谢你写这么好用的脚本!
欢迎光临 批处理之家 (http://bbs.bathome.net/) |
Powered by Discuz! 7.2 |