±¾Ìû×îºóÓÉ yu2n ÓÚ 2019-5-26 12:41 ±à¼
2019.05.26 ÒѸüÐÂʱ¼äÀ´Ô´£¬¿ÉÉèÖÃÈÎÒâÍøվΪʱ¼äÔ´¡£ (×Ô¶¨Òå HTTP ·þÎñÆ÷¿ÉÐ޸ĴúÂëÖÐµÄ http://www.microsoft.com )
Win7x64 / Win10x64 ²âÊÔͨ¹ý- 'VBSУ׼ϵͳʱ¼ä BY Yu2n 2019.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("HKLM\SYSTEM\CurrentControlSet\Control\TimeZoneInformation\ActiveTimeBias")
- 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
¸´ÖÆ´úÂë
|