试用期的代码，哪个大侠最完善一下
程序代码：'先引用Microsoft XML, v6.0
Option Explicit
Private Sub Form_Load()
On Error GoTo GetDateErr
Dim myXmlHttp As XMLHTTP
Set myXmlHttp = New XMLHTTP
myXmlHttp.open "GET", "http://m.baidu.com", False
myXmlHttp.send
Dim BaiduNow As Date
BaiduNow = DateFromHTTP(myXmlHttp.getResponseHeader("Date"))
BaiduNow = DateAdd("h", 8, BaiduNow)
MsgBox BaiduNow
Exit Sub
GetDateErr:
MsgBox "获取网络时间错误, 请确认已连接到网络"
End
End Sub
Public Function DateFromHTTP(HTTPDate As String) As Date
Const GMTDiff = 0
Dim Swd As String, d As String, Sm As String, Y As String, h As String, m As String, s As String, g As String, Out As Date
HTTPDate = LCase$(HTTPDate)
If Mid$(HTTPDate, 27, 3) = "gmt" Then
Swd = Left$(HTTPDate, 3)
d = Mid$(HTTPDate, 6, 2)
Sm = Mid$(HTTPDate, 9, 3)
Y = Mid$(HTTPDate, 13, 4)
h = Mid$(HTTPDate, 18, 2)
m = Mid$(HTTPDate, 21, 2)
s = Mid$(HTTPDate, 24, 2)
' on error resume Next
Out = DateSerial(Y, mFromSm(Sm), d) + TimeSerial(h, m, s) '+ GMTDiff
End If
DateFromHTTP = Out
End Function
Function mFromSm(Sm As String) As Integer
Dim Out As Integer
Select Case LCase$(Sm)
Case "jan": Out = 1: Case "feb": Out = 2: Case "mar": Out = 3: Case "apr": Out = 4
Case "may": Out = 5: Case "jun": Out = 6: Case "jul": Out = 7: Case "aug": Out = 8
Case "sep": Out = 9: Case "oct": Out = 10: Case "nov": Out = 11: Case "dec": Out = 12
End Select
mFromSm = Out
End Function
