2021年js和vbs代碼可用網絡日期網絡時間同步到本地電腦上

2021年js和vbs代碼可用網絡日期網絡時間同步到本地電腦上最后由 ygqiang 于 -12-1 14:28年。js和vbs代碼可用：網絡日期、網絡時間，同步到本地電腦上。感謝：Yu2n系統環境：win7 64

'VBS校準系統時間 BY Yu2n.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(HKLMSYSTEMCurrentControlSetControlTimeZoneInformationActiveTimeBias)
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
nclick="copycode($('code0'));">復制代碼