[问题求助] 求助解决VBS获取网络上的时间校准本机系统时间的代码报错的原因

hnldwhm52

老师下了以下VBS校准系统时间在有线网络行，无线就不行，请修改！！谢谢！！
http://www.bathome.net/redirect. ... 4203&ptid=21616
运行vbs显示提示如下：

hnldwhm52

回复 2# yu2n
yu2n老师您好！！
        我是新手，是来学习的！！

yu2n

回复 2# hnldwhm52

这个『有线网络行，无线就不行』问题太广，但是跟VBS有关系么？
你要真觉得是无线网络问题，去把无线网络搞好不就行了。
你要真是来问问题的，把系统、运行环境、怎么操作出错的，给写明白了。

apang

我来改一下，不是因为lz所说的“无线网络不能用”，而是为了win7开启uac时双击能用，另外时区更改了不受影响

call runAsAdmin()
strNewDateTime = convertDateTime(getBaiduTime())
call syncDateTime(strNewDateTime, Now())

Function getBaiduTime()
    Dim strUrl, strText
    strUrl = "http://open.baidu.com/special/time/"
    With CreateObject("MSXML2.XmlHttp")
        .Open "GET", strUrl, False
        .Send()
        strText = .responseText
    End With
    strText = Split(LCase(strText), "window.baidu_time(")(1)
    getBaiduTime = Int(Left(strText, 13)/1000)
End Function

Function convertDateTime(intUnixTime)
    Dim objWMI, colOSes, objOS, tmZone
    Set objWMI = GetObject("winmgmts:\\.\root\cimv2")
    Set colOSes =objWMI.ExecQuery("Select * from Win32_OperatingSystem")
    For Each objOS in colOSes
        tmZone = objOS.CurrentTimeZone
    Next
    intUnixTime = intUnixTime + tmZone * 60
    convertDateTime = DateAdd("s", intUnixTime, "1970-1-1 00:00:00")
End Function

Sub syncDateTime(ByVal strNewDateTime, strOldDateTime)
    Dim ss, objDateTime, dtmNewDateTime
    ss = DateDiff("s", strOldDateTime, strNewDateTime)
    If Abs(ss) < 1 Then
        MsgBox "本机时间非常准确无需校对！"
        Exit Sub
    End If

    Set objDateTime = CreateObject("WbemScripting.SWbemDateTime")
    objDateTime.SetVarDate strNewDateTime, true 
    dtmNewDateTime = objDateTime.Value

    Dim objWMI, colOSes, objOS
    Set objWMI = GetObject("winmgmts:{(Systemtime)}\\.\root\cimv2")
    Set colOSes =objWMI.ExecQuery("Select * from Win32_OperatingSystem")
    For Each objOS in colOSes
        objOS.SetDateTime dtmNewDateTime
    Next
    MsgBox "校准前：" & strOldDateTime & vbLf & "校准后：" & Now()
End Sub

Sub runAsAdmin()
    Dim objWMI, colOSes, objOS, strVer
    Set objWMI = GetObject("winmgmts:\\.\root\cimv2") 
    Set colOSes =objWMI.ExecQuery("Select * from Win32_OperatingSystem")
    For Each objOS in colOSes
        strVer = Split(objOS.Version, ".")(0)
    Next
    If CInt(strVer) >= 6 Then
        Dim objShell
        Set objShell = CreateObject("Shell.Application")
        If WScript.Arguments.Count = 0 Then
            objShell.ShellExecute "WScript.exe", _
                """" & WScript.ScriptFullName & """ OK", , "runAs", 1
            Set objShell = Nothing
            WScript.Quit
        End If
    End If
End Sub
复制代码

ygqiang

我来改一下，不是因为lz所说的“无线网络不能用”，而是为了win7开启uac时双击能用，另外时区更改了不受影响 ...
apang 发表于 2015-1-20 21:26

    而是为了win7开启uac时双击能用？？？

这个是啥意思？你的vbs代码，与1楼的相比，有啥差别呢？


明白了。多谢。。。
有人说：“win7下，不是所有vbs都可以运行  包括其它一些程序  有些需要权限
call runAsAdmin()    这个就是获取win7下管理员权限的命令

下面有个runAsAdmin()   自定义函数，作用就是获取权限”

hnldwhm52

我来改一下，不是因为lz所说的“无线网络不能用”，而是为了win7开启uac时双击能用，另外时区更改了不受影响 ...
apang 发表于 2015-1-20 21:26

i
谢谢apang老师旳热心指教解答！

yiwuyun

没看懂那个OK是什么意思，如果没有，就会出问题，但如果改成任何其他字符串，都不会出问题。
objShell.ShellExecute "WScript.exe", """" & WScript.ScriptFullName & """ OK", , "runAs", 1
按一些资料的解释，第二个参数应该是WScript.exe的参数，但它需要这个ＯＫ参数吗？

apang

回复 7# yiwuyun


    如你所说，OK就是一参数名字，可以用其它字符替代，但它是WScript.exe的参数，WScript.Arguments.Count 就是WScript.exe的参数个数
如果把它当作objShell.ShellExecute 的参数，那它是多余的

yiwuyun

谢谢，想了一晚上，懂了，ok不是要传给ws的，而是要传给vbs的。代码很清晰，写得很好。比楼主的那个代码清晰多了。