cnetconn.cls

LineWatcher dials your ISP, keeps your connection alive and logs errors. Originally distributed as f

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "CNetConn"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit

Private mPing_obj As CPing


Public Enum NetConnTypeConstants
   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


Private Const RAS_MAXENTRYNAME As Integer = 256
Private Const RAS_MAXDEVICETYPE As Integer = 16
Private Const RAS_MAXDEVICENAME As Integer = 128
Private Const RAS_RASCONNSIZE As Integer = 412

Private Type RasEntryName
    dwSize As Long
    szEntryName(RAS_MAXENTRYNAME) As Byte
End Type

Private Type RasConn
    dwSize As Long
    hRasConn As Long
    szEntryName(RAS_MAXENTRYNAME) As Byte
    szDeviceType(RAS_MAXDEVICETYPE) As Byte
    szDeviceName(RAS_MAXDEVICENAME) As Byte
End Type

Private Declare Function RasEnumConnections Lib _
"rasapi32.dll" Alias "RasEnumConnectionsA" (lpRasConn As _
Any, lpcb As Long, lpcConnections As Long) As Long

Private Declare Function RasHangUp Lib "rasapi32.dll" Alias _
"RasHangUpA" (ByVal hRasConn 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

'   for list RAS's function
Private Declare Function RasEnumEntriesA Lib "rasapi32.dll" (ByVal Reserved As String, ByVal lpszPhonebook As String, lprasentryname As Any, lpcb As Long, lpcEntries As Long) As Long

'   for Dial and Hangup functions
Private Declare Function InternetDial Lib "wininet.dll" (ByVal hwnd As Long, ByVal sConnectoid As String, ByVal dwFlags As Long, lpdwConnection As Long, ByVal dwReserved As Long) As Long
    '       Returns   ERROR_SUCCESS if successfull or one of the following error codes
    '                 ERROR_INVALID_PARAMETER - one or more parameters are incorrect
    '                 ERROR_NO_CONNECTION - There is a problem with the dial-up connection
    '                 ERROR_USER_DISCONNECTION - The user clicked either the work offline or cancel button on the dialog box
'   Flags for InternetAutodial
Private Const INTERNET_AUTODIAL_FORCE_ONLINE = &H1
Private Const INTERNET_AUTODIAL_FORCE_UNATTENDED = &H2
Private Const INTERNET_AUTODIAL_FAILIFSECURITYCHECK = &H4







' Public Interface ------------------------------------------------------------------------------------------------------------

Public PingHostName As String

Public PingEnabled As Boolean ' True=ping host PingHostName to check connection (default); False=check Windows RasConn state only


Public Property Get IsConnected() As Boolean
    IsConnected = NetworkConnected()
End Property

Public Property Get ConnType() As Long
    Dim connInfo As NetConnTypeConstants
    NetworkConnected connInfo
    ConnType = connInfo
End Property

Public Function ConnTypeDevice(nType As Long) As String
    Dim strReturn As String
    
    If nType And INTERNET_CONNECTION_LAN Then
        strReturn = "LAN"
    ElseIf nType And INTERNET_CONNECTION_MODEM Then
        strReturn = "Modem"
    ElseIf nType And INTERNET_CONNECTION_PROXY Then
        strReturn = "Proxy"
    ElseIf nType And INTERNET_CONNECTION_OFFLINE Then
        strReturn = "Offline"
    End If
    
    ConnTypeDevice = strReturn
End Function

Public Property Get ConnName() As String
    Dim strName As String
    NetworkConnected , strName
    ConnName = strName
End Property

Public Sub ListRAS(sRASList() As String)
    Dim plSize As Long
    Dim plEntries As Long
    Dim psConName As String
    Dim plIndex As Long
    Dim RAS(255) As RasEntryName
    
    Erase sRASList()
    RAS(0).dwSize = 264
    plSize = 256 * RAS(0).dwSize
    Call RasEnumEntriesA(vbNullString, vbNullString, RAS(0), plSize, plEntries)
    plEntries = plEntries - 1
    If plEntries >= 0 Then
        ReDim sRASList(plEntries)
        For plIndex = 0 To plEntries
            psConName = StrConv(RAS(plIndex).szEntryName(), vbUnicode)
            sRASList(plIndex) = Left$(psConName, InStr(psConName, vbNullChar) - 1)
        Next plIndex
    End If
End Sub

' return value: 0=Ok
Public Function Connect(hwnd As Long, sRAS As String) As Long
    
    If NetworkConnected() Then
        Connect = -1   'already issued a connection
    Else
        Dim lConnectionNumber As Long
        Connect = InternetDial(hwnd, sRAS, INTERNET_AUTODIAL_FORCE_UNATTENDED, lConnectionNumber, 0&)
    End If
End Function

Public Sub HangUp()
    Dim i As Long
    Dim lpRasConn(255) As RasConn
    Dim lpcb As Long
    Dim lpcConnections As Long
    Dim hRasConn As Long
    Dim ReturnCode As Long
    Dim gstrISPName As String
    
    lpRasConn(0).dwSize = RAS_RASCONNSIZE
    lpcb = RAS_MAXENTRYNAME * lpRasConn(0).dwSize
    lpcConnections = 0
    ReturnCode = RasEnumConnections(lpRasConn(0), lpcb, _
    lpcConnections)

    If ReturnCode = 0 Then
        For i = 0 To lpcConnections - 1
            If Trim(ByteToString(lpRasConn(i).szEntryName)) = Trim(gstrISPName) Then
                hRasConn = lpRasConn(i).hRasConn
                ReturnCode = RasHangUp(ByVal hRasConn)
            End If
        Next i
    End If
End Sub


' Private Stuff --------------------------------------------------------------------------------------------------------------

Private Function NetworkConnected( _
    Optional ByRef eConnectionInfo As NetConnTypeConstants, _
    Optional ByRef sConnectionName As String _
    ) As Boolean
   
    Dim dwFlags As Long
    Dim sNameBuf As String
    Dim lR As Long
    Dim iPos As Long
    Dim connected_bool As Boolean
    
    sNameBuf = String$(513, 0)
    lR = InternetGetConnectedStateEx(dwFlags, sNameBuf, 512, 0&)
    connected_bool = (lR = 1)
    
    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
    
    If (connected_bool And PingEnabled) Then
        ' May be we have LAN connection only: let's ping outside
        connected_bool = InternetConnected()
    End If
    
    NetworkConnected = connected_bool
End Function

Private Function InternetConnected() As Boolean
    Dim status_int As Integer
    Dim error_str As String
    Dim connected_bool As Boolean: connected_bool = False
    Dim fatal_bool As Boolean: fatal_bool = False
    Dim retries_int As Integer: retries_int = 0
    
    Do Until (retries_int = 3 Or connected_bool Or fatal_bool)
        retries_int = retries_int + 1 ' retry on timeout
        Debug.Print PingHostName & " ping #" & retries_int
        status_int = mPing_obj.Ping(PingHostName, 10000, , , error_str)
        If (status_int = 0) Then
            connected_bool = True
        ElseIf (status_int <> -3) Then
            fatal_bool = True ' abort if other <> timeout
        End If
        If (Not connected_bool) Then
            Debug.Print PingHostName & " ping #" & retries_int & " failed: " & error_str
        End If
        DoEvents
    Loop
    
    InternetConnected = connected_bool
End Function

Private Function ByteToString(bytString() As Byte) As String
    Dim i As Integer
    
    i = 0
    While bytString(i) = 0&
        ByteToString = ByteToString & ChrB$(bytString(i))
        i = i + 1
    Wend
End Function


Private Sub Class_Initialize()
    Set mPing_obj = New CPing
    PingHostName = "www.whitehouse.gov"
    PingEnabled = False
End Sub

Private Sub Class_Terminate()
    Set mPing_obj = Nothing
End Sub