如何读取 世界时间 而非本电脑时间

革天明

xiaxiang 发表于 2012-8-23 16:18
请教GetNetTimeAPP.dll是如何来的，提供什么接口以供调用？可以开源吗？

Public Function GetNetTime() As String
Dim obj, OBJStatus, url, GetText, i
Dim Retrieval
    url = "http://www.baidu.com"
    '判断网络是否连接
    If url <> "" Then
        Set Retrieval = GetObject("winmgmts:\\.\root\cimv2")
        Set obj = Retrieval.ExecQuery("Select * From Win32_PingStatus Where Address = '" & Mid(url, 8) & "'")
        For Each OBJStatus In obj
            If IsNull(OBJStatus.StatusCode) Or OBJStatus.StatusCode <> 0 Then
                Exit Function
            Else
                Exit For '已连接则继续
            End If
        Next
    End If
   
    '通过下载网页头信息获取网络时间
    Set Retrieval = CreateObject("Microsoft.XMLHTTP")
    With Retrieval
        .Open "Get", url, False, "", ""
        .setRequestHeader "If-Modified-Since", "0"
        .setRequestHeader "Cache-Control", "no-cache"
        .setRequestHeader "Connection", "close"
        .Send
        If .Readystate <> 4 Then Exit Function
        GetText = .getAllResponseHeaders()
        i = InStr(1, GetText, "date:", vbTextCompare)
        If i > 0 Then '网页下载成功
            i = InStr(i, GetText, ",", vbTextCompare)
            GetText = Trim(Mid(GetText, i + 1))
             i = InStr(1, GetText, " GMT", vbTextCompare)
            GetText = Left(GetText, i - 1)
            'MsgBox "网络时间:" & GetText
            GetNetTime = GetText
        End If
    End With
    Set Retrieval = Nothing
    Set OBJStatus = Nothing
    Set obj = Nothing
End Function

革天明

http://bbs.mjtd.com/forum.php?mod=viewthread&tid=57202
感谢tcsl9621 大师

xiaxiang

革天明 发表于 2012-8-23 18:01
http://bbs.mjtd.com/forum.php?mod=viewthread&tid=57202
感谢tcsl9621 大师

感谢分享！

革天明

我最想实现的就是LISP调用VB界面，调用DLL

xiaxiang

革天明 发表于 2012-8-23 23:09
我最想实现的就是LISP调用VB界面，调用DLL

调用VB界面好像猫给过实例的。。。

海盗曹

好东西啊，学习一下~