上次跟你说ping,看你没给分。这次给你代码。其中的connection3就是ping的方法modFunction中:
Option ExplicitPublic Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long
Public Declare Function RegOpenKey Lib "advapi32.dll" Alias "RegOpenKeyA" _
    (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
Public Declare Function RegQueryValueEx Lib "advapi32.dll" Alias "RegQueryValueExA" _
    (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, _
    lpData As Any, lpcbData As Long) As Long
Public Const ERROR_SUCCESS = 0&
Public Const APINULL = 0&
Public Const HKEY_LOCAL_MACHINE = &H80000002
Public Declare Function InternetGetConnectedStateEx Lib "wininet.dll" Alias _
    "InternetGetConnectedStateExA" (ByRef lpdwFlags As Long, ByVal lpszConnectionName As String, _
    ByVal dwNameLen As Long, ByVal dwReserved As Long) As LongPublic Const INTERNET_CONNECTION_MODEM = &H1&
Public Const INTERNET_CONNECTION_LAN = &H2&
Public Const INTERNET_CONNECTION_PROXY = &H4&
Public Const INTERNET_RAS_INSTALLED = &H10&
Public Const INTERNET_CONNECTION_OFFLINE = &H20&
Public Const INTERNET_CONNECTION_CONFIGURED = &H40&
Public Declare Function InternetOpen Lib "wininet.dll" Alias "InternetOpenA" _
    (ByVal lpszAgent As String, ByVal dwAccessType As Long, ByVal lpszProxyName As String, _
    ByVal lpszProxyBypass As String, ByVal dwFlags As Long) As Long
Public Declare Function InternetOpenUrl Lib "wininet.dll" Alias "InternetOpenUrlA" _
    (ByVal hInet As Long, ByVal lpszUrl As String, ByVal lpszHeaders As String, _
    ByVal dwHeadersLength As Long, ByVal dwFlags As Long, ByVal dwContext As Long) As Long
Public Declare Function InternetCloseHandle Lib "wininet.dll" (ByVal hInet As Long) As Long
Public Const INTERNET_OPEN_TYPE_PRECONFIG = 0
Public Const INTERNET_FLAG_RELOAD = &H80000000
Public Const INTERNET_FLAG_KEEP_CONNECTION = &H400000
Public Const INTERNET_FLAG_NO_CACHE_WRITE = &H400000窗体中代码:
Option ExplicitPrivate Sub Form_Load()    Frame1.Caption = "探测方式"
    opt1.Caption = "Modem"
    opt2.Caption = "LAN/Modem"
    opt3.Caption = "Ping"
    
End SubPrivate Sub cmdCheck_Click()
    
    If opt1.Value Then
        CheckConnection1
    ElseIf opt2.Value Then
        CheckConnection2
    ElseIf opt3.Value Then
        CheckConnection3
    Else
        MsgBox "您尚未选择探测方式", vbCritical, "出错"
        Exit Sub
    End If
    
End SubPrivate Sub cmdExit_Click()    Unload Me
    
End SubPrivate Sub CheckConnection1()    Dim ReturnCode As Long
    Dim hKey As Long
    Dim lpSubKey As String
    Dim phkResult As Long
    Dim lpValueName As String
    Dim lpReserved As Long
    Dim lpType As Long
    Dim lpData As Long
    Dim lpcbData As Long
    
    lpSubKey = "System\CurrentControlSet\Services\RemoteAccess" & Chr$(0)
    ReturnCode = RegOpenKey(HKEY_LOCAL_MACHINE, lpSubKey, phkResult)
    If ReturnCode = ERROR_SUCCESS Then
        hKey = phkResult
        lpValueName = "Remote Connection"
        lpReserved = APINULL
        lpType = APINULL
        lpData = APINULL
        lpcbData = APINULL
        ReturnCode = RegQueryValueEx(hKey, lpValueName, lpReserved, lpType, lpData, lpcbData)
        If ReturnCode = ERROR_SUCCESS Then
            If lpData = 0 Then
                MsgBox "你的计算机未通过Modem连接", vbInformation, "连接检测"
            Else
                MsgBox "你的计算机通过Modem接通", vbInformation, "连接检测"
            End If
        Else
            MsgBox "你的计算机未通过Modem连接,但可能通过LAN连接", vbInformation, "连接检测"
        End If
    End If
    RegCloseKey (hKey)End SubPrivate Sub CheckConnection2(Optional ByRef ConnectionInfo As Long, Optional ByRef sConnectionName As String)    Dim lFlags As Long
    Dim sNameBuf As String, msg As String
    Dim lPos As Long
    sNameBuf = String$(513, 0)
    If InternetGetConnectedStateEx(lFlags, sNameBuf, 512, 0&) Then
        lPos = InStr(sNameBuf, vbNullChar)
        If lPos > 0 Then
            sConnectionName = Left$(sNameBuf, lPos - 1)
        Else
            sConnectionName = ""
        End If
        msg = "你的计算机已经接入Internet" & vbCrLf & "连接名:" & sConnectionName
        If (lFlags And INTERNET_CONNECTION_LAN) Then
            msg = msg & vbCrLf & "连接使用了LAN"
        ElseIf (lFlags And INTERNET_CONNECTION_MODEM) Then
            msg = msg & vbCrLf & "连接使用了Modem"
        End If
        If lFlags And INTERNET_CONNECTION_PROXY Then msg = msg & vbCrLf & "连接使用了Proxy"
        If lFlags And INTERNET_RAS_INSTALLED Then
            msg = msg & vbCrLf & "RAS已安装"
        Else
            msg = msg & vbCrLf & "RAS未安装"
        End If
        If lFlags And INTERNET_CONNECTION_OFFLINE Then
            msg = msg & vbCrLf & "您不在线"
        Else
            msg = msg & vbCrLf & "您正在线"
        End If
        If lFlags And INTERNET_CONNECTION_CONFIGURED Then
            msg = msg & vbCrLf & "您的连接已经配置"
        Else
            msg = msg & vbCrLf & "您的连接尚未配置"
        End If
    Else
        msg = "您尚未接入Internet"
    End If
    MsgBox msg, vbInformation, "连接提示"
    
End SubPrivate Sub CheckConnection3()    Dim sTmp As sting
    Dim hInet As Long
    Dim hUrl As Long
    Dim Flags As Long
    Dim url As Variant
    hInet = InternetOpen(App.Title, INTERNET_OPEN_TYPE_PRECONFIG, vbNullString, vbNullString, 0&)
    sTmp = Me.Caption
    Me.Caption = "通过 Ping WWW.CHINA.COM 检测..."
    If hInet Then
        Flags = INTERNET_FLAG_KEEP_CONNECTION Or INTERNET_FLAG_NO_CACHE_WRITE Or INTERNET_FLAG_RELOAD
        hUrl = InternetOpenUrl(hInet, "http://www.china.com", vbNullString, 0, Flags, 0)
        If hUrl Then
            MsgBox "您的计算机已经接入Internet", vbInformation, "接入检测"
            Call InternetCloseHandle(hUrl)
        Else
            MsgBox "您的计算机已经接入Internet", vbInformation, "接入检测"
        End If
    End If
    Call InternetCloseHandle(hInet)
    Me.Caption = sTmp
    
End Sub