请问各位大虾，VB怎样检测电脑正在上网？又怎样断开网络？

[shareedx]

请问各位大侠，VB用什么方法检测电脑的网络是接通的，也就是电脑正在上网？又怎样断开网络？

[倒大霉的上帝]

Private Declare Function InternetSetOption Lib "wininet.dll" Alias "InternetSetOptionA" (ByVal hInternet As Long, ByVal dwOption As Long, lpBuffer As Any, ByVal dwBufferLength As Long) As Long
 
Private Type internetInfo
        lngconnectedstate As Long
        lngFlags As Long
End Type
  
Private Sub Test()
 
 Dim connectInfo As internetInfo
 Dim lngSuccess As Long
 
   connectInfo.lngconnectedstate = &H10     '断开连接
   connectInfo.lngFlags = 1                 '设置标识
   
   lngSuccess = InternetSetOption(0, 50, connectInfo, Len(connectInfo))
  
   If lngSuccess = 1 Then
        MsgBox "网络断开成功", vbInformation, "测试"
   Else
        MsgBox "网络断开失败", vbInformation, "测试"
   End If
End Sub

Private Sub Command1_Click()
    Call Test
End Sub

[赵4老师]

shell("netstat -na | find /C "ESTABLISHED" >c:\temp.txt",vbHide)
'如果c:\temp.txt文件内容是0表示当前没程序连接网络，否则表示有。

[倒大霉的上帝]

7楼是临时断开Internet
如果是完全断开（受限）
直接：
Private Sub Command1_Click()
Shell "cmd /c ipconfig -release", vbHide
End Sub

[Fanks]

可以通过ping一些常用的站点地址或者网络供应商的服务器地址，根据反馈的结果来判断。

[贝隆]

对，ping

[倒大霉的上帝]

Option Explicit

Private Type QOCINFO
   dwSize As Long
   dwFlags As Long
   dwInSpeed As Long
   dwOutSpeed As Long
End Type

Private Const NETWORK_ALIVE_LAN As Long = &H1
Private Const NETWORK_ALIVE_WAN As Long = &H2
Private Const NETWORK_ALIVE_AOL As Long = &H4
                                                                                            
Private Declare Function IsDestinationReachable Lib "sensapi.dll" _
   Alias "IsDestinationReachableA" _
  (ByVal lpszDestination As String, _
   lpQOCInfo As QOCINFO) As Long

Private Const REG_MULTI_SZ = 7&
Private Const HKEY_LOCAL_MACHINE = &H80000002
Private Const HKEY_TCPIP As String = "SYSTEM\CurrentControlSet\Services\Tcpip\"

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
     
Private Declare Function RegCloseKey Lib "advapi32.dll" _
     (ByVal HKey As Long) As Long

Public Function GetLocalIP() As String
    
    Dim HKey&, strBuf As String, DataBufSize As Long, data$, Subkey$

    On Error Resume Next

    '获得配置ip信息的子键信息
    RegOpenKey HKEY_LOCAL_MACHINE, HKEY_TCPIP & "Linkage", HKey

    '读取缓冲区大小
    RegQueryValueEx HKey, "Route", 0, REG_MULTI_SZ, ByVal 0, DataBufSize

    '建立缓冲区
    strBuf = String$(DataBufSize, Chr$(0))
    RegQueryValueEx HKey, "Route", 0, REG_MULTI_SZ, ByVal strBuf, DataBufSize

    '获取Chr(0)分隔的键值
    data = Left$(strBuf, InStr(1, strBuf, Chr$(0)) - 1)
    '过滤一个"
    Subkey = Mid$(data, 2, Len(data) - 2)

    '获得IP地址
    RegOpenKey HKEY_LOCAL_MACHINE, HKEY_TCPIP & "Parameters\Interfaces\" & Subkey, HKey
    
    RegQueryValueEx HKey, "IPAddress", 0, REG_MULTI_SZ, ByVal 0, DataBufSize
    
    strBuf = String$(DataBufSize, Chr$(0))
    
    RegQueryValueEx HKey, "IPAddress", 0, REG_MULTI_SZ, ByVal strBuf, DataBufSize
    
    GetLocalIP = Left$(strBuf, InStr(1, strBuf, Chr$(0)) - 1)

End Function

Public Function IsNetConnectionAlive(ByVal localIP As String) As Boolean
   
   Dim result As Long
   Dim qoc As QOCINFO

   qoc.dwSize = Len(qoc)
   
   result = IsDestinationReachable(localIP, qoc)  '测试本地IP
   
   IsNetConnectionAlive = qoc.dwFlags
End Function

Private Sub Command1_Click()
   If IsNetConnectionAlive(GetLocalIP) Then
      MsgBox "已连接"
   Else
      MsgBox "连接断开"
   End If
End Sub

[shareedx]

谢谢BestBedGod，你给的程序很好，受益非浅，再请问怎样断开网络呢？

[倒大霉的上帝]

断开网络方式多样：
1:禁用本地连接
2：修改IP地址和域名解析地址
等等。
其中修改IP地址比较简单，直接用
netsh interface ip set address 就行了。

[shareedx]

BestBedGod，还是禁用本地连接好点吧，修改IP地址是改电脑本身的IP地址吗？禁用本地连接很难是吗？

[shareedx]

[Quote=引用 9 楼 bestbadgod 的回复:]
7楼是临时断开Internet
如果是完全断开（受限）
直接：
Private Sub Command1_Click()
Shell "cmd /c ipconfig -release", vbHide
End Sub
[/Quote]

谢谢了，这个好用，7楼的没反应，谢谢你的指点