'--------------------------------------------------
' VBTerm - Demonstration program for the MSComm
' communications custom control.  Demonstrates the
' functionality of the control in the context of a
' terminal program.
'
' Copyright (c) 1992, Crescent Software, Inc.
' by Don Malin and Carl Franklin.
'--------------------------------------------------
DefInt A-Z

Option Explicit
                        
Dim Ret                 'Scratch integer
Dim Temp$               'Scratch string
Dim hLogFile            'Handle of open log file
Dim Num$                'Notify Pager Phone Number
Dim capcodes            'Count of Monitored Capcodes
Dim a$                  'Collects Pagers.Ini lines
Dim z$                  'Used to read Pagers.Ini
Dim Newline$            'Used to flag new line of Pagers.Ini
Dim i                   'Used to build Capcode$ Table
Dim j                   'Utility variable
Dim capcode$(250)       'Contains Capcodes of Interest
Dim secret$(250)        'Contains Secret Pager Code to quality capcode
Dim PagersIni$          'Default location of Pagers.Ini
Dim NotifyIni$          'Default location of Notify.Ini
Dim stack$(1000)        'Holds Messages from PD203 for Analysis
Dim stackctr            'Number of Messages in the Stack
Dim ric$                'Capcode to search for in Pagers.Ini Table
Dim Timestamp$          'Timestamp of message of interest
Dim Message$            'Message of interest
Dim stacklength         'Length of stacked message
Dim x                   'Handle for SHELL to Pager Engine
Dim worka$              'Work Area A
Dim Wait                'Determines Wait after a Pageout Request
Dim NextPage$           'Used to collect a new line of pagout data
Dim KeepBackColor       'Used to remember default background color
Dim PageOuts            'Count of Pageouts during this run

Sub About_Click ()
    On Local Error Resume Next

    '--- Display the blurb.
    MsgBox "Listener/MDT for Windows V1.1 Beta (c)1998 Listen$oft / Spectrum Analyzers"
    MsgBox "Visit http://spectrum.base.org/ for MDTW1234 and Listener/MDT Updates --Bonzo--"

End Sub

Sub Form_Load ()

    'Open the MDT Port to begin monitoring.

    MSComm1.PortOpen = 1

    'Tell the User we will get going

    Label1.Caption = "Ready to Receive Data..."

    MDTREnable_Click

End Sub

Sub Form_Resize ()
   
   '--- Resize the Term (display) control and
   '    status bar.
   Line1.X2 = ScaleWidth
   Term.Move 0, Line1.Y2 + 15, ScaleWidth, ScaleHeight - Line1.Y2 + 15
   
End Sub

Sub Form_Unload (Cancel As Integer)
    Dim T&

    If MSComm1.PortOpen Then
       '--- Wait 10 seconds for data to be transmitted
       T& = Timer + 10
       Do While MSComm1.OutBufferCount
          Ret = DoEvents()
          If Timer > T& Then
             Select Case MsgBox("Data cannot be sent", 34)
                '--- Abort
                Case 3
                   Cancel = True
                   Exit Sub
                '--- Retry
                Case 4
                   T& = Timer + 10
                '--- Ignore
                Case 5
                   Exit Do
             End Select
          End If
       Loop

       MSComm1.PortOpen = 0
    End If

    '--- If log file is open, flush and close it
    If hLogFile Then MCloseLog_Click

    End

End Sub

Sub MCloseLog_Click ()

   '--- Close the log file.
   Close hLogFile
   hLogFile = 0
   MOpenLog.Enabled = True
   MCloseLog.Enabled = False
   Form1.Caption = "MSComm Terminal"

End Sub

'--- Toggle DTREnabled property
'
Sub MDTREnable_Click ()
    
    MSComm1.DTREnable = Not MSComm1.DTREnable
    MDTREnable.Checked = MSComm1.DTREnable

End Sub

Sub MFileExit_Click ()
    
    '--- Use Form_Unload since it has code to check
    '    for un sent data and open log file
    Form_Unload Ret

End Sub

'--- Display the value of the CDHolding property.
'
Sub MHCD_Click ()
    
    If MSComm1.CDHolding Then
        Temp$ = "True"
    Else
        Temp$ = "False"
    End If
    MsgBox "CDHolding = " + Temp$

End Sub

'--- Display the value of the CTSHolding property.
'
Sub MHCTS_Click ()
    
    If MSComm1.CTSHolding Then
        Temp$ = "True"
    Else
        Temp$ = "False"
    End If
    MsgBox "CTSHolding = " + Temp$

End Sub

'--- Display the value of the DSRHolding property.
'
Sub MHDSR_Click ()
    
    If MSComm1.DSRHolding Then
        Temp$ = "True"
    Else
        Temp$ = "False"
    End If
    MsgBox "DSRHolding = " + Temp$

End Sub

'*************************************************
'Sets the InputLen property. The InputLen property
'determines how many bytes of data are read each
'time Input is used to retreive data from the
'input buffer. Setting InputLen to 0 specifies that
'the entire contents of the buffer should br read.
'*************************************************
'
Sub MInputLen_Click ()
    On Error Resume Next

    Temp$ = InputBox$("Enter New InputLen:", "InputLen", Str$(MSComm1.InputLen))
    If Len(Temp$) Then
        MSComm1.InputLen = Val(Temp$)
        If Err Then MsgBox Error$, 48
    End If

End Sub

'--- Toggles the state of the port (open or closed).
'
Sub MOpen_Click ()
    On Error Resume Next
    Dim OpenFlag

    MSComm1.PortOpen = Not MSComm1.PortOpen
    If Err Then MsgBox Error$, 48
    
    OpenFlag = MSComm1.PortOpen
    MOpen.Checked = OpenFlag
 
End Sub

Sub MOpenLog_Click ()
   Dim replace
   On Error Resume Next
   
   '--- Get Log File name from the user
   OpenLog.DialogTitle = "Open Communications Log File"
   OpenLog.Filter = "Log Files (*.LOG)|*.log|All Files (*.*)|*.*"
   
   Do
      OpenLog.Filename = ""
      OpenLog.Action = 1
      If Err = CDERR_CANCEL Then Exit Sub
      Temp$ = OpenLog.Filename

      '--- If file already exists, do they want to
      '    overwrite or add to it.
      Ret = Len(Dir$(Temp$))
      If Err Then
         MsgBox Error$, 48
         Exit Sub
      End If
      If Ret Then
         replace = MsgBox("Replace existing file - " + Temp$ + "?", 35)
      Else
         replace = 0
      End If
   Loop While replace = 2

   '--- User picked "Yes" button - Delete file.
   If replace = 6 Then
      Kill Temp$
      If Err Then
         MsgBox Error$, 48
         Exit Sub
      End If
   End If

   '--- Open the log file
   hLogFile = FreeFile
   Open Temp$ For Binary Access Write As hLogFile
   If Err Then
      MsgBox Error$, 48
      Close hLogFile
      hLogFile = 0
      Exit Sub
   Else
      '--- Seek to the end so we append new data
      Seek hLogFile, LOF(hLogFile) + 1
   End If

   Form1.Caption = "Listener/MDT - " + OpenLog.Filetitle
   MOpenLog.Enabled = False
   MCloseLog.Enabled = True

End Sub

'*************************************************
'Sets the ParityReplace property. The
'ParityReplace property holds the character that
'will replace any incorrect characters that are
'received due to a parity error.
'*************************************************
'
Sub MParRep_Click ()
    On Error Resume Next

    Temp$ = InputBox$("Enter Replace Character", "ParityReplace", Form1.MSComm1.ParityReplace)
    Form1.MSComm1.ParityReplace = Left$(Temp$, 1)
    If Err Then MsgBox Error$, 48

End Sub

'*************************************************
'Sets the RThreshold property.  The RThreshold
'property determines how many bytes can arrive at
'the receive buffer before the OnComm event is
'triggered and the CommEvent property is set to
'MSCOMM_EV_RECEIVE
'*************************************************
'
Sub MRThreshold_Click ()
    On Error Resume Next

    Temp$ = InputBox$("Enter New RThreshold:", "RThreshold", Str$(MSComm1.RThreshold))
    If Len(Temp$) Then
        MSComm1.RThreshold = Val(Temp$)
        If Err Then MsgBox Error$, 48
    End If

End Sub

'*************************************************
'The OnComm event is used for trapping
'communications events and errors.
'*************************************************
'
Static Sub MSComm1_OnComm ()
    Dim EVMsg$
    Dim ERMsg$
    
    '--- Branch according to the CommEvent Prop..
    Select Case MSComm1.CommEvent
        '--- Event messages
        Case MSCOMM_EV_RECEIVE
            Showdata Term, (MSComm1.Input)
        Case MSCOMM_EV_SEND
            
        Case MSCOMM_EV_CTS
            EVMsg$ = "Change in CTS Detected"
        Case MSCOMM_EV_DSR
            EVMsg$ = "Change in DSR Detected"
        Case MSCOMM_EV_CD
            EVMsg$ = "Change in CD Detected"
        Case MSCOMM_EV_RING
            EVMsg$ = "The Phone is Ringing"
        Case MSCOMM_EV_EOF
            EVMsg$ = "End of File Detected"

        '--- Error messages
        Case MSCOMM_ER_BREAK
            EVMsg$ = "Break Received"
        Case MSCOMM_ER_CTSTO
            ERMsg$ = "CTS Timeout"
        Case MSCOMM_ER_DSRTO
            ERMsg$ = "DSR Timeout"
        Case MSCOMM_ER_FRAME
            EVMsg$ = "Framing Error"
        Case MSCOMM_ER_OVERRUN
            ERMsg$ = "Overrun Error"
        Case MSCOMM_ER_CDTO
            ERMsg$ = "Carrier Detect Timeout"
        Case MSCOMM_ER_RXOVER
            ERMsg$ = "Receive Buffer Overflow"
        Case MSCOMM_ER_RXPARITY
            EVMsg$ = "Parity Error"
        Case MSCOMM_ER_TXFULL
            ERMsg$ = "Transmit Buffer Full"
        Case Else
            ERMsg$ = "Unknown error or event"
    End Select
    
    If Len(EVMsg$) Then
        '--- Display event messages in label
        Label1.Caption = EVMsg$
        EVMsg$ = ""
    ElseIf Len(ERMsg$) Then
        '--- Display error messages in an alert
        '    message box.
        Beep
        Ret = MsgBox(ERMsg$, 1, "Press Cancel to Quit, Ok to ignore.")
        ERMsg$ = ""
        '--- If Cancel (2) was pressed
        If Ret = 2 Then
            MSComm1.PortOpen = 0    'Close the port and quit
        End If
    End If

End Sub

Sub MSettings_Click ()
    
    '--- Show the communications settings form
    ConfigScrn.Show

End Sub

'*************************************************
'Sets the SThreshold property. The SThreshold
'property determines how many characters (at most)
'have to be waiting in the output buffer before
'the CommEvent property is set to EV_SEND and the
'OnComm event is triggered.
'*************************************************
'
Sub MSThreshold_Click ()
    On Error Resume Next
    
    Temp$ = InputBox$("Enter New SThreshold Value", "SThreshold", Str$(MSComm1.SThreshold))
    If Len(Temp$) Then
        MSComm1.SThreshold = Val(Temp$)
        If Err Then MsgBox Error$, 48
    End If

End Sub

Sub NDial_Click ()
    On Local Error Resume Next
    Static Num$
    
    '--- Get a number from the user.
    Num$ = InputBox$("Enter Phone Number:", "Dial Number", Num$)
    If Num$ = "" Then Exit Sub
    
    '--- Open the port if it isn't already
    If Not MSComm1.PortOpen Then
       MOpen_Click
       If Err Then Exit Sub
    End If
    
    '--- Dial the number
    MSComm1.Output = "ATDT" + Num$ + Chr$(13) + Chr$(10)

End Sub

'**************************************************
'Adds data to the Term control's .Text property.
'Also filters control characters such as Back Space
'Charriage Return and Line Feed, and writes data to
'an open log file.
'
'Back Space chars. delete the character to the left,
'either in the .Text property, or the passed string.
'Line Feed characters are appended to all Charriage
'Returns.  The size of the Term control's Text
'property is also monitored so that it never
'excedes 16384 characters.
'**************************************************
'
Static Sub Showdata (Term As Control, Dta$)
    On Error Resume Next
    Dim Nd, i

    'Okay, we got some data

    Label1.Caption = "Receiving Data Now..."

    'Parse the Datastream for each new input line

    For i = 1 To Len(Dta$)

      a$ = Mid$(Dta$, i, 1)
      j = Asc(a$)

      If j <> 10 And j <> 13 Then
        NextPage$ = NextPage$ + a$
      Else
        If Len(NextPage$) > 10 Then
          NextPage$ = NextPage$

    'Put the message on the Stack for processing

           'stackctr = stackctr + 1
           '
           'If stackctr > 1000 Then
           '  stackctr = stackctr - 1
           '  Label1.Caption = "Stack Space Exceeded-Contact Listen$oft Technical Support at 1-800-WE-HEARU"
           'End If
           '
           'stack$(stackctr) = NextPage$
           'NextPage$ = ""
           '
           'If stackctr < 1000 Then
           '  ric$ = Mid$(stack$(stackctr), 19, 7)
           '  Label1.Caption = "RIC = " + ric$ + " PageOuts = " + Str$(PageOuts) + " Stackctr = " + Str$(stackctr) + " Last Message: " + stack$(stackctr)
           'End If

        End If

      End If

    Next i

    '--- Make sure the existing text doesn't get
    '    too large.
    Nd = Len(Term.Text)
    If Nd >= 16384 Then
       Term.Text = Mid$(Term.Text, 4097)
       Nd = Len(Term.Text)
    End If

    '--- Point to the end of Term's data
    Term.SelStart = Nd

    '--- Filter/handle Back Space characters
    Do
       i = InStr(Dta$, Chr$(8))
       If i Then
          If i = 1 Then
             Term.SelStart = Nd - 1
             Term.SelLength = 1
             Dta$ = Mid$(Dta$, i + 1)
          Else
             Dta$ = Left$(Dta$, i - 2) + Mid$(Dta$, i + 1)
          End If
       End If
    Loop While i

    '--- Elliminate Line Feeds (put back below)
    Do
       i = InStr(Dta$, Chr$(10))
       If i Then
          Dta$ = Left$(Dta$, i - 1) + Mid$(Dta$, i + 1)
       End If
    Loop While i

    '--- Make sure all Charriage Returns have a
    '    Line Feed
    i = 1
    Do
       i = InStr(i, Dta$, Chr$(13))
       If i Then
          Dta$ = Left$(Dta$, i) + Chr$(10) + Mid$(Dta$, i + 1)
          i = i + 1
       End If
    Loop While i

    '--- Add the filtered data to .Text
    Term.SelText = Dta$

    '--- Log data to file if requested
    If hLogFile Then
       i = 2
       Do
          Err = 0
          Put hLogFile, , Dta$
          If Err Then
             i = MsgBox(Error$, 21)
             If i = 2 Then
                MCloseLog_Click
             End If
          End If
       Loop While i <> 2
    End If

    '--- If there are any messages in the Stack, let see if we want
    '--- To page out for any of them
    'If Wait > 0 Then Wait = Wait - 1: ric$ = Mid$(stack$(stackctr), 19, 7): Label1.Caption = "RIC = " + ric$ + " PageOuts = " + Str$(PageOuts) + " Stackctr = " + Str$(stackctr) + " Wait now Contains: " + Str$(Wait)
    'While (stackctr > 0 And Wait = 0)
    '
    '  stacklength = Len(stack$(stackctr))
    '  ric$ = Mid$(stack$(stackctr), 19, 7)
    '  Timestamp$ = Left$(stack$(stackctr), 18)
    '  Message$ = Mid$(stack$(stackctr), 29, stacklength - 29 + 1)
    '
    '  For i = 1 To capcodes
    '   If capcode$(i) = ric$ Then
    '      Label1.Caption = "Capcode " + ric$ + " Matched - Page Out Here"
    '      worka$ = capcode$(i) + "*" + secret$(i) + "*"
    '      Wait = 50
    '
    '      PageOuts = PageOuts + 1
    '
    '      Term.SelText = "Notify: " + stack$(stackctr)
    '
    '      If Num$ <> "" Then x = Shell("pager.exe ATDT" + Num$ + ",,,,,,,," + worka$, 8)
    '    End If
    '  Next i
    '
    '  If stackctr > 0 Then stackctr = stackctr - 1
    '  If Wait = 0 Then
    '    Label1.Caption = "RIC = " + ric$ + " PageOuts = " + Str$(PageOuts) + " Stackctr = " + Str$(stackctr)
    '  Else
    '    Label1.Caption = "RIC = " + ric$ + " PageOuts = " + Str$(PageOuts) + " Stackctr = " + Str$(stackctr) + " Pager Notification In Progress, Wait=" + Str$(Wait)
    '  End If
    '
    'Wend



End Sub

'*************************************************
'Key strokes trapped here are sent to the Comm
'control where they are echoed back via the
'OnComm/MSCOMM_EV_RECEIVE event, and displayed
'through the ShowData procedure.
'*************************************************
'
Sub Term_KeyPress (KeyAscii As Integer)
    
    '--- If the port is openned,
    If MSComm1.PortOpen Then
       '--- Send the key stroke to the port
       MSComm1.Output = Chr$(KeyAscii)
       '--- Unless Echo is on, there is no need to
       '    let the Text control display the key.
       If Not Echo Then KeyAscii = 0
    End If

End Sub

