方法一:
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 SubPrivate 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
Inet = InternetConnected(eR, sName) SocketsInitialize
If Inet = False Then
MsgBox "没有连接到Internet。"
Exit Sub
ElseIf Inet = True Then
MsgBox "已经连接到Internet。"
Exit Sub
End IfEnd Sub方法二:
Option ExplicitPrivate 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
还可以监测IP,如果时127.0.0.1则没有!
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 SubPrivate 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
Inet = InternetConnected(eR, sName) SocketsInitialize
If Inet = False Then
MsgBox "没有连接到Internet。"
Exit Sub
ElseIf Inet = True Then
MsgBox "已经连接到Internet。"
Exit Sub
End IfEnd Sub方法二:
Option ExplicitPrivate 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
还可以监测IP,如果时127.0.0.1则没有!
看ip是不可靠的。要是用直接电缆连接ip还是会变的。
[email protected]
[email protected]
[email protected]
[email protected]
http://www.applevb.com/sourcecode/connect_to_net.zip
检测是否连接到Internet以及是通过何种方式(Modem,LAN,Proxy)连接到Internet的