用vb怎么测试与internet网络连接状态

Question

方法一：（取注册表信息）
Private Const REG_DWORD = 4                      ' 32-bit number
Private Const HKEY_LOCAL_MACHINE = &H80000002
Private Declare Function RegOpenKey Lib "advapi32.dll" Alias "RegOpenKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
Private 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         ' Note that if you declare the lpData parameter as String, you must pass it By Value.
Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As LongFunction CheckNet() As Boolean
Dim lData As Long, lType As Long, lSize As Long
Dim hKey As Long, Qry As Long
    Qry = RegOpenKey(HKEY_LOCAL_MACHINE, "System\CurrentControlSet\Services\RemoteAccess", hKey)
    If Qry <> 0 Then
          MsgBox "Can't Open Statistics Key"
          End
    End If
    lType = REG_DWORD
    lSize = 4
    Qry = RegQueryValueEx(hKey, "Remote Connection", 0, lType, lData, lSize)
If lData = 1 Then
CheckNet = True
Else
CheckNet = False
End If
    Qry = RegCloseKey(hKey)
End FunctionPrivate Sub Command1_Click()
If CheckNet = True Then
   MsgBox "已经连接到因特网！"
Else
   MsgBox "没有连接到因特网！"
End If
End Sub
Private Function InternetConnected(Optional ByRef eConnectionInfo _
    As EIGCInternetConnectionState, Optional ByRef _
    sConnectionName As String) As Boolean
    
    Dim dwFlags As Long
    Dim sNameBuf As String
    Dim lR As Long
    Dim iPos As Long
    
    sNameBuf = String$(513, 0)
    lR = InternetGetConnectedStateEx(dwFlags, sNameBuf, 512, 0&)
    eConnectionInfo = dwFlags
    iPos = InStr(sNameBuf, vbNullChar)
    If iPos > 0 Then
        sConnectionName = Left$(sNameBuf, iPos - 1)
    ElseIf Not sNameBuf = String$(513, 0) Then
        sConnectionName = sNameBuf
    End If
    InternetConnected = (lR = 1)
End FunctionPrivate Sub Command1_Click()
Dim Inet As Boolean
Dim eR As EIGCInternetConnectionState
Dim sName As String    If Inet = False Then
        MsgBox "没有连接到Internet。"
        Exit Sub
    ElseIf Inet = True Then
        MsgBox "已经连接到Internet。"
        Exit Sub
    End IfEnd SubPrivate Sub Form_Load()
      Inet = InternetConnected(eR, sName)  SocketsInitializeEnd Sub
   方法二：（API）
Option ExplicitPrivate Enum EIGCInternetConnectionState
        INTERNET_CONNECTION_MODEM = &H1&
        INTERNET_CONNECTION_LAN = &H2&
        INTERNET_CONNECTION_PROXY = &H4&
        INTERNET_RAS_INSTALLED = &H10&
        INTERNET_CONNECTION_OFFLINE = &H20&
        INTERNET_CONNECTION_CONFIGURED = &H40&
End EnumPrivate Declare Function WSAStartup Lib "WSOCK32.DLL" (ByVal wVersionRequired&, lpWSAData As WSADATA) As Long
Private 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 Long
        
Private Const WSADescription_Len = 256
Private Const WS_VERSION_REQD = &H101
Private Const WSASYS_Status_Len = 128
Private Const WS_VERSION_MAJOR = WS_VERSION_REQD \ &H100 And &HFF&
Private Const WS_VERSION_MINOR = WS_VERSION_REQD And &HFF&
Private Const MIN_SOCKETS_REQD = 1Private Type WSADATA
  wversion As Integer
  wHighVersion As Integer
  szDescription(0 To WSADescription_Len) As Byte
  szSystemStatus(0 To WSASYS_Status_Len) As Byte
  iMaxSockets As Integer
  iMaxUdpDg As Integer
  lpszVendorInfo As Long
End TypeFunction lobyte(ByVal wParam As Integer)
  lobyte = wParam And &HFF&
End FunctionFunction hibyte(ByVal wParam As Integer)
  hibyte = wParam \ &H100 And &HFF&
End FunctionSub SocketsInitialize()
  
  Dim WSAD As WSADATA
  Dim iReturn As Integer
  Dim sLowByte As String, sHighByte As String, sMsg As String
  
  iReturn = WSAStartup(WS_VERSION_REQD, WSAD)
  
  If iReturn <> 0 Then
      MsgBox "Winsock.dll is not responding."
      End
  End If
  
  If lobyte(WSAD.wversion) < WS_VERSION_MAJOR Or (lobyte(WSAD.wversion) = WS_VERSION_MAJOR And hibyte(WSAD.wversion) < WS_VERSION_MINOR) Then
      sHighByte = Trim$(Str$(hibyte(WSAD.wversion)))
      sLowByte = Trim$(Str$(lobyte(WSAD.wversion)))
      sMsg = "Windows Sockets version " & sLowByte & "." & sHighByte
      sMsg = sMsg & " is not supported by winsock.dll "
      MsgBox sMsg
      End
  End If
  
  If WSAD.iMaxSockets < MIN_SOCKETS_REQD Then
      sMsg = "This application requires a minimum of "
      sMsg = sMsg & Trim$(Str$(MIN_SOCKETS_REQD)) & " supported sockets."
      MsgBox sMsg
      End
  End If
  
End Sub

Answer 1

    如何检测是否已连接到Internet？
 
　
声明：Public Declare Function RasEnumConnections Lib "RasApi32.dll" _
    Alias "RasEnumConnectionsA" (lpRasCon As Any, _
    lpcb As Long, lpcConnections As Long) As Long
Public Declare Function RasGetConnectStatus Lib "RasApi32.dll" _
    Alias "RasGetConnectStatusA" (ByVal hRasCon As Long, _
    lpStatus As Any) As LongPublic Const RAS95_MaxEntryName = 256
Public Const RAS95_MaxDeviceType = 16
Public Const RAS95_MaxDeviceName = 32Public Type RASCONN95
    dwSize As Long
    hRasCon As Long
    szEntryName(RAS95_MaxEntryName) As Byte
    szDeviceType(RAS95_MaxDeviceType) As Byte
    szDeviceName(RAS95_MaxDeviceName) As Byte
End TypePublic Type RASCONNSTATUS95
    dwSize As Long
    RasConnState As Long
    dwError As Long
    szDeviceType(RAS95_MaxDeviceType) As Byte
    szDeviceName(RAS95_MaxDeviceName) As Byte
End Type程序：
Private Sub main()
    If IsConnected = True Then
        MsgBox "已连接到Internet！", vbInformation, "提示"
    Else
        MsgBox "未连接到Internet！", vbInformation, "提示"
    End If
End SubPublic Function IsConnected() As Boolean
    Dim TRasCon(255) As RASCONN95
    Dim lg As Long
    Dim lpcon As Long
    Dim RetVal As Long
    Dim Tstatus As RASCONNSTATUS95
    '
    TRasCon(0).dwSize = 412
    lg = 256 * TRasCon(0).dwSize
    '
    RetVal = RasEnumConnections(TRasCon(0), lg, lpcon)
    If RetVal <> 0 Then
        MsgBox "产生错误！", vbInformation, "提示"
        Exit Function
    End If
    '
    Tstatus.dwSize = 160
    RetVal = RasGetConnectStatus(TRasCon(0).hRasCon, Tstatus)
    If Tstatus.RasConnState = &H2000 Then
        IsConnected = True
    Else
        IsConnected = False
    End If
End Function
 
   
　
  
 

Answer 2

我以上的程序在局域网运行不能检测，推荐用以下代码
http://www.applevb.com/sourcecode/snet.htm
一个检查是否连接Internet的程序 下载(16.7K)

Answer 3

具体的下载位置：
http://www.applevb.com/sourcecode/connect_to_net.zip