VB获取网络时间

OptionExplicit'获取网页源码PublicFunctionGetHtmlCode(ByValURLAsString,OptionalUTF8AsBoolean)AsStringDimxmlHTTPAsObjectDimobjStreamAsObjectDimstrObjNameAsStringOnErrorGoToToExit'Microsoft.XMLHTTP这样做是为了不被某些杀软杀掉strObjName=Chr$(562Xor639)&Chr$(480Xor393)&Chr$(262Xor357)&Chr$(653Xor767)&Chr$(469Xor442)&Chr$(293Xor342)&Chr$(558Xor577)&Chr$(755Xor661)&Chr$(427Xor479)&Chr$(420Xor394)&Chr$(177Xor233)&Chr$(907Xor966)&Chr$(435Xor511)&Chr$(860Xor788)&Chr$(110Xor58)&Chr$(382Xor298)&Chr$(29Xor77)SetxmlHTTP=CreateObject(strObjName)WithxmlHTTPIfLeft$(LCase$(URL),7)=http://&URL.OpenGET,URL,True.sendDoUntil.ReadyState=4DoEventsLoopEndWithSetobjStream=CreateObject(adodb.stream)WithobjStream.Type=1.Mode=3.Open.WritexmlHTTP.responseBody.position=0.Type=2.Charset=IIf(UTF8=True,UTF-8,GB2312)GetHtmlCode=.ReadText.CloseEndWithSetxmlHTTP=NothingSetobjStream=NothingToExit:SetxmlHTTP=NothingSetobjStream=NothingEndFunction'e.g:'从网络上获得当天日期SubMain()DimstrCodeAsStringstrCode==GetHtmlCode(strCode)'取得网页源码strCode=Filter(Split(strCode,vbCrLf),年)(0)strCode=Right$(strCode,Len(strCode)-InStr(strCode,'))strCode=Left$(strCode,InStr(strCode,')-1)MsgBoxstrCodeEndSub我们用VB程序实现通过RFC867协议设置我们自己的计算机系统时间，为使程序简化，程序未进行日期校正，只进行时间校正。在FORM1中添加1个Winsock控件，将下面代码剪贴到FORM1的代码窗体中即可：OptionExplicit'采用RFC867Daytime协议获取标准时间例程'为中科院国家授时中心，采用北京时间'时间格式：MonJul2609:58:572004'time.nist.gov为美国标准技术院，采用格灵威时间'时间格式：5321204-07-2602:00:125000488.3UTC(NIST)*PrivateDeclareSubSleepLibkernel32(ByValdwMillisecondsAsLong)DimNoSrvAsBooleanDimTimeFromNetPrivateSubForm_Load()Winsock1.Protocol=sckTCPProtocol'采用TCP协议NetTime首先取中科院国家授时中心时间IfNoSrvOrTimeFromNet=Then'若未取到中科院国家授时中心时间，则取美国标准技术院时间NetTimetime.nist.govIfNoSrvOrTimeFromNet=Then'若不能取美国标准技术院时间，则报错MsgBox检测不到网络标准时间服务器time.nist.gov！Else'为使网络传输误差减小，第2次再取美国标准技术院时间NetTimetime.nist.govIfTimeFromNet=ThenMsgBox网络标准时间服务器time.nist.gov超时！ElseTimeFromNet=Mid(TimeFromNet,17,8)TimeFromNet=TimeSerial((Hour(TimeFromNet)+8)Mod24,Minute(TimeFromNet),Second(TimeFromNet))Time=TimeFromNet'设置系统时间EndIfEndIfElse'为使网络传输误差减小，第2次再取中科院国家授时中心时间NetTime=ThenMsgBox网络标准时间服务器超时！ElseTime=Mid(TimeFromNet,12,8)'设置系统时间EndIfEndIfEndEndSub'关闭Winsock子程序PrivateSubWinsock1_Close()IfWinsock1.StatesckClosedThenWinsock1.CloseEndIfEndSub'Winsock接收数据事件PrivateSubWinsock1_DataArrival(ByValbytesTotalAsLong)TimeFromNet=String(bytesTotal,)Winsock1.GetDataTimeFromNet,vbString,bytesTotalEndSub'Winsock出错事件PrivateSubWinsock1_Error(ByValNumberAsInteger,DescriptionAsString,ByValScodeAsLong,ByValSourceAsString,ByValHelpFileAsString,ByValHelpContextAsLong,CancelDisplayAsBoolean)NoSrv=TrueEndSub'从互联网上标准时间提供网站获取标准时间PrivateSubNetTime(TimeSrvAsString)NoSrv=FalseTimeFromNet=IfWinsock1.StatesckClosedThenWinsock1.CloseWinsock1.RemoteHost=TimeSrv'=13Winsock1.LocalPort=0Winsock1.ConnectDoWhileTimeFromNet='循环等待标准时间网站返回时间数据IfNoSrvThenExitDo'若Winsock出错，则跳出循环等待Sleep55DoEventsLoopIfWinsock1.StatesckClosedThenWinsock1.CloseEndSub