[VBScript]簡單的網路校時工具

我們都知道電腦的時間準確與否，是一件很重要的事情，
但是電腦的時間有時會不準確，要使用 Windows 內建的網路校時功能時，不是會被防火牆給擋住，不然就是只能每週校時一次，很不方便。



一、為了改善這種狀況，所以自己撰寫、開發一個網路校時程式，
這個範例是使用 VBSciprt， 需要先安裝 IE 5.5 以上版本
有興趣可到這裡 http://www.fileserve.com/list/eUzZUFS 下載 GetHttpServerDate.vbs（用來測試網站時間是否正確）、SyncTime.vbs（網路校時）（如何下載：請參考這裡）

優點：

• 支援使用 proxy server（許多網路校時軟體並沒有支援）
• 可選用的伺服器眾多，且伺服器回應快（因為一般的時間伺服器，有太多人在使用，造成不容易連線成功）
• 可校正的時間並無限制（就算時間和真正的時間差了幾十年依然可以校時，一般的網路校時軟體，最多只能接受相差幾個小時到幾天）
• 有程式碼，可自行修改
  

缺點：

• 校正時間不夠精確（誤差大多在1秒之內，對一般人而言已經足夠了）
• 有些網頁伺服器，它的時間不準確（所以要先用 GetHttpServerDate.vbs 測試一下）
  

使用 GetHttpServerDate.vbs：

執行 GetHttpServerDate.vbs 會出現一個視窗，這時可輸入想要查詢的 http 伺服器的時間
點擊『確定』後，可看到查詢到的網頁時間和時間伺服器上的時間差不多

試用 SyncTime.vbs：

先切到命令提示字元 以『echo %date% %time%』指令，查看現在的日期時間 再以『date 1999/01/02 && time 4:5:6』指令，變更日期及時間 以『echo %date% %time%』指令，查看日期、時間是否有變更 執行『SyncTime.vbs』 以『echo %date% %time%』指令，查看日期、時間，看網路校時是否有效

二、運作原理
一般來說，要實作網路校時，使用的方式有「網路時 間協議」、「Day Time Protocol」、「Time Protocol」、「Simple Network Time Protocol」，不過在這個例子採用的是「HTTP Time Protocol」，它其實就是使用 HTTP Header 中的 Date 欄位

先設定一些會用到的常數
如果會用到 proxy server 才能連上網的話，也要設定 proxy server 的相關設定值

014 ' WinHttpRequest proxy 設定方式 015 Const HTTPREQUEST_PROXYSETTING_DEFAULT = 0 016 Const HTTPREQUEST_PROXYSETTING_PRECONFIG = 0 017 Const HTTPREQUEST_PROXYSETTING_DIRECT = 1 018 Const HTTPREQUEST_PROXYSETTING_PROXY = 2 019 020 Const HTTPREQUEST_SETCREDENTIALS_FOR_SERVER = 0 021 Const HTTPREQUEST_SETCREDENTIALS_FOR_PROXY = 1 022 023 Const WindowStyle_Hidden = 0 024 025 Dim sProxyUser, sProxyPass, sProxyServer, bUseProxyServer, bProxyCheckUserPass 026 ' Proxy Server 設定值 027 sProxyServer = "localhost:8080" 028 ' 是否要使用 Proxy Server 029 bUseProxyServer = False 030 ' 是否要檢查帳號、密碼 031 bProxyCheckUserPass = False 032 sProxyUser = "username" 033 sProxyPass = "password" 034 035 Dim sHttpServer, nSyncPeriod 036 ' 要網路校時的網路伺服器 037 sHttpServer = "http://tw.yahoo.com" 038 ' 每隔多久要校正一次（單位分鐘） 039 nSyncPeriod = 60

使用 WinHttp 物件抓取 HTTP Header 中的 Date 欄位

043 Function GetDate(sUrl) 044 Dim HttpReq 045 046 ' 建立 WinHTTPRequest ActiveX 物件 047 Set HttpReq = CreateObject("WinHttp.WinHttpRequest.5.1") 048 049 ' 如果有需要透過 proxy 上網，可設定 proxy 050 If bUseProxyServer Then 051 HttpReq.SetProxy HTTPREQUEST_PROXYSETTING_PROXY, sProxyServer, "" 052 053 ' 開啟 HTTP 連線 054 If bProxyCheckUserPass Then 055 HttpReq.Open "POST", sUrl 056 HttpReq.SetCredentials sProxyUser, sProxyPass, HTTPREQUEST_SETCREDENTIALS_FOR_PROXY 057 Else 058 HttpReq.Open "GET", sUrl 059 End If 060 Else 061 ' 開啟 HTTP 連線 062 HttpReq.Open "GET", sUrl 063 End If 064 065 ' 送出 HTTP 請求 066 HttpReq.Send 067 068 ' 取出 HTTP 檔頭中的日期 069 GetDate = HttpReq.GetResponseHeader("Date") 070 071 ' 釋放物件 072 Set HttpReq = Nothing 073 End Function

HTTP Header 中的 Date 欄位是 GMT 格式，要將它轉換為本地時間

075 Function ConvertDate(sDate) 076 Dim regEx, oMatch, oMatches 077 078 ConvertDate = "" 079 ' 使用正規表示式，來找出 HTTP 檔頭的日期格式 080 Set regEx = New RegExp 081 regEx.Pattern = "(\d+) (\w+) (\d+) (\d+):(\d+):(\d+)" 082 regEx.IgnoreCase = True 083 Set oMatches = regEx.Execute(sDate) 084 If Not oMatches Is Nothing Then 085 If oMatches.Count Then 086 Dim year, mon, day, hour, min, sec 087 Dim months, pos 088 Dim oShell, atb, offsetMin 089 090 Set oMatch = oMatches(0) 091 day = oMatch.SubMatches(0) 092 mon = oMatch.SubMatches(1) 093 year = oMatch.SubMatches(2) 094 hour = oMatch.SubMatches(3) 095 min = oMatch.SubMatches(4) 096 sec = oMatch.SubMatches(5) 097 If year < 100 Then 098 year = year + 2000 099 End If 100 101 ' 將英文縮寫月份轉成數字 102 months = "(Jan|Feb|Mar|Apr|May|Jun|Jul|Aug|Sep|Oct|Nov|Dec)" 103 pos = InStr(months, mon) 104 If pos > 0 Then 105 mon = (pos - 2 + 4) / 4 106 End If 107 108 ' 轉換為 VBScript 的日期格式 109 ConvertDate = DateSerial(year, mon, day) + TimeSerial(hour, min, sec) 110 111 ' 釋放物件 112 Set oMatch = Nothing 113 114 Set oShell = CreateObject("WScript.Shell") 115 atb = "HKEY_LOCAL_MACHINE\System\CurrentControlSet\Control\TimeZoneInformation\ActiveTimeBias" 116 offsetMin = oShell.RegRead(atb) 117 ' 轉換為本地時間 118 ConvertDate = DateAdd("n", -offsetMin, ConvertDate) 119 ' 釋放物件 120 Set oShell = Nothing 121 End If 122 End If 123 124 ' 釋放物件 125 Set oMatches = Nothing 126 Set regEx = Nothing 127 End Function

然後再用 Dos 的 Date, Time 指令設定日期及時間

150 Function Sync_Time(url) 151 Dim remoteDate, StartTime, DiffTime 152 153 SyncTime = False 154 StartTime = Timer 155 remoteDate = GetDate(url) 156 DiffTime = Timer - StartTime 157 remoteDate = ConvertDate(remoteDate) 158 remoteDate = DateAdd("s", Round(DiffTime / 2), remoteDate) 159 160 If IsDate(remoteDate) Then 161 Dim oShell, rc 162 163 Set oShell = WScript.CreateObject("WScript.Shell") 164 Do 165 ' 變更系統時間 166 rc = oShell.Run("cmd /c time " & FormatDateTime(remoteDate, vbShortTime) & ":" & Second(remoteDate) , WindowStyle_Hidden, True) 167 If rc <> 0 Then 168 SyncTime = False 169 Exit Do 170 End If 171 172 ' 變更系統日期 173 rc = oShell.Run("cmd /c date " & FormatDateTime(remoteDate, vbShortDate) , WindowStyle_Hidden, True) 174 If rc <> 0 Then 175 SyncTime = False 176 Exit Do 177 End If 178 179 SyncTime = True 180 Exit Do 181 Loop 182 183 ' 釋放物件 184 Set oShell = Nothing 185 End If 186 End Function

每固定一段時間和網頁伺服器做時間校正（可自行修改成適合您的）

129 Sub Do_Sync_Time() 130 Dim i, j 131 132 Do 133 ' 開始真正的 Sync Time 134 Sync_Time(sHttpServer) 135 ' 暫停一段時間 136 For i = 1 To nSyncPeriod 137 For j = 1 To 60 138 WScript.Sleep 1000 139 Next 140 Next 141 Loop While True 142 End Sub

三、如果需要更精確的網路校時工具
可以到這裡 時間網站 或 國家時間與頻率標準實驗室，可以下載 NTP client程式(中文版及英文版)