frmmain.frm

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

    Set mPref_obj = Nothing
End Sub

Private Sub Form_Unload(Cancel As Integer)
    WriteLog App.Title & " End.", vbLogEventTypeWarning
End Sub

Private Sub mnuFileExit_Click()
    cmdExit_Click
End Sub

Private Sub cmdExit_Click()
    On Error Resume Next
    Unload Me
    On Error GoTo 0
End Sub

Private Sub cmdAction_Click()
    Timer1.Enabled = False ' disable auto connect
    If (ConnectionStatus = STATUS_OFFLINE) Then
        Dim connected_bool As Boolean
        connected_bool = Open_connection()
        Timer1.Enabled = True ' timer will retry to reconnect if 1st connection try failed
    ElseIf (ConnectionStatus = STATUS_ONLINE) Then
        Close_connection "Connection terminated by user"
    End If
End Sub

Private Sub mnuFilePref_Click()
    mChildForms_bool(1) = True
    mPref_obj.Show
    mChildForms_bool(1) = False
End Sub

Private Sub mnuHelpAbout_Click()
    mChildForms_bool(0) = True
    
    Dim frmAbout_obj As frmAbout
    Set frmAbout_obj = New frmAbout
    frmAbout.Show vbModal
    Set frmAbout_obj = Nothing
    
    mChildForms_bool(0) = False
End Sub

Private Sub Timer1_Timer()
    ' test if some child form is loaded
    Dim childform_bool As Boolean
    Dim idx As Integer
    For idx = 0 To UBound(mChildForms_bool)
        childform_bool = mChildForms_bool(idx)
        If (childform_bool) Then
            Exit For
        End If
    Next
    
    ' ignore timer event if some child form is loaded
    If (Not childform_bool) Then
        Dim connected_bool As Boolean
        
        lblStatus.Caption = Time
        Timer1.Enabled = False
        Timer1.Interval = mPref_obj.PingDelay * 1000 ' set normal delay after 1st try
        
        ConnectionStatus = STATUS_BUSY
        connected_bool = mInet_obj.IsConnected()
        If (Not connected_bool) Then
            ' connection was lost
            Close_connection "Connection lost" ' make sure it is really terminated
            connected_bool = Open_connection() ' try to reopen connection
        Else
            ConnectionStatus = STATUS_ONLINE
        End If
        
        Timer1.Enabled = True
    End If
    DoEvents
End Sub

' Implementation ----------------------------------------------------------------------------

Public Sub Load_ListRas(trgList_obj As ComboBox)
    Dim psDuns() As String
    Dim piMax As Integer
    Dim idx As Integer
    
    'get list of DUNS on the system
    mInet_obj.ListRAS psDuns
    trgList_obj.Clear
    
    'put list in the listbox
    piMax = -1
    On Error Resume Next
    piMax = UBound(psDuns())
    On Error GoTo 0
    For idx = 0 To piMax
        trgList_obj.AddItem psDuns(idx)
    Next idx
    
    ' select active RAS in combo
    If (trgList_obj.ListCount > 0) Then
        trgList_obj.ListIndex = 0 ' select first entry by default
        With trgList_obj
            For idx = 0 To .ListCount - 1
                If (.List(idx) = mPref_obj.RASConnection) Then
                    .ListIndex = idx
                    Exit For
                End If
            Next
        End With
    End If
  End Sub


' Return True if connection is open
Private Function Open_connection() As Boolean
    Dim connected_bool As Boolean: connected_bool = False
    Dim plResult As Long
    
    With cboConnections
        If .ListIndex = -1 Then
            MsgBox "Please select a Remote Access Service from the list", vbOKOnly + vbExclamation, App.Title
        Else
            ConnectionStatus = STATUS_BUSY ' operation in progress...
            WriteTrace "Connecting  to " & .List(.ListIndex)
            plResult = mInet_obj.Connect(Me.hwnd, .List(.ListIndex))
            If plResult = 0& Or plResult = -1 Then ' connected or already connected
                connected_bool = mInet_obj.IsConnected()
            End If
            If (Not connected_bool) Then
                Call WriteTrace("Error " & plResult & " attempting to connect to " & .List(.ListIndex))
            End If
            ConnectionStatus = IIf(connected_bool, STATUS_ONLINE, STATUS_OFFLINE)
        End If
    End With
    Open_connection = connected_bool
End Function

Private Sub Close_connection(reason_str As String)
    mInet_obj.HangUp
    Call WriteTrace(reason_str)
    ConnectionStatus = STATUS_OFFLINE
End Sub


Private Property Get ConnectionStatus() As CONN_STATUS
    ConnectionStatus = CInt(Val(cmdAction.Tag))
End Property

Private Property Let ConnectionStatus(new_status As CONN_STATUS)
    Static connection_count As Long
    Static online_int As CONN_STATUS
    
    If (new_status = STATUS_ONLINE And (online_int = STATUS_OFFLINE Or online_int = STATUS_UNDEF)) Then
        connection_count = connection_count + 1
        WriteTrace "Connection #" & connection_count & " started at " & Time, txtLog
        online_int = STATUS_ONLINE
        txtLog.ForeColor = &H8000& 'dark green
    ElseIf (new_status = STATUS_OFFLINE And online_int = STATUS_ONLINE) Then
        WriteTrace "Connection #" & connection_count & "  lost at " & Time, txtLog
        online_int = STATUS_OFFLINE
        txtLog.ForeColor = &HFF& 'red
    End If
    
    cmdAction.Tag = CStr(new_status)
    cmdAction.Enabled = True
    lblStatus.Caption = Time & " "
        
    Select Case new_status
        Case STATUS_BUSY:
            cmdAction.Caption = "Busy..."
            cmdAction.BackColor = vbYellow
            lblStatus.Caption = lblStatus.Caption & "Busy..."
            cmdAction.Enabled = False
        Case STATUS_ONLINE:
            cmdAction.Caption = "&Hangup"
            cmdAction.BackColor = vbGreen
            lblStatus.Caption = lblStatus.Caption & "Connected"
        Case STATUS_OFFLINE:
            cmdAction.Caption = "C&onnect"
            cmdAction.BackColor = vbRed
            lblStatus.Caption = lblStatus.Caption & "Not connected"
        Case Else
            ' undefined status
    End Select
    
    DoEvents
End Property


'add supplied text_str to box, log text_str to file
Private Sub WriteTrace(text_str As String, Optional textbox_obj As TextBox = Nothing)
    Const MAX_STATUS_LENGTH = 8 * 1024
    Dim fmt_text_str As String
    fmt_text_str = CStr(Time) & " " & text_str
    
    If (textbox_obj Is Nothing) Then
        Set textbox_obj = txtStatus
    End If
    
    ' log text_str to file
    WriteLog text_str, IIf(textbox_obj Is txtStatus, vbLogEventTypeInformation, vbLogEventTypeWarning)
    
    ' add text_str to box
    With textbox_obj
        .text = .text & fmt_text_str & vbCrLf
        If (Len(.text) > MAX_STATUS_LENGTH) Then
            .text = Right(.text, MAX_STATUS_LENGTH)
        End If
        'scroll text down if necessary
        .SelStart = Len(.text)
        .SelLength = 0
        DoEvents
    End With
End Sub


' EventType: vbLogEventTypeInformation (default), vbLogEventTypeWarning
'Warning:  the LogEvent and StartLogging Methods work only in a compiled DLL. They do not work in the Microsoft Visual Basic IDE.
Private Sub WriteLog(ByVal text As String, Optional ByVal EventType As Long = vbLogEventTypeInformation)
    Static started_bool As Boolean
    
    If (mPref_obj.LogLevel > 0) Then
        If (Not started_bool) Then
            App.StartLogging App.Path & "\" & App.Title & ".log", vbLogToFile
            started_bool = True
        End If
    
        If ((mPref_obj.LogLevel = 1 And EventType = vbLogEventTypeWarning) Or mPref_obj.LogLevel = 2) Then
            App.LogEvent App.Title & " " & CStr(Now) & " " & text, EventType
        End If
    End If
End Sub