[问题求助] [已解决]vbs如何获取指定网页上的日期时间并同步到本机，若获取不到则不校准？

'VBS校准系统时间 BY BatMan
On Error Resume Next
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)
  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
复制代码

Function getBaiduTime()
  On Error Resume Next
  Dim strUrl, strText
  strUrl = "http://open.baidu.com/special/time/"
  With CreateObject("MSXML2.XmlHttp")
    .Open "GET", strUrl, False
    .Send()
    strText = CStr(.responseText)
  End With
  If Err.Number <> 0 Or InStr(strText,"window.baidu_time(")<1 Then
    Msgbox "Error.getBaiduTime() 无法获取在线时间数据。"
    WScript.Quit
  End If
  strText = Split(LCase(strText), "window.baidu_time(")(1)
  getBaiduTime = Int(Left(strText, 13)/1000)
End Function
复制代码

regNum = Int(objREG.Execute(objStr)(0).Submatches(0)) /1000
If regNum = "" Or regNum = 0 Then
  Msgbox "无法获取在线时间数据。"
  WScript.Quit
End If
复制代码

@echo off&setlocal enabledelayedexpansion

if "%1" == "h" goto begin
mshta vbscript:createobject("wscript.shell").run("%~fs0 h",0)(window.close)&&exit
:begin
rem 下边开始写批处代码了


ping 127.0.0.1 -n 5 >nul 2>nul

title 获取网络时间，同步到本机(需联网)
cd /d "%tmp%"
(
    echo With CreateObject("Microsoft.XMLHTTP"^)
    echo    .open "GET", "http://time.tianqi.com/", False
    echo    .send
    echo    s = Split(Split(.responseText, "new Date(("^)(1^), "+"^)(0^)
    echo End With
    echo WSH.Echo DateAdd("s", s * 1, "1970-1-1 8:00"^)
)>getTime.vbs


——————————————————————————
cls
for /l %%m in (1,1,180) do (

ping 127.0.0.1 -n 10 >nul 2>nul

ping time.tianqi.com -n 1 >nul 2>nul 

echo !errorlevel!
if !errorlevel! equ 0 goto :neta

echo 外网不通
)

echo 外网不通，持续30分钟

exit


:neta
echo 外网通，同步本机时间
for /f "tokens=1*" %%i in ('cscript //nologo gettime.vbs') do date %%i & time %%j
echo 本机系统时间设置完成！


exit
复制代码

if getset("网络校时")="1" then
        if ping("baidu.com")<888 then
            debug("已完成网络校时：" & Set_Net_DateTime() ) '根据网络设置正确时间
        else
            debug ("网络似乎没有通，无法校时")
       end if
end if


Function Set_Net_DateTime()'网络校时，批处理之家batman作品
    Dim objXML, Url, objStr, LocalDate,objREG, regNum,OldDate, BJDate, Num, Num1,DM, DT, TM, objSHELL,Arr, Arr1, h24
    Set_Net_DateTime= "本机时间非常准确无需校对."
    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
    objStr = objXML.responseText
    LocalDate = Now()
    Set objXML = Nothing
    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
    OldDate = "1970-01-01 08:00:00"
    BJDate = DateAdd("s", regNum, OldDate)
    Num = DateDiff("s", LocalDate, BJDate)
    If Abs(Num) >=1 Then
        DM = DateAdd("S", Num, Now())
        DT = DateValue(left(DM,instr(DM," ")))
        tmp3=trim(left(DT,instr(DT," ")))
        if tmp3 > "" then DT=tmp3
        TM = right(DM,len(DM)-InstrRev(DM," "))
        if len(TM)<4 then tmp3=trim(left(DM,InstrRev(DM,TM)-1)):TM=right(tmp3,len(tmp3)-InstrRev(tmp3," "))& " " & TM
        TM=TimeValue(TM)
        If InStr(Now, "午") Then
            Arr = Split(TM, " ")
            Arr1 = Split(Arr(1), ":")
            h24 = Arr1(0)
            If Arr(0) = "下午" Then
                h24 = h24 + 12
                if h24=24 then 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 /c date " & DT, 0, True
        objSHELL.Run "cmd /c time " & TM, 0, True
        Num1 = Abs(DateDiff("s", Now(), BJDate))
Set_Net_DateTime = "本机" & LocalDate & vbTab & "与标准时间" & BJDate & vbTab & "相差:" & vbTab & Abs(Num) & "秒"
        Set objSHELL = Nothing
    End If
End Function
复制代码

@echo off
(
    echo;With CreateObject("Microsoft.XMLHTTP"^)
    echo;   .open "GET", "http://www.114time.com/api/time.php", False
    echo;   .send
    echo;   ms = .responseText*1
    echo;End With
    echo;WSH.Echo DateAdd("s", left(ms, len(ms^)-3^)+480*60, "1970-1-1 0:0:0"^)
)>%tmp%\dt.vbs
for /f "tokens=1*" %%i in ('cscript -nologo %tmp%\dt.vbs') do echo;date %%i&echo;time %%j
for /f "tokens=1*" %%i in ('cscript -nologo %tmp%\dt.vbs') do date %%i&time %%j
pause
复制代码

——————————————————————————————————————————————————————————
ver|find "XP" >nul&&goto :commo||goto :bootmgr

ver|find "5.2" >nul&&goto :commo||goto :bootmgr

if not exist c:\boot.ini goto :bootmgr


———————————————————————————————
:bootmgr

reg add "HKEY_CURRENT_USER\Control Panel\International" /f /v "sDate" /t REG_SZ /d "/"
reg add "HKEY_CURRENT_USER\Control Panel\International" /f /v "sLongDate" /t REG_SZ /d "yyyy'年'M'月'd'日'"
reg add "HKEY_CURRENT_USER\Control Panel\International" /f /v "sShortDate" /t REG_SZ /d "yyyy/M/d"
reg add "HKEY_CURRENT_USER\Control Panel\International" /f /v "sTime" /t REG_SZ /d ":"
reg add "HKEY_CURRENT_USER\Control Panel\International" /f /v "sTimeFormat" /t REG_SZ /d "H:mm:ss"
reg add "HKEY_CURRENT_USER\Control Panel\International" /f /v "sShortTime" /t REG_SZ /d "H:mm"
reg add "HKEY_CURRENT_USER\Control Panel\International" /f /v "sYearMonth" /t REG_SZ /d "yyyy'年'M'月'"
reg add "HKEY_CURRENT_USER\Control Panel\International" /f /v "iFirstDayOfWeek" /t REG_SZ /d "0"

1pause




———————————————————————————————
:commo
复制代码