VB 高速获取本机是否接入互联网

VB 快速获取本机是否接入互联网
代码如下：


Option Explicit
  
Private Type HOSTENT
    hName As Long
    hAliases As Long
    hAddrType As Integer
    hLength As Integer
    hAddrList As Long
End Type
  
Private Type WSADATA
    wversion As Integer
    wHighVersion As Integer
    szDescription(0 To 256) As Byte
    szSystemStatus(0 To 128) As Byte
    iMaxSockets As Integer
    iMaxUdpDg As Integer
    lpszVendorInfo As Long
End Type
  
Private Declare Function WSAGetLastError Lib "WSOCK32.DLL" () As Long
Private Declare Function WSAStartup Lib "WSOCK32.DLL" (ByVal wVersionRequired As Integer, lpWSAData As WSADATA) As Long
Private Declare Function WSACleanup Lib "WSOCK32.DLL" () As Long
Private Declare Function gethostname Lib "WSOCK32.DLL" (ByVal szHostname As String, ByVal HostLen As Long) As Long
Private Declare Function gethostbyname Lib "WSOCK32.DLL" (ByVal szHostname As String) As Long
Private Declare Sub RtlMoveMemory Lib "KERNEL32" (hpvDest As Any, ByVal hpvSource As Long, ByVal cbCopy As Long)
  
Private Const WS_VERSION_REQD = &H101
  
Public Function DomainNameToIP(URL As String) As String
    InitializeWinSock
    DomainNameToIP = GetAddressByName(URL)
    If DomainNameToIP = "" Then Exit Function '如果网络不通，则退出
    TerminateWinSock
End Function
  
Private Function GetAddressByName(strHostname As String)
    Dim lngAddr As Long
    Dim udtHost As HOSTENT
    Dim lngIP As Long
    Dim bteTmp() As Byte
    Dim i As Integer
    Dim strIP As String
  
    lngAddr = gethostbyname(strHostname)
  
    If lngAddr = 0 Then  '未接入互联网
        GetAddressByName = "" '返回空值
        Exit Function
    End If
  
    RtlMoveMemory udtHost, lngAddr, LenB(udtHost)
    RtlMoveMemory lngIP, udtHost.hAddrList, 4
  
    ReDim bteTmp(1 To udtHost.hLength)
    RtlMoveMemory bteTmp(1), lngIP, udtHost.hLength
    For i = 1 To udtHost.hLength
        strIP = strIP & bteTmp(i) & "."
    Next
    strIP = Mid$(strIP, 1, Len(strIP) - 1) 
 
  
    GetAddressByName = strIP
End Function
  
Private Sub InitializeWinSock()
    Dim udtWSAD As WSADATA
    Dim lngRet As Long
    lngRet = WSAStartup(WS_VERSION_REQD, udtWSAD)
    If lngRet &lt;&gt; 0 Then
      Exit Sub
    End If
End Sub
  
Private Sub TerminateWinSock()
    Dim lngRet As Long
    lngRet = WSACleanup()
    If lngRet &lt;&gt; 0 Then
      Exit Sub
    End If
End Sub

我现在通过DomainNameToIP方法来判断
Dim a As String
a = DomainNameToIP("www.baidu.com")
如果能连接到百度网站，则会返回它的IP，若不能则返回空值。

但是代码运行速度太慢了，我在一台电脑上测试，大概要17秒，大虾们，有木有更快的方法判断是否接入互联网呢？。
需要注意的是：
API函数InternetCheckConnection只能检测出当前计算机是否物理联网，即网线是否接好，网卡是否能顺利工作，不能确定是否能够实现获得 Internet 服务，即不能确定是否能和 ISP 进行 Internet 连接。这时可以通过另一个 Win32 Internet(WinInet) 函数 InternetQueryOption 来检测(是否能够实现获得 Internet 服务)；这个函数的功能是查询指定Internet 句柄的状态、选项。需要说明的是 InternetQueryOption 函数的检测结果只能表明当前的 Internet 设置是可用的，并不能表示计算机一定能访问 Internet，例如网线掉了，网卡突然坏了之类的错误就没法检测出来，要想检测当前计算机是否能够获得 Internet 服务了必须两个函数结合起来使用。请参考这篇文章：检测计算机的 Internet 连接状态(InternetCheckConnection与InternetQueryOption)

VB 高速获取本机是否接入互联网

热点推荐