定时ping某个网站,ping得通说明网络通

ping又怎么做呢？

Dim I As Integer
Global add As String
Global user As String
Global pass As String
Public Const IP_STATUS_BASE = 11000
Public Const IP_SUCCESS = 0
Public Const IP_BUF_TOO_SMALL = (11000 + 1)
Public Const IP_DEST_NET_UNREACHABLE = (11000 + 2)
Public Const IP_DEST_HOST_UNREACHABLE = (11000 + 3)
Public Const IP_DEST_PROT_UNREACHABLE = (11000 + 4)
Public Const IP_DEST_PORT_UNREACHABLE = (11000 + 5)
Public Const IP_NO_RESOURCES = (11000 + 6)
Public Const IP_BAD_OPTION = (11000 + 7)
Public Const IP_HW_ERROR = (11000 + 8)
Public Const IP_PACKET_TOO_BIG = (11000 + 9)
Public Const IP_REQ_TIMED_OUT = (11000 + 10)
Public Const IP_BAD_REQ = (11000 + 11)
Public Const IP_BAD_ROUTE = (11000 + 12)
Public Const IP_TTL_EXPIRED_TRANSIT = (11000 + 13)
Public Const IP_TTL_EXPIRED_REASSEM = (11000 + 14)
Public Const IP_PARAM_PROBLEM = (11000 + 15)
Public Const IP_SOURCE_QUENCH = (11000 + 16)
Public Const IP_OPTION_TOO_BIG = (11000 + 17)
Public Const IP_BAD_DESTINATION = (11000 + 18)
Public Const IP_ADDR_DELETED = (11000 + 19)
Public Const IP_SPEC_MTU_CHANGE = (11000 + 20)
Public Const IP_MTU_CHANGE = (11000 + 21)
Public Const IP_UNLOAD = (11000 + 22)
Public Const IP_ADDR_ADDED = (11000 + 23)
Public Const IP_GENERAL_FAILURE = (11000 + 50)
Public Const MAX_IP_STATUS = (11000 + 50)
Public Const IP_PENDING = (11000 + 255)
Public Const PING_TIMEOUT = 200
Public Const WS_VERSION_REQD = &H101
Public Const WS_VERSION_MAJOR = WS_VERSION_REQD \ &H100 And &HFF&
Public Const WS_VERSION_MINOR = WS_VERSION_REQD And &HFF&
Public Const MIN_SOCKETS_REQD = 1
Public Const SOCKET_ERROR = -1
Public Const MAX_WSADescription = 256
Public Const MAX_WSASYSStatus = 128
Public Type ICMP_OPTIONS
  Ttl As Byte
  Tos As Byte
  Flags As Byte
  OptionsSize As Byte
  OptionsData As Long
End Type
Dim ICMPOPT As ICMP_OPTIONS
Public Type ICMP_ECHO_REPLY
  Address As Long
  Status As Long
  RoundTripTime As Long
  DataSize As Integer
  Reserved As Integer
  DataPointer As Long
  Options As ICMP_OPTIONS
  Data As String * 250
End Type
Public Type WSADATA
  wVersion As Integer
  wHighVersion As Integer
  szDescription(0 To MAX_WSADescription) As Byte
  szSystemStatus(0 To MAX_WSASYSStatus) As Byte
  wMaxSockets As Integer
  wMaxUDPDG As Integer
  dwVendorInfo As Long
End Type
Public Declare Function IcmpCreateFile Lib "icmp.dll" () As Long
Public Declare Function IcmpCloseHandle Lib "icmp.dll" (ByVal IcmpHandle&) As Long
Public Declare Function IcmpSendEcho Lib "icmp.dll" (ByVal IcmpHandle As Long, _
   ByVal DestinationAddress As Long, ByVal RequestData As String, _
   ByVal RequestSize As Integer, ByVal RequestOptions As Long, _
   ReplyBuffer As ICMP_ECHO_REPLY, ByVal ReplySize As Long, _
   ByVal Timeout As Long) As Long
Public Declare Function WSAGetLastError Lib "WSOCK32.dll" () As Long
Public Declare Function WSAStartup Lib "WSOCK32.dll" _
  (ByVal wVersionReqired As Long, lpWSADATA As WSADATA) As Long
Public Declare Function WSACleanup Lib "WSCOK32.dll" () As Long
Public Declare Function gethostname Lib "WSCOK32.dll" _
  (ByVal szHost As String, ByVal dwHostLen As Long) As Long
Public Declare Function gethostbyname Lib "WSOCK32.dll" (ByVal szHost$) As Long
Public Declare Function RtlMoveMemory Lib "kernel32" _
  (hpvDest As Any, ByVal hpvSource As Long, ByVal cbCopy As Long) As Long
Public Function GetStatusCode(Status As Long) As String
 Dim msg As String
 Select Case Status
  Case IP_SUCCESS:
                If checksql(Dadd, Duser, Dpass, Ddb) Then
                     msg = "连接成功"
                Else
                     msg = "连接失败"
                End If                    
  Case IP_DEST_HOST_UNREACHABLE: msg = "连接失败"
  Case IP_REQ_TIMED_OUT:  msg = "连接失败"
  Case IP_BAD_DESTINATION:  msg = "连接失败"
  Case Else:
 End Select
 GetStatusCode = msg
End Function

Public Function Ping(szAddress As String, Echo As ICMP_ECHO_REPLY) As Long
 Dim hPort As Long
 Dim dwAddress As Long
 Dim sDataToSend As String
 Dim iOpt As Long
 sDataToSend = "aaa"
 dwAddress = AddressStringToLong(szAddress)
 hPort = IcmpCreateFile()
 If IcmpSendEcho(hPort, dwAddress, sDataToSend, Len(sDataToSend), 0, Echo, Len(Echo), PING_TIMEOUT) Then
   Ping = Echo.RoundTripTime
 Else: Ping = Echo.Status * -1
 End If
 'Call IcmpCloseHandle(hPort)
End Function
Function AddressStringToLong(ByVal tmp As String) As Long
 Dim parts(1 To 4) As String
 I = 0
 While InStr(tmp, ".") > 0
  I = I + 1
  parts(I) = Mid(tmp, 1, InStr(tmp, ".") - 1)
  tmp = Mid(tmp, InStr(tmp, ".") + 1)
  Wend
  I = I + 1
  parts(I) = tmp
  If I <> 4 Then
   AddressStringToLong = 0
   Exit Function
End If
  AddressStringToLong = Val("&H" & Right("00" & Hex(parts(4)), 2) & _
                             Right("00" & Hex(parts(3)), 2) & _
                             Right("00" & Hex(parts(2)), 2) & _
                             Right("00" & Hex(parts(1)), 2))
End Function
Public Function checksql(strSQLServer As String, strAccount As String, strPassword As String, strDBname As String) As Boolean
    Dim cnn As New ADODB.Connection    
    On Error GoTo ErrorHandler
    cnn.ConnectionString = "PROVIDER=SQLOLEDB;Data Source=" & strSQLServer & ";UID=" & strAccount & ";PWD=" & strPassword & ";DATABASE=" & strDBname & ""
    cnn.ConnectionTimeout = 1
    cnn.Open   
    cnn.Close
    checksql = True    
ExitPoint:
    Exit Function    
ErrorHandler:
    checksql = False
    Resume ExitPoint    
End Function

Public Function cnncheck(a As Boolean) As Boolean
 Select Case a
 Case True: Call Ping(Dadd, Echo)
            If GetStatusCode(Echo.Status) = "连接成功" Then
                cnncheck = True
            Else
                cnncheck = False    
            End If
Case False: Dim acn As New ADODB.Connection       
            On Error GoTo ErrorHandler
            acn.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source='" + accessPATH + "';Persist Security Info=False"
            acn.ConnectionTimeout = 1
            acn.Open        
            acn.Close
            cnncheck = True        
ExitPoint:
            Exit Function   
ErrorHandler:
            cnncheck = False
            Resume ExitPoint
End Select
End Function

好久以前做的程序中的服务器连接测试模块，其中用PING检测的功能，你参详一下吧

怎么调用这个呀

调用cnncheck啊，认真看看就行的了

是把3楼和4楼的代码放在一个标准模块里么？