home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / basic / library / qb_pds / communic / term / term.bas next >
Encoding:
BASIC Source File  |  1992-07-18  |  11.2 KB  |  548 lines
  1. ' TERM.BAS: Public domain terminal package utilizes serial communication ports.
  2. '
  3. ' Note: Compiling instructions;
  4. '       (Microsoft Basic Development System 7.1, Overlay Linker)
  5. '
  6. '       BC TERM/S/O;
  7. '       LINK TERM,,,QBX/E;
  8. '
  9.  
  10. Type RegType
  11.  AX    As Integer
  12.  BX    As Integer
  13.  CX    As Integer
  14.  DX    As Integer
  15.  BP    As Integer
  16.  SI    As Integer
  17.  DI    As Integer
  18.  Flags As Integer
  19. End Type
  20.  
  21. DefStr A-B
  22. DefInt C-Z
  23.  
  24. Common Shared ANSI.TTY%, Baud%, Column, Echo, Flow, Init.Type
  25. Common Shared Inregs As RegType, Linefeeds, Outregs As RegType, Port, Return$
  26. Common Shared Row, Video.Page
  27.  
  28.  
  29. Const False=0
  30. Const True=Not False
  31. Const Version$="v1.0-d"
  32. Return$=Chr$(13)+Chr$(10)
  33.  
  34. Def FNport$
  35.    K$="Port#"+Mid$(Str$(Port),2)
  36.    K$=K$+"/Com#"+Mid$(Str$(Port+1),2)
  37.    K$=K$+":N,8,1"+Return$
  38.    FNport$=K$
  39. End Def
  40.  
  41. Call Get.Video
  42. Call Init.Term
  43.  
  44. Do
  45.    I$=Inkey$
  46.    Select Case Len(I$)
  47.    Case 1
  48.       I=Asc(I$)
  49.       If Echo Then
  50.          If I<>8 Then
  51.             Call Scrn(I$)
  52.          Endif
  53.       Endif
  54.       Inregs.AX=I
  55.       Call Driver(6)
  56.       If I=13 Then
  57.          If Echo Or Linefeeds Then
  58.             Call Scrn(Chr$(10))
  59.          Endif
  60.       Endif
  61.    Case 2
  62.       I=Asc(Right$(I$,1))
  63.       If ANSI.TTY% Then
  64.          Call Out.ANSI(I)
  65.       Endif
  66.       Call Function.Key(I)
  67.    End Select
  68.    Call Driver(5)
  69.    J=(Outregs.AX And &HFF)
  70.    Select Case J
  71.    Case 8
  72.       Call BackSpace
  73.    Case 10
  74.       If Linefeeds Then
  75.          Call Scrn(Chr$(10))
  76.       Endif
  77.    Case 12
  78.       Call Function.Key(46)
  79.    Case 13
  80.       Call Scrn(Return$)
  81.    Case 255
  82.       J=False
  83.    Case Else
  84.       Call Scrn(Chr$(J))
  85.    End Select
  86. Loop
  87. End
  88.  
  89. Sub BackSpace
  90.  Call Get.Cursor
  91.  If Column Then
  92.     Out$=Chr$(27)+"[D"
  93.     Call Scrn(Out$)
  94.     Out$=Chr$(32)
  95.     Call Scrn(Out$)
  96.     Out$=Chr$(27)+"[D"
  97.     Call Scrn(Out$)
  98.  Endif
  99. End Sub
  100.  
  101. Sub Get.Video
  102.  Inregs.AX=&H0F00 ' Get and Store Video Page
  103.  Call Interrupt(&H10,Inregs,Outregs)
  104.  Video.Page=Outregs.BX
  105. End Sub
  106.  
  107. Sub Out.Modem(I$)
  108.  For K=1 To Len(I$)
  109.     Inregs.AX=Asc(Mid$(I$,K,1))
  110.     Call Driver(6)
  111.  Next
  112. End Sub
  113.  
  114. Sub Init.Term
  115.  Key Off
  116.  Locate 24,1,1
  117.  Out$=Chr$(27)+"[24;1H"
  118.  Call Scrn(Out$)
  119.  Call Parse.Command
  120.  Out$="Term "+Version$+Return$
  121.  Call Scrn(Out$)
  122.  Call Init.Driver
  123.  If Init.Type<>2 Then
  124.     Call Function.Key(35)
  125.     Call Pause.Second
  126.     Call Function.Key(31)
  127.  Endif
  128.  If Init.Type=3 Then
  129.     Call Function.Key(45)
  130.  Endif
  131.  Out$="Alt-Z: Display Keys"+Return$
  132.  Call Scrn(Out$)
  133.  Linefeeds=False
  134.  Echo=False
  135. End Sub
  136.  
  137. Sub Init.Driver
  138.  Call Driver(1)
  139.  If Outregs.AX<>&H1954 Then
  140.     Out$="FOSSIL driver not installed."+Return$
  141.     Call Scrn(Out$)
  142.     End
  143.  Endif
  144.  Call Driver(9)
  145. End Sub
  146.  
  147. Sub Pause.Second
  148.  T!=Timer+1
  149.  Do
  150.  Loop Until T!<=Timer
  151. End Sub
  152.  
  153. Sub Driver(Var)
  154.  Select Case Var
  155.  Case 1
  156.     Inregs.AX=&H0400 ' Initialize Driver
  157.  Case 2
  158.     Inregs.AX=&H0600 ' Lower DTR
  159.  Case 3
  160.     Inregs.AX=&H0601 ' Raise DTR
  161.  Case 4
  162.     Select Case Baud% ' Change Baud
  163.     Case 3
  164.        Inregs.AX=&H0043
  165.     Case 6
  166.        Inregs.AX=&H0063
  167.     Case 12
  168.        Inregs.AX=&H0083
  169.     Case 24
  170.        Inregs.AX=&H00A3
  171.     Case 48
  172.        Inregs.AX=&H00C3
  173.     Case 96
  174.        Inregs.AX=&H00E3
  175.     Case 192
  176.        Inregs.AX=&H0003
  177.     Case 384
  178.        Inregs.AX=&H0023
  179.     End Select
  180.  Case 5
  181.     Inregs.AX=&H2000 ' Read Character
  182.  Case 6
  183.     Inregs.AX=Inregs.AX Or &H0B00 ' Send Character
  184.  Case 7
  185.     Inregs.AX=&H0A00 ' Purge Input Buffer
  186.  Case 8
  187.     Inregs.AX=&H0900 ' Purge Output Buffer
  188.  Case 9
  189.     If Flow Then ' Xon/Xoff, RTS/CTS Flow Control
  190.        Inregs.AX=&H0F0B
  191.     Else
  192.        Inregs.AX=&H0F00
  193.     Endif
  194.  End Select
  195.  Inregs.DX=Port ' Call Device Driver
  196.  Call Interrupt(&H14,Inregs,Outregs)
  197. End Sub
  198.  
  199. Sub Out.ANSI(I)
  200.  Select Case I
  201.  Case 71 ' Home
  202.     J$=Chr$(27)+"[H"
  203.  Case 72 ' Up-Arrow
  204.     J$=Chr$(27)+"[A"
  205.  Case 75 ' Left-Arrow
  206.     J$=Chr$(27)+"[D"
  207.  Case 77 ' Right-Arrow
  208.     J$=Chr$(27)+"[C"
  209.  Case 79 ' End
  210.     J$=Chr$(27)+"[K"
  211.  Case 80 ' Down-Arrow
  212.     J$=Chr$(27)+"[B"
  213.  Case 82 ' Insert
  214.     J$=Chr$(22)
  215.  Case 83 ' Delete
  216.     J$=Chr$(127)
  217.  Case 115 ' Control-Left
  218.     J$=Chr$(1)
  219.  Case 116 ' Control-Right
  220.     J$=Chr$(6)
  221.  Case 118 ' Control-PageDown
  222.     J$=Chr$(3)
  223.  Case 132 ' Control-PageUp
  224.     J$=Chr$(18)
  225.  Case Else
  226.     J$=""
  227.  End Select
  228.  Call Out.Modem(J$)
  229. End Sub
  230.  
  231. Sub Parse.Command
  232.  C$=Command$
  233.  If C$="" Then
  234.     Call Term.Usage
  235.  Endif
  236.  L=False
  237.  Do Until C$=""
  238.     M=Instr(C$," ")
  239.     If M Then
  240.        D$=Left$(C$,M-1)
  241.        C$=Mid$(C$,M+1)
  242.     Else
  243.        D$=C$
  244.        C$=""
  245.     Endif
  246.     L=L+1
  247.     Select Case L
  248.     Case 1
  249.        Select Case D$
  250.        Case "1"
  251.           Port=0
  252.        Case "2"
  253.           Port=1
  254.        Case "3"
  255.           Port=2
  256.        Case "4"
  257.           Port=3
  258.        Case Else
  259.           Call Term.Usage
  260.        End Select
  261.     Case 2
  262.        Select Case D$
  263.        Case "3"
  264.           Baud%=3
  265.        Case "12"
  266.           Baud%=12
  267.        Case "24"
  268.           Baud%=24
  269.        Case "48"
  270.           Baud%=48
  271.        Case "96"
  272.           Baud%=96
  273.        Case "192"
  274.           Baud%=192
  275.        Case "384"
  276.           Baud%=384
  277.        Case Else
  278.           Call Term.Usage
  279.        End Select
  280.     Case 3
  281.        Select Case D$
  282.        Case "I"
  283.           Init.Type=1
  284.        Case "N"
  285.           Init.Type=2
  286.        Case "X"
  287.           Init.Type=3
  288.        Case Else
  289.           Call Term.Usage
  290.        End Select
  291.     Case Else
  292.        Call Term.Usage
  293.     End Select
  294.  Loop
  295. End Sub
  296.  
  297. Sub Function.Key(I)
  298.  Call Get.Cursor
  299.  If Column Then
  300.     Call Scrn(Return$)
  301.  Endif
  302.  Select Case I
  303.  Case 30 ' Alt-A
  304.     Out$="Auto Answer"+Return$
  305.     Call Scrn(Out$)
  306.     Call Out.Modem("ATA"+Chr$(13))
  307.  Case 46 ' Alt-C
  308.     Out$="Clear Screen"+Return$
  309.     Call Scrn(Out$)
  310.     Out$=Chr$(27)+"[2J"
  311.     Call Scrn(Out$)
  312.  Case 32 ' Alt-D
  313.     Out$="Enter number: "
  314.     Call Scrn(Out$)
  315.     I$=""
  316.     P$=""
  317.     Do Until I$=Chr$(13)
  318.        If Len(I$)=1 Then
  319.           If I$=Chr$(8) Then
  320.              If Len(P$) Then
  321.                 Call BackSpace
  322.                 P$=Left$(P$,Len(P$)-1)
  323.              Endif
  324.           Else
  325.              If Asc(I$)>=32 And Asc(I$)<=127 Then
  326.                 P$=P$+I$
  327.                 Call Scrn(I$)
  328.              Endif
  329.           Endif
  330.        Endif
  331.        I$=Inkey$
  332.     Loop
  333.     Call Scrn(Return$)
  334.     Out$="Dial Out: "+P$+Return$
  335.     Call Scrn(Out$)
  336.     Call Out.Modem("ATDT"+P$+Return$)
  337.  Case 18 ' Alt-E
  338.     Echo=Not Echo
  339.     Out$="Echo: "
  340.     If Echo Then
  341.        Out$=Out$+"on."
  342.     Else
  343.        Out$=Out$+"off."
  344.     Endif
  345.     Out$=Out$+Return$
  346.     Call Scrn(Out$)
  347.  Case 33 ' Alt-F
  348.     Flow=Not Flow
  349.     Call Driver(9)
  350.     Out$="Flow Control: "
  351.     If Flow Then
  352.        Out$=Out$+"on."
  353.     Else
  354.        Out$=Out$+"off."
  355.     Endif
  356.     Out$=Out$+Return$
  357.     Call Scrn(Out$)
  358.  Case 34 ' Alt-G
  359.     Out$="Sending ANSI Report."+Return$
  360.     Call Scrn(Out$)
  361.     Out$=Chr$(27)+"[6n"
  362.     Call Out.Modem(Out$)
  363.     Out$=""
  364.     T!=Timer+1
  365.     Do
  366.        Call Driver(5)
  367.        J=(Outregs.AX And &HFF)
  368.        If J<>255 Then
  369.           Out$=Out$+Chr$(J)
  370.        Endif
  371.     Loop Until T!<=Timer
  372.     Got.ANSI=False
  373.     If Left$(Out$,1)=Chr$(27) Then
  374.        Out$=Mid$(Out$,2)
  375.        If Left$(Out$,1)="[" Then
  376.           Out$=Mid$(Out$,2)
  377.           While Left$(Out$,1)>="0" And Left$(Out$,1)<="9"
  378.              Out$=Mid$(Out$,2)
  379.           Wend
  380.           If Left$(Out$,1)=";" Then
  381.              Out$=Mid$(Out$,2)
  382.              While Left$(Out$,1)>="0" And Left$(Out$,1)<="9"
  383.                 Out$=Mid$(Out$,2)
  384.              Wend
  385.              If Left$(Out$,1)="R" Then
  386.                 Got.ANSI=True
  387.              Endif
  388.           Endif
  389.        Endif
  390.     Endif
  391.     If Got.ANSI=False Then
  392.        For I=1 To 4
  393.           Out$=Chr$(8)+" "+Chr$(8)
  394.           Call Out.Modem(Out$)
  395.        Next
  396.        Out$="Remote does not have ANSI."
  397.     Else
  398.        Out$="Remote does have ANSI."
  399.     Endif
  400.     Out$=Out$+Return$
  401.     Call Scrn(Out$)
  402.  Case 35 ' Alt-H
  403.     Out$="Drop DTR"+Return$
  404.     Call Scrn(Out$)
  405.     Call Driver(3)
  406.     Call Driver(2)
  407.     Call Driver(7)
  408.     Call Driver(8)
  409.     Call Pause.Second
  410.     Call Driver(3)
  411.     Call Driver(9)
  412.  Case 38 ' Alt-L
  413.     Linefeeds=Not Linefeeds
  414.     Out$="Linefeeds: "
  415.     If Linefeeds Then
  416.        Out$=Out$+"on."
  417.     Else
  418.        Out$=Out$+"off."
  419.     Endif
  420.     Out$=Out$+Return$
  421.     Call Scrn(Out$)
  422.  Case 25 ' Alt-P
  423.     Out$="Enter port(1-4): "
  424.     Call Scrn(Out$)
  425.     I$=""
  426.     While I$=""
  427.        I$=Inkey$
  428.     Wend
  429.     Call Scrn(I$)
  430.     Call Scrn(Return$)
  431.     X=Val(I$)
  432.     X=X-1
  433.     X=Int(X)
  434.     If X=0 Or X=1 Or X=2 Or X=3 Then
  435.        Port=X
  436.        Out$=FNport$
  437.        Call Scrn(Out$)
  438.        Call Init.Driver
  439.     Else
  440.        Beep
  441.     Endif
  442.  Case 31 ' Alt-S
  443.     Out$="Set Baud:"+Str$(Baud%*100)+Return$
  444.     Call Scrn(Out$)
  445.     Call Driver(4)
  446.     Call Driver(9)
  447.  Case 20 ' Alt-T
  448.     ANSI.TTY%=Not ANSI.TTY%
  449.     If ANSI.TTY% Then
  450.        Out$="ANSI TTY: on"
  451.     Else
  452.        Out$="ANSI TTY: off"
  453.     Endif
  454.     Out$=Out$+Return$
  455.     Call Scrn(Out$)
  456.  Case 45 ' Alt-X
  457.     Out$="Exit"+Return$
  458.     Call Scrn(Out$)
  459.     End
  460.  Case 44 ' Alt-Z
  461.     Out$="Help"+Return$
  462.     Call Scrn(Out$)
  463.     Call Display.Keys
  464.  End Select
  465. End Sub
  466.  
  467. Sub Display.Keys
  468.  Out$=FNport$
  469.  Call Scrn(Out$)
  470.  Out$="Alt-A: Auto Answer"+Return$
  471.  Call Scrn(Out$)
  472.  Out$="Alt-C: Clear Screen"+Return$
  473.  Call Scrn(Out$)
  474.  Out$="Alt-D: Dial Out"+Return$
  475.  Call Scrn(Out$)
  476.  Out$="Alt-E: Echo"+Return$
  477.  Call Scrn(Out$)
  478.  Out$="Alt-F: Flow Control"+Return$
  479.  Call Scrn(Out$)
  480.  Out$="Alt-G: Get Remote ANSI"+Return$
  481.  Call Scrn(Out$)
  482.  Out$="Alt-H: Drop DTR"+Return$
  483.  Call Scrn(Out$)
  484.  Out$="Alt-L: Linefeeds"+Return$
  485.  Call Scrn(Out$)
  486.  Out$="Alt-P: Port"+Return$
  487.  Call Scrn(Out$)
  488.  Out$="Alt-S: Set Baud"+Return$
  489.  Call Scrn(Out$)
  490.  Out$="Alt-T: ANSI Terminal"+Return$
  491.  Call Scrn(Out$)
  492.  Out$="Alt-X: Exit Term"+Return$
  493.  Call Scrn(Out$)
  494. End Sub
  495.  
  496. Sub Term.Usage
  497.  Out$="TERM "+Version$+" usage:"+Return$
  498.  Call Scrn(Out$)
  499.  Out$="    Term <port> <baud> <boot>"+Return$
  500.  Call Scrn(Out$)
  501.  Out$="    <port>=1, 2, 3, or 4."+Return$
  502.  Call Scrn(Out$)
  503.  Out$="    <baud>=3, 12, 24, 48, 96, 192, or 384."+Return$
  504.  Call Scrn(Out$)
  505.  Out$="    <boot>=I (do init),"+Return$
  506.  Call Scrn(Out$)
  507.  Out$="           N (no init),"+Return$
  508.  Call Scrn(Out$)
  509.  Out$="           X (init & exit)."+Return$
  510.  Call Scrn(Out$)
  511.  End
  512. End Sub
  513.  
  514. Sub Get.Cursor
  515.  Inregs.AX=&H0300 ' Get Current Cursor Row and Column
  516.  Inregs.BX=Video.Page
  517.  Call Interrupt(&H10,Inregs,Outregs)
  518.  Row=Outregs.DX\256
  519.  Column=Outregs.DX And &H00FF
  520. End Sub
  521.  
  522. Sub Scrn(Var$)
  523.  For Count=1 To Len(Var$)
  524.     Call Get.Cursor
  525.     Char=Asc(Mid$(Var$,Count,1))
  526.     If Row=23 And Char=10 Then
  527.        Count=Count+1
  528.     Else
  529.        If Row=23 Then
  530.           If Char=13 Or Column=79 Then
  531.              Inregs.AX=&H0601 ' Page Scroll
  532.              Inregs.BX=&H0700
  533.              Inregs.CX=&H0000
  534.              Inregs.DX=&H174F
  535.              Call Interrupt(&H10,Inregs,Outregs)
  536.              Inregs.AX=&H0200 ' Set Cursor 24,1
  537.              Inregs.BX=Video.Page
  538.              Inregs.DX=&H1700
  539.              Call Interrupt(&H10,Inregs,Outregs)
  540.           Endif
  541.        Endif
  542.        Inregs.AX=&H0600 ' Character to Standard Out
  543.        Inregs.DX=Char
  544.        Call Interrupt(&H21,Inregs,Outregs)
  545.     Endif
  546.  Next
  547. End Sub
  548.