获取北京时间

0 Reply , Posted in 程序代码 on 2016 08, 2016

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

标签:     

相关推荐

vb读取access并且显示  (2017-5-11 9:18:27)

VB 获取CPU温度示例  (2017-5-8 10:35:11)

VB程序逆向反汇编常见的函数   (2017-5-8 10:32:0)

VB内嵌汇编的模块示例  (2017-5-8 10:24:4)

内存数据的读写(PC)   (2017-3-1 17:51:40)

用VB制作外挂   (2017-3-1 16:16:53)

发表评论:



◎欢迎参与讨论,请在这里发表您的看法、交流您的观点。

                       

  鄂公网安备 42112502000156号     鄂ICP备16019550号