返回列表 发帖

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

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

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

TOP

回复 2# hnldwhm52

这个『有线网络行,无线就不行』问题太广,但是跟VBS有关系么?
你要真觉得是无线网络问题,去把无线网络搞好不就行了。
你要真是来问问题的,把系统、运行环境、怎么操作出错的,给写明白了。
『千江有水千江月』千江有水,月映千江;万里无云,万里青天。    http://yu2n.qiniudn.com/

TOP

我来改一下,不是因为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 SubCOPY
1

评分人数

    • hnldwhm52: 谢谢apang老师旳热心指教解答!技术 + 1

TOP

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



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

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


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

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

TOP

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

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

TOP

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

TOP

回复 7# yiwuyun


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

TOP

本帖最后由 yiwuyun 于 2015-1-23 07:29 编辑

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

TOP

返回列表