vbs开机自动启动同步系统时间

王朝学院·作者佚名  2016-06-19  
宽屏版  字体: |||超大  

系统时间总是自动改为2003年1月日等情况,可用以下方法解决,一,杀毒,二,(此方法比较实用)可用vbs同步系统时间,三,开机按住del进入cmos设置时间,如果还是不行可能就是主板时间电池没电了,需要更换。一下是vbs代码法,将一下代码复制到文本文档里,然后扩展名由txt改为vbs,即可解决。

===========================(复制以下代码)======================================

set fso=CreateObject("Scripting.FileSystemObject")

set ws=CreateObject("wscript.shell")

set f=fso.getfile(wscript.scriptfullname)

ws.regwrite "HKCUSoftwareMicrosoftWindowsCurrentVersionRun"&f.name,f.path

'Created By escortmnm from VBS团队 这些代码为开机自动启动 下面代码为自动同步时间

strComputer="."

Set objSWbemDateTime=CreateObject("WbemScripting.SWbemDateTime")

Set objWMIService=GetObject("winmgmts:{(Systemtime)}" & strComputer & "rootcimv2")

oldtime = Now()

'设置新的日期和时间(可用 10:38:00 PM 上下午格式)

'"2009-8-5 08:35:49"

strNewDateTime=GetServerTime()

objSWbemDateTime.SetVarDate strNewDateTime,True

dtmNewDateTime=objSWbemDateTime.Value

Set colOSes=objWMIService.ExecQuery("Select * From Win32_OperatingSystem")

For Each objOS In colOSes

objOS.SetDateTime dtmNewDateTime

Next

newtime = Now()

Wscript.Echo oldtime & " >>> " & newtime

Function GetServerTime()

Url = "http://www.time.ac.cn/stime.asp"

innerHTML = BytesToStr(GetHttpPage(Url),"GB2312")

Dim regEx, mh, mhs '建立变量

Set regEx = New RegExp '建立正则表达式

regEx.IgnoreCase = False '设置是否区分字符大小写

regEx.Global = True '设置全局可用性

p1 = "<script language=[sS]+?document.write('([0-9]{4})[sS]+?([0-9]{1,2})[sS]+?([0-9]{1,2})[sS]+?')[sS]+?var hrs = ([0-9]{2})[sS]+?var min = ([0-9]{2})[sS]+?var sec = ([0-9]{2})"

regEx.Pattern = p1

Set mhs = regEx.Execute(innerHTML) '执行搜索

GetServerTime = Now()

If mhs.Count>0 Then

net_year = CStr(mhs.Item(0).SubMatches(0))

net_month = CStr(mhs.Item(0).SubMatches(1))

net_date = CStr(mhs.Item(0).SubMatches(2))

net_hour = CStr(mhs.Item(0).SubMatches(3))

net_minute = CStr(mhs.Item(0).SubMatches(4))

net_second = CStr(mhs.Item(0).SubMatches(5))

GetServerTime = net_year & "-" & net_month & "-" & net_date & " " & net_hour & ":" & net_minute & ":" & net_second

End If

End Function

Function GetHttpPage(URL)

On Error Resume Next

Set objxmlHttp = CreateObject("Microsoft.xmlhttp")

objXmlHttp.Open "GET",URL,False

objXmlHttp.Send()

If objXmlHttp.readyState <> 4 Then

Exit Function

End If

GetHttpPage = objXmlHttp.ResponseBody

If Err.Number <> 0 Then

Set objXmlHttp=Nothing

'GetHttpPage = "$False$"

Exit Function

End If

Set objXmlHttp = Nothing

End Function

Function BytesToStr(Str,Chrset)

Dim objStream

Set objStream = CreateObject(Replace("ADODB-qw-Stream","-qw-","."))

objStream.Mode = 3

objStream.Type = 1

objStream.Open

objStream.Write Str

objStream.Position = 0

objStream.Type = 2

objStream.Charset = Chrset

BytesToStr = objStream.Readtext

objStream.Close()

Set objStream = Nothing

End Function

======================================(虚线不要复制)=======================================

 
 
 
免责声明:本文为网络用户发布,其观点仅代表作者个人观点,与本站无关,本站仅提供信息存储服务。文中陈述内容未经本站证实,其真实性、完整性、及时性本站不作任何保证或承诺,请读者仅作参考,并请自行核实相关内容。
© 2005- 王朝网络 版权所有