Visual Basic 4 Power Pack/Visual_Basic4_Power_Pack.bin/vb4files/pclvbw11/logline.bas

BASIC Source File | 1996-11-20 | 6.0 KB | 241 lines

' LOGIN.BAS
Option Explicit

Dim FatalFlag As Integer
Dim Code As Integer

Sub Aborting ()
  Dim Code As Integer
  LOGIN.Print "Fatal Error, Aborting..."
  Code = SioDone(ThePort)
  End
End Sub

Sub DisplayChar (ByVal C As Integer)
  Dim Row As Integer
  Dim Col As Integer
  C = &H7F And C
  'process char
  If C = 13 Then
    'carriage control
    CurrentCol = 0
    'plus assumed line feed
    If CurrentRow < 23 Then
      CurrentRow = CurrentRow + 1
      'print CR+LF
      LOGIN.Print
    Else
      'scroll !
      LOGIN.Cls
      For Row = 0 To 22
        'print row
        ScreenBuffer(Row) = ScreenBuffer(Row + 1)
        LOGIN.Print ScreenBuffer(Row)
      Next Row
      'clear bottom row
      ScreenBuffer(23) = Space$(80)
    End If
  ElseIf C = 10 Then
    'throw away line feeds
  Else
    'not CR or LF
    CurrentCol = CurrentCol + 1
    If CurrentCol > 79 Then
      'throw away !
      Exit Sub
    Else
      'save in screen buffer & display
      Mid$(ScreenBuffer(CurrentRow), CurrentCol, 1) = Chr$(C)
      LOGIN.Print Chr$(C);
    End If
  End If
End Sub

Sub DisplayString (Text As String)
  Dim I As Integer
  Dim Length As Integer
  Length = Len(Text)
  For I = 1 To Length
    Call DisplayChar(Asc(Mid$(Text, I, 1)))
  Next I
  Call DisplayChar(13)
End Sub

Function GetDosMemory (SizeCode As Integer)
  Dim Size As Long
  Dim Value As Long
  If SizeCode > Size32K Then
    LOGIN.Print "SizeCode out of range"
    GetDosMemory = 0
    Exit Function
  End If
  Size = 2 ^ (SizeCode + 4)
  Value = GlobalDosAlloc(Size)
  If Value Then
    'return selector
    GetDosMemory = (&HFFFF& And Value)
  Else
    LOGIN.Print "Cannot allocate Dos memory ("; Size; ")"
    GetDosMemory = 0
  End If

End Function

Sub GetIncoming ()
  Dim I As Integer
  Dim TheChar As Integer
  Dim Code As Integer
  'is modem I/O (MIO) running ?
  If MIOstate Then
    'MIO is running
    TheChar = mioDriver(ThePort)
    If TheChar = MIO_IDLE Then
      'time to go to next MIO state (since driver is idle)
      Select Case MIOstate
        '*** HANDSHAKE states ***
        Case Handshake_1
          'send "AT" to modem
          Code = mioSendTo(ThePort, 100&, "!AT!")
          MIOstate = Handshake_2
        Case Handshake_2
          'expect "OK" back
          Code = mioWaitFor(ThePort, 3000&, 1, "OK")
          MIOstate = Handshake_3
        Case Handshake_3
          'did we get expected result ("OK")
          If mioResult(ThePort) Then
            DisplayString (">>>OK was received")
          Else
            DisplayString (">>>OK was NOT received!")
          End If
          'all done
          MIOstate = 0
          LOGIN.menuStart.Enabled = True
          LOGIN.menuBREAK.Enabled = False
        '*** DIAL states ***
        Case Dial_1
          'dial modem
          Code = mioSendTo(ThePort, 100&, "!ATDT880,9748!")
          MIOstate = Dial_2
        Case Dial_2
          'expect "CONNECT" back (wait up to 60 seconds)
          If mioWaitFor(ThePort, 60000, 1, "CONNECT") Then
            MIOstate = Dial_3
          Else
            'error!
            DisplayString (">>>mioWaitFor fails!")
          End If
        Case Dial_3
          'did we get expected result ("CONNECT")
          If mioResult(ThePort) Then
            DisplayString (">>>CONNECT was received")
          Else
            DisplayString (">>>CONNECT was NOT received!")
          End If
          'all done
          MIOstate = 0
          LOGIN.menuBREAK.Enabled = False
          LOGIN.menuStart.Enabled = True
      End Select
    Else
      'MIO is not IDLE
      If TheChar <> MIO_RUNNING Then
        Call DisplayChar(TheChar)
      End If
    End If
  Else
  'MIO not in use
    For I = 1 To 1000
      TheChar = SioGetc(ThePort, 0)
      If TheChar > 0 Then
        Call DisplayChar(TheChar)
        '''Call DisplayString("{" + Hex$(TheChar) + "}")
      Else
        Exit For
      End If
    Next I
  End If
End Sub

Sub GoOffLine ()
  Dim Code As Integer
  OnLineFlag = 0
  'shut down port
  Code = SioDone(ThePort)
  'free DOS memory
  If TxSelector <> 0 Then
    '''Code = GlobalPageUnlock(TxSelector)
    Code = GlobalDosFree(TxSelector)
    TxSelector = 0
  End If
  If RxSelector <> 0 Then
    '''Code = GlobalPageUnlock(RxSelector)
    Code = GlobalDosFree(RxSelector)
    RxSelector = 0
  End If

End Sub

Sub GoOnLine ()
  Dim I As Integer
  If OnLineFlag Then
    Exit Sub
  End If
  'allocating RX buffer
  RxSelector = GetDosMemory(Size1024)
  Code = SioRxBuf(ThePort, RxSelector, Size1024)
  If Code < 0 Then
    LOGIN.Print "Cannot allocate RX buffer"
    Exit Sub
  End If
  'allocate TX buffer
  TxSelector = GetDosMemory(Size128)
  Code = SioTxBuf(ThePort, TxSelector, Size128)
  If Code < 0 Then
    LOGIN.Print "Cannot allocate TX buffer"
    Exit Sub
  End If
  'reset the port
  Code = SioReset(ThePort, TheBaudCode)
  If Code < 0 Then
    Call SioError(LOGIN, Code)
    Exit Sub
  End If
  'call Aborting() if detect error after resetting port
  Call DisplayString("COM" + LTrim$(Str$(1 + ThePort)) + " reset")
  'set DTR & RTS
  Code = SioDTR(ThePort, Asc("S"))
  Code = SioRTS(ThePort, Asc("S"))
  'turn on hardware flow control
  Code = SioFlow(ThePort, 18)
  Call DisplayString("RTS/CTS flow control on")
  'turn on UART FIFO if 16550
  Code = SioFIFO(ThePort, LEVEL_8)
  If Code > 0 Then
    Call DisplayString("16550 Detected")
  End If
  ' set parms
  Code = SioParms(ThePort, TheParity, TheStopBits, TheDataBits)
  ' we're online !
  OnLineFlag = 1
End Sub

Sub ShowConfig ()
  Dim A As String
  Dim B As String
  Dim C As String
  Dim D As String
  Dim E As String
  If OnLineFlag Then
    A = " (Online)"
  Else
    A = " (Offline)"
  End If
  B = "COM" + LTrim$(Str$(ThePort + 1))
  C = " @ " + BaudText(TheBaudCode) + " "
  D = Str$(5 + TheDataBits) + ParityText(TheParity)
  E = LTrim$(Str$(1 + TheStopBits))
  LOGIN.Caption = "LOGIN: " + B + C + D + E + A
End Sub