home *** CD-ROM | disk | FTP | other *** search
/ CD Shareware Magazine 1996 December / CD_shareware_12-96.iso / WIN / Programa / WSC4VB10.ZIP / RS_LINE.BAS < prev    next >
Encoding:
BASIC Source File  |  1996-08-25  |  3.7 KB  |  162 lines
  1. ' RS_LINE.BAS
  2.  
  3. Option Explicit
  4.  
  5. Dim FatalFlag As Integer
  6. Dim Code As Integer
  7.  
  8. Sub Aborting ()
  9.   Dim Code As Integer
  10.   RS232.Print "Fatal Error, Aborting..."
  11.   Code = SioDone(ThePort)
  12.   End
  13. End Sub
  14.  
  15. Sub DisplayChar (ByVal C As Integer)
  16.   Dim Row As Integer
  17.   Dim Col As Integer
  18.   C = &H7F And C
  19.   'process char
  20.   If C = 13 Then
  21.     'carriage control
  22.     CurrentCol = 0
  23.     'plus assumed line feed
  24.     If CurrentRow < 23 Then
  25.       CurrentRow = CurrentRow + 1
  26.       'print CR+LF
  27.       RS232.Print
  28.     Else
  29.       'scroll !
  30.       RS232.Cls
  31.       For Row = 0 To 22
  32.         'print row
  33.         ScreenBuffer(Row) = ScreenBuffer(Row + 1)
  34.         RS232.Print ScreenBuffer(Row)
  35.       Next Row
  36.       'clear bottom row
  37.       ScreenBuffer(23) = Space$(80)
  38.     End If
  39.   ElseIf C = 10 Then
  40.     'throw away line feeds
  41.   Else
  42.     'not CR or LF
  43.     CurrentCol = CurrentCol + 1
  44.     If CurrentCol > 79 Then
  45.       'throw away !
  46.       Exit Sub
  47.     Else
  48.       'save in screen buffer
  49.       Mid$(ScreenBuffer(CurrentRow), CurrentCol, 1) = Chr$(C)
  50.       'display character
  51.       If DataFlag = 0 Then
  52.         RS232.Print Chr$(C);
  53.       Else
  54.         RS232.Print Hex$(C);
  55.       End If
  56.     End If
  57.   End If
  58. End Sub
  59.  
  60. Sub DisplayString (Text As String)
  61.   Dim i As Integer
  62.   Dim Length As Integer
  63.   Length = Len(Text)
  64.   For i = 1 To Length
  65.     Call DisplayChar(Asc(Mid$(Text, i, 1)))
  66.   Next i
  67.   Call DisplayChar(13)
  68. End Sub
  69.  
  70. Sub GetIncoming ()
  71.   Dim i As Integer
  72.   Dim Buffer As String * 1024
  73.   Dim Count As Integer
  74.   Count = SioGets(ThePort, Buffer, 1024)
  75.   If Count > 0 Then
  76.     For i = 1 To Count
  77.       Call DisplayChar(Asc(Mid$(Buffer, i, 1)))
  78.     Next i
  79.   End If
  80. End Sub
  81.  
  82. Sub GoOffLine ()
  83.   Dim Code As Integer
  84.   RS232.menuPort.Enabled = True
  85.   RS232.menuStatus.Enabled = False
  86.   RS232.menuControl.Enabled = False
  87.   RS232.menuFlow.Enabled = False
  88.   OnLineFlag = 0
  89.   'shut down port
  90.   Code = SioDone(ThePort)
  91. End Sub
  92.  
  93. Sub GoOnLine ()
  94.   Dim i As Integer
  95.   Dim RxQueSize As Integer
  96.   Dim TxQueSize As Integer
  97.   If OnLineFlag Then
  98.     Exit Sub
  99.   End If
  100.   'reset the port (1024 byte RX buffer & 512 byte TX buffer)
  101.   RxQueSize = 1024
  102.   TxQueSize = 512
  103.   Code = SioReset(ThePort, RxQueSize, TxQueSize)
  104.   If Code < 0 Then
  105.     Call SayError(RS232, Code)
  106.     Exit Sub
  107.   End If
  108.   'set baud rate
  109.   Code = SioBaud(ThePort, TheBaudCode)
  110.   'call Aborting() if detect error after resetting port
  111.   Call DisplayString("[COM" + LTrim$(Str$(1 + ThePort)) + " reset]")
  112.   ' set parms
  113.   Code = SioParms(ThePort, TheParity, TheStopBits, TheDataBits)
  114.   'set DTR
  115.   Code = SioDTR(ThePort, Asc("S"))
  116.   RS232.menuSetDTR.Enabled = False
  117.   RS232.menuSetDTR.Checked = True
  118.   RS232.menuClearDTR.Enabled = True
  119.   RS232.menuClearDTR.Checked = False
  120.   'set RTS
  121.   Code = SioRTS(ThePort, Asc("S"))
  122.   RS232.menuSetRTS.Enabled = False
  123.   RS232.menuSetRTS.Checked = True
  124.   RS232.menuClearRTS.Enabled = True
  125.   RS232.menuClearRTS.Checked = False
  126.   ' we're online !
  127.   OnLineFlag = 1
  128.   RS232.menuPort.Enabled = False
  129.   RS232.menuStatus.Enabled = True
  130.   RS232.menuControl.Enabled = True
  131.   RS232.menuFlow.Enabled = True
  132. End Sub
  133.  
  134. Sub SetBaud ()
  135. Dim Code As Integer
  136. 'Baudrate can be changed while running
  137. Code = SioBaud(ThePort, TheBaudCode)
  138. End Sub
  139.  
  140. Sub ShowConfig ()
  141.   Dim A As String
  142.   Dim B As String
  143.   Dim C As String
  144.   Dim D As String
  145.   Dim E As String
  146.   If OnLineFlag Then
  147.     A = " (Online)"
  148.   Else
  149.     A = " (Offline)"
  150.   End If
  151.   B = "COM" + LTrim$(Str$(ThePort + 1))
  152.   C = " @ " + BaudRateTable(TheBaudCode) + " "
  153.   D = Str$(TheDataBits) + ParityText(TheParity)
  154.   If TheStopBits = 0 Then
  155.     E = "1"
  156.   Else
  157.     E = "2"
  158.   End If
  159.   RS232.Caption = "RS232: " + B + C + D + E + A
  160. End Sub
  161.  
  162.