希米日志


主页 代码 笔记 软件 闲谈 留言


63 0

程序代码 Private Sub Command1_Click()     Me.Caption = 获取北京时间() End Sub '==============================以上为调用方法============================== '==============================以下为标准模块代码============================== Public Function 获取北京时间() As String     On Error GoTo 出错处理:     Dim WinHttp As WinHttp.WinHttpRequest     Set WinHttp = CreateObject("WinHttp.WinHttpRequest.5.1")     WinHttp.Open "GET", "http://m.bjtime.cn/header10.asp", True     WinHttp.SetTimeouts 5000, 5000, 5000, 5000     WinHttp.Option(WinHttpRequestOption_SslErrorIgnoreFlags) = &H3300     WinHttp.SetRequestHeader "Host", "m.bjtime.cn"     WinHttp.SetRequestHeader "Connection", "keep-alive"     WinHttp.SetRequestHeader "User-Agent", "Mozilla/5.0 (Windows NT 5.1) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/42.0.2311.135 Safari/537.36"     WinHttp.SetRequestHeader "Accept", "/"     WinHttp.SetRequestHeader "Referer", "http://m.bjtime.cn/"     WinHttp.SetRequestHeader "Accept-Language", "zh-CN,zh;q=0.8"     WinHttp.SetRequestHeader "Cookie", "visit=bjtime; ASPSESSIONIDCQDTCCRT=NKJOCKIDDBGFNKNOPJNJLMNP"     WinHttp.Send     WinHttp.WaitForResponse     While WinHttp.Status <> 200         DoEvents     Wend     获取北京时间 = BytesToBstr(WinHttp.ResponseBody, "UTF-8")     Set WinHttp = Nothing     获取北京时间 = FromUnixTime(Left(Shijian, 10), 8)     Exit Function 出错处理:     Set WinHttp = Nothing     获取北京时间 = "获取失败!" End Function Public Function BytesToBstr(strBody, CodeBase)     Dim ObjStream     Set ObjStream = CreateObject("Adodb.Stream")     With ObjStream         .Type = 1         .Mode = 3         .Open         .Write strBody         .Position = 0         .Type = 2         .Charset = CodeBase         BytesToBstr = .ReadText         .Close     End With     Set ObjStream = Nothing End Function Function FromUnixTime(intTime, intTimeZone)     If IsEmpty(intTime) Or Not IsNumeric(intTime) Then         FromUnixTime = Now()         Exit Function     End If     If IsEmpty(intTime) Or Not IsNumeric(intTimeZone) Then intTimeZone = 0     FromUnixTime = DateAdd("s", intTime, "1970-1-1 0:0:0")     FromUnixTime = DateAdd("h", intTimeZone, FromUnixTime) End Function


 2016-11-08 18:35:00

二维码



评论:

已有评论:

目 录




1