Option Explicit
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Copyright ©1996-2011 VBnet/ Randy Birch, All Rights Reserved.
' Some pages may also contain other copyrights by the author.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Distribution: You can freely use this code in your own
' applications, but you may not reproduce
' or publish this code on any web site,
' online service, or distribute as source
' on any media without express permission.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Private Declare Function InternetGetConnectedState Lib "wininet" _
(ByRef dwflags As Long, _
ByVal dwReserved As Long) As Long
'Local system uses a modem to connect to the Internet.
Private Const INTERNET_CONNECTION_MODEM As Long = &H1
'Local system uses a LAN to connect to the Internet.
Private Const INTERNET_CONNECTION_LAN As Long = &H2
'Local system uses a proxy server to connect to the Internet.
Private Const INTERNET_CONNECTION_PROXY As Long = &H4
'No longer used.
Private Const INTERNET_CONNECTION_MODEM_BUSY As Long = &H8
Private Const INTERNET_RAS_INSTALLED As Long = &H10
Private Const INTERNET_CONNECTION_OFFLINE As Long = &H20
Private Const INTERNET_CONNECTION_CONFIGURED As Long = &H40
Private Sub Command1_Click()
Let Text1.Text = IsNetConnectViaLAN()
Let Text2.Text = IsNetConnectViaModem()
Let Text3.Text = IsNetConnectViaProxy()
Let Text4.Text = IsNetConnectOnline()
Let Text5.Text = IsNetRASInstalled()
Let Text6.Text = GetNetConnectString()
End Sub
Function IsNetConnectViaLAN() As Boolean
Dim dwflags As Long
'pass an empty variable into which the API will
'return the flags associated with the connection
Call InternetGetConnectedState(dwflags, 0&)
'return True if the flags indicate a LAN connection
IsNetConnectViaLAN = dwflags And INTERNET_CONNECTION_LAN
End Function
Function IsNetConnectViaModem() As Boolean
Dim dwflags As Long
'pass an empty variable into which the API will
'return the flags associated with the connection
Call InternetGetConnectedState(dwflags, 0&)
'return True if the flags indicate a modem connection
Let IsNetConnectViaModem = dwflags And INTERNET_CONNECTION_MODEM
End Function
Function IsNetConnectViaProxy() As Boolean
Dim dwflags As Long
'pass an empty variable into which the API will
'return the flags associated with the connection
Call InternetGetConnectedState(dwflags, 0&)
'return True if the flags indicate a proxy connection
Let IsNetConnectViaProxy = dwflags And INTERNET_CONNECTION_PROXY
End Function
Function IsNetConnectOnline() As Boolean
'no flags needed here - the API returns True
'if there is a connection of any type
Let IsNetConnectOnline = InternetGetConnectedState(0&, 0&)
End Function
Function IsNetRASInstalled() As Boolean
Dim dwflags As Long
'pass an empty variable into which the API will
'return the flags associated with the connection
Call InternetGetConnectedState(dwflags, 0&)
'return True if the flags include RAS installed
Let IsNetRASInstalled = dwflags And INTERNET_RAS_INSTALLED
End Function
Function GetNetConnectString() As String
Dim dwflags As Long
Dim msg As String
'build a string for display
If InternetGetConnectedState(dwflags, 0&) Then
If dwflags And INTERNET_CONNECTION_CONFIGURED Then
Let msg = msg & "Você tem uma conexão de rede configurada." & vbCrLf
End If
If dwflags And INTERNET_CONNECTION_LAN Then
Let msg = msg & "O sistemas local conecta-se a Internet via LAN"
End If
If dwflags And INTERNET_CONNECTION_PROXY Then
Let msg = msg & ", e usuários no Servidor de Proxy. "
Else
Let msg = msg & "."
End If
If dwflags And INTERNET_CONNECTION_MODEM Then
Let msg = msg & "O sistema local usa um modem para conectar-se a Internet. "
End If
If dwflags And INTERNET_CONNECTION_OFFLINE Then
Let msg = msg & "A conexão está offline. "
End If
If dwflags And INTERNET_CONNECTION_MODEM_BUSY Then
Let msg = msg & "O sistema de Modem local está ocupado com uma conexão non-Internet. "
End If
If dwflags And INTERNET_RAS_INSTALLED Then
Let msg = msg & "Serviço de Acesso Remoto instalado neste sistema."
End If
Else
Let msg = "Não conectado a Internet agora."
End If
Let GetNetConnectString = msg
End Function
