我們都知道電腦的時間準確與否，是一件很重要的事情，
但是電腦的時間有時會不準確，要使用
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
|
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 |
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程式(中文版及英文版)
