- 生肖
- 猴
- 星座
- 处女座
- 性别
- 男
- 积分
- 680
- 积分
- 1161
- 精华
- 1
- 阅读权限
- 70
- 注册时间
- 2012-5-3
- 最后登录
- 2016-9-22
- 帖子
- 136
- 生肖
- 猴
- 星座
- 处女座
- 性别
- 男
|
发表于 2014-4-11 09:38:30
|显示全部楼层
电脑的纽扣电池没电了 开机时间总是不对于是就做了这个更新时间的 同样情况的可以把这个小东西设置拖到开始-程序-启动 就可以自启动了(代码里面没有设置自启动怕被杀,)不过需要联网哈拨号连接的就只能拨完号手动打开程序了 (打开后就更新时间没窗口的)
上代码: - Option Explicit
- '获取网页源码
- Public Function GetHtmlCode(ByVal URL As String, Optional UTF8 As Boolean) As String
- Dim xmlHTTP As Object
- Dim objStream As Object
- Dim strObjName As String
- On Error GoTo ToExit
- 'Microsoft.xmlHTTP '这样做是为了不被某些杀软杀掉
- strObjName = Chr$(562 Xor 639) & Chr$(480 Xor 393) & Chr$(262 Xor 357) & Chr$(653 Xor 767) & Chr$(469 Xor 442) & Chr$(293 Xor 342) & Chr$(558 Xor 577) & Chr$(755 Xor 661) & Chr$(427 Xor 479) & Chr$(420 Xor 394) & Chr$(177 Xor 233) & Chr$(907 Xor 966) & Chr$(435 Xor 511) & Chr$(860 Xor 788) & Chr$(110 Xor 58) & Chr$(382 Xor 298) & Chr$(29 Xor 77)
- Set xmlHTTP = CreateObject(strObjName)
- With xmlHTTP
- If Left$(LCase$(URL), 7) <> "http://" Then URL = "http://" & URL
- .Open "GET", URL, True
- .send
- Do Until .ReadyState = 4
- DoEvents
- Loop
- End With
- Set objStream = CreateObject("adodb.stream")
- With objStream
- .Type = 1
- .Mode = 3
- .Open
- .Write xmlHTTP.responseBody
- .position = 0
- .Type = 2
- .Charset = IIf(UTF8 = True, "UTF-8", "GB2312")
- GetHtmlCode = .ReadText
- .Close
- End With
- Set xmlHTTP = Nothing
- Set objStream = Nothing
- ToExit:
- Set xmlHTTP = Nothing
- Set objStream = Nothing
- End Function
- Private Function getTime() As Date
- Dim Regex As Object, ms As Object
- Dim HTML As String
- HTML = GetHtmlCode("http://open.baidu.com/special/time/", True)
- Set Regex = CreateObject("VBSCRIPT.REGEXP")
- Regex.IgnoreCase = True
- Regex.Pattern = "window.baidu_time\(([0-9]{13})\);"
- Set ms = Regex.Execute(HTML)
- If ms.Count = 0 Then
- getTime = Now()
- Else
- Dim t As String
- Dim q As String
- Dim tt As Long
- tt = Val(ms.Item(0).SubMatches(0) / 1000)
- t = FromUnixTime(tt, 8)
- If IsDate(t) Then getTime = CDate(t) Else getTime = Now()
- q = Format(t, "yyyy-MM-dd HH:mm:ss")
- 'Print Mid(q, 1, 10)
- 'Print Mid(q, 12, 8)
- 'Print q
- 'Print t
- 'Print Now
- Date = Mid(q, 1, 10)
- Time = Mid(q, 12, 8)
- End If
- End Function
- Function FromUnixTime(intTime, intTimeZone) '把Unix时间戳便改为常用的形式
- 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
- Private Sub Form_Load()
- Me.Hide
- getTime
- Unload Me
- End Sub
复制代码 |
|