革天明 发表于 2012-8-23 17:58:05

xiaxiang 发表于 2012-8-23 16:18 static/image/common/back.gif
请教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

革天明 发表于 2012-8-23 18:01:11

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

xiaxiang 发表于 2012-8-23 20:38:47

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

感谢分享！

革天明 发表于 2012-8-23 23:09:41

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

xiaxiang 发表于 2012-8-24 08:51:47

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

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

海盗曹 发表于 2012-8-28 09:11:12

好东西啊，学习一下~
页: 1 [2]
查看完整版本: 如何读取 世界时间 而非本电脑时间