9zhmke

我自己也写过这个脚本，但发现好几个时间采集点经常出错自己的时间都不正确，你们遇到了吗？

9zhmke

回复 7# ygqiang

batman的作品可以使用，只是偶尔会出现源时间不准的现象，与程序无关

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
复制代码