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 <> 0 Then
Exit Sub
End If
End Sub
Private Sub TerminateWinSock()
Dim lngRet As Long
lngRet = WSACleanup()
If lngRet <> 0 Then
Exit Sub
End If
End Sub
