给你copy一个吧,昨晚上网时偶然看到的,说是调用API函数的,原理我不懂,不过我试过了,确实好用。把下面的代码写到模块里,在你的窗体里调用ICS()过程即可。 '检测Internet网络连接状态 'eg. bConnected = InternetConnected(eR, sName) As Boolean
'InternetConnectionState - API函数定义 Dim eR As EIGCInternetConnectionState Dim sMsg As String Dim sName As String Dim bConnected As Boolean
Private Declare Function InternetSetDialState Lib "wininet.dll" _ (ByVal lpszConnectoid As String, ByVal dwState As Long, _ ByVal dwReserved As Long) As Long
Private Declare Function InternetOpen Lib "wininet.dll" Alias "InternetOpenA" _ (ByVal sAgent As String, ByVal lAccessType As Long, ByVal sProxyName As String, _ ByVal sProxyBypass As String, ByVal lFlags As Long) 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 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 Enum
'InternetConnected 函数判断是否连接到Internet的函数 '获得是否以及通过何中方式连接到Internet上 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 Function
'根据获得的结果输出 If (eR And INTERNET_CONNECTION_MODEM) = INTERNET_CONNECTION_MODEM Then sMsg = sMsg & "使用modem连接到Internet." & vbCrLf End If
If (eR And INTERNET_CONNECTION_LAN) = INTERNET_CONNECTION_LAN Then sMsg = sMsg & "使用内部网连接到Internet." & vbCrLf End If
If (eR And INTERNET_CONNECTION_PROXY) = INTERNET_CONNECTION_PROXY Then sMsg = sMsg & "通过代理服务器连接到Internet." & vbCrLf End If
If (eR And INTERNET_CONNECTION_OFFLINE) = INTERNET_CONNECTION_OFFLINE Then sMsg = sMsg & "现在连接处于离线状态." & vbCrLf End If
If (eR And INTERNET_CONNECTION_CONFIGURED) = INTERNET_CONNECTION_CONFIGURED Then sMsg = sMsg & "连接已经被设定." & vbCrLf Else sMsg = sMsg & "没有设定好的连接." & vbCrLf End If
If (eR And INTERNET_RAS_INSTALLED) = INTERNET_RAS_INSTALLED Then sMsg = sMsg & "本机已经安装了远程访问服务功能." & vbCrLf End If
'显示连接名称 If bConnected Then sMsg = "已连接到Internet,连接名称: " & sName & vbCrLf & vbCrLf & sMsg Else sMsg = "没有连接到Internet,连接名称: " & sName & vbCrLf & vbCrLf & sMsg End If
MsgBox sMsg
End Sub
注册表法: 原理:通过注册表项HKEY_LOCAL_MACHINE\System\CurrentControlSet\Services\RemoteAccess下Remote Connection的值进行判断,该值为0或不存在则没连网,否则则已经连上了INTERNET网。声明以下函数变量常量: Public Const ERROR_SUCCESS = 0& Public Const APINULL = 0& Public Const HKEY_LOCAL_MACHINE = &H80000002 Public ReturnCode As Long Declare Function RegCloseKey Lib "advapi32.dll" (ByVal _hKey As Long) As LongDeclare Function RegOpenKey Lib "advapi32.dll" Alias _"RegOpenKeyA" (ByVal hKey As Long, ByVal lpSubKey As _ String, phkResult As Long) As Long 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 代码: Public Function ActiveConnection() As Boolean Dim hKey As Long Dim lpSubKey As String Dim phkResult As Long Dim lpValueName As String Dim lpReserved As Long Dim lpType As Long Dim lpData As Long Dim lpcbData As Long ActiveConnection = False lpSubKey = "System\CurrentControlSet\Services\RemoteAccess" ReturnCode = RegOpenKey(HKEY_LOCAL_MACHINE, lpSubKey, _ phkResult) If ReturnCode = ERROR_SUCCESS Then hKey = phkResult lpValueName = "Remote Connection" lpReserved = APINULL lpType = APINULL lpData = APINULL lpcbData = APINULL ReturnCode = RegQueryValueEx(hKey, lpValueName, _ lpReserved, lpType, ByVal lpData, lpcbData) lpcbData = Len(lpData) ReturnCode = RegQueryValueEx(hKey, lpValueName, _ lpReserved, lpType, lpData, lpcbData) If ReturnCode = ERROR_SUCCESS Then If lpData = 0 Then ActiveConnection = False Else ActiveConnection = True End If End If RegCloseKey (hKey) End If End Function 下面是使用以上代码的例子: If ActiveConnection = True then Call MsgBox("现在处于链结状态。",vbInformation) Else Call MsgBox("现在处于断开状态。", vbInformation) End If
'检测Internet网络连接状态
'eg. bConnected = InternetConnected(eR, sName) As Boolean
'InternetConnectionState - API函数定义
Dim eR As EIGCInternetConnectionState
Dim sMsg As String
Dim sName As String
Dim bConnected As Boolean
Private Declare Function InternetSetDialState Lib "wininet.dll" _
(ByVal lpszConnectoid As String, ByVal dwState As Long, _
ByVal dwReserved As Long) As Long
Private Declare Function InternetOpen Lib "wininet.dll" Alias "InternetOpenA" _
(ByVal sAgent As String, ByVal lAccessType As Long, ByVal sProxyName As String, _
ByVal sProxyBypass As String, ByVal lFlags As Long) 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 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 Enum
'InternetConnected 函数判断是否连接到Internet的函数
'获得是否以及通过何中方式连接到Internet上
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 Function
Public Sub ICS()
Dim sMsg As String
'InternetConnected 函数的调用
'检测是否已经以及使用什么方法连接到Internet
bConnected = InternetConnected(eR, sName)
'根据获得的结果输出
If (eR And INTERNET_CONNECTION_MODEM) = INTERNET_CONNECTION_MODEM Then
sMsg = sMsg & "使用modem连接到Internet." & vbCrLf
End If
If (eR And INTERNET_CONNECTION_LAN) = INTERNET_CONNECTION_LAN Then
sMsg = sMsg & "使用内部网连接到Internet." & vbCrLf
End If
If (eR And INTERNET_CONNECTION_PROXY) = INTERNET_CONNECTION_PROXY Then
sMsg = sMsg & "通过代理服务器连接到Internet." & vbCrLf
End If
If (eR And INTERNET_CONNECTION_OFFLINE) = INTERNET_CONNECTION_OFFLINE Then
sMsg = sMsg & "现在连接处于离线状态." & vbCrLf
End If
If (eR And INTERNET_CONNECTION_CONFIGURED) = INTERNET_CONNECTION_CONFIGURED Then
sMsg = sMsg & "连接已经被设定." & vbCrLf
Else
sMsg = sMsg & "没有设定好的连接." & vbCrLf
End If
If (eR And INTERNET_RAS_INSTALLED) = INTERNET_RAS_INSTALLED Then
sMsg = sMsg & "本机已经安装了远程访问服务功能." & vbCrLf
End If
'显示连接名称
If bConnected Then
sMsg = "已连接到Internet,连接名称: " & sName & vbCrLf & vbCrLf & sMsg
Else
sMsg = "没有连接到Internet,连接名称: " & sName & vbCrLf & vbCrLf & sMsg
End If
MsgBox sMsg
End Sub
原理:通过注册表项HKEY_LOCAL_MACHINE\System\CurrentControlSet\Services\RemoteAccess下Remote Connection的值进行判断,该值为0或不存在则没连网,否则则已经连上了INTERNET网。声明以下函数变量常量: Public Const ERROR_SUCCESS = 0& Public Const APINULL = 0& Public Const HKEY_LOCAL_MACHINE = &H80000002 Public ReturnCode As Long Declare Function RegCloseKey Lib "advapi32.dll" (ByVal _hKey As Long) As LongDeclare Function RegOpenKey Lib "advapi32.dll" Alias _"RegOpenKeyA" (ByVal hKey As Long, ByVal lpSubKey As _ String, phkResult As Long) As Long 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 代码: Public Function ActiveConnection() As Boolean Dim hKey As Long Dim lpSubKey As String Dim phkResult As Long Dim lpValueName As String Dim lpReserved As Long Dim lpType As Long Dim lpData As Long Dim lpcbData As Long ActiveConnection = False lpSubKey = "System\CurrentControlSet\Services\RemoteAccess" ReturnCode = RegOpenKey(HKEY_LOCAL_MACHINE, lpSubKey, _ phkResult) If ReturnCode = ERROR_SUCCESS Then hKey = phkResult lpValueName = "Remote Connection" lpReserved = APINULL lpType = APINULL lpData = APINULL lpcbData = APINULL ReturnCode = RegQueryValueEx(hKey, lpValueName, _ lpReserved, lpType, ByVal lpData, lpcbData) lpcbData = Len(lpData) ReturnCode = RegQueryValueEx(hKey, lpValueName, _ lpReserved, lpType, lpData, lpcbData) If ReturnCode = ERROR_SUCCESS Then If lpData = 0 Then ActiveConnection = False Else ActiveConnection = True End If End If RegCloseKey (hKey) End If End Function 下面是使用以上代码的例子: If ActiveConnection = True then Call MsgBox("现在处于链结状态。",vbInformation) Else Call MsgBox("现在处于断开状态。", vbInformation) End If