home *** CD-ROM | disk | FTP | other *** search
/ Media Share 9 / MEDIASHARE_09.ISO / bbs / samps.zip / TERM4.PAS < prev   
Pascal/Delphi Source File  |  1991-02-02  |  18KB  |  733 lines
  1. Program Term4;
  2. {$M 2512,0,1024}
  3.  
  4.         { Terminal program Version 1.0 by Martin Stubbs G8IMB }
  5.         { Written specifically to test the new BPQ interface  }
  6.         { Comments and improvements welcome                   }
  7.  
  8. Uses Crt,Dos;
  9.  
  10. const
  11.   CR     = #$0D;
  12.   LF     = #$0A;
  13.   CRLF   = CR+LF;
  14. var
  15.  
  16.   Ch          : Char;
  17.   err         : Integer;
  18.   I           : integer;
  19.   p           : Integer;
  20.   S           : Byte;
  21.   port        : Integer;
  22.   Stream      : Byte;
  23.   Call        : String[10];
  24.   TimeSt      : String[20];
  25.   Conok       : Boolean;
  26.   Connected   : Boolean;
  27.   Monitor     : Byte;
  28.   Last        : Boolean;
  29.  
  30.   Quit        : Boolean;
  31.   xloc,yloc   : Integer;
  32.   xkeep,ykeep : Integer;
  33.   row,col     : Integer;
  34.   Show_status : Boolean;
  35.  
  36.   Regs        : Registers;
  37.  
  38.   BPQbuff     : Array [1..256] of byte;
  39.   IBuffer     : String[255];
  40.   locbuff     : String[255];
  41.  
  42.  
  43. Procedure DV_Nice;          {Give time slice to next task}
  44.   begin
  45.     regs.ax := $1000;
  46.     Intr($15, regs);
  47.   end;
  48.  
  49. Procedure Cursor(On:Boolean);
  50. Begin
  51.   With regs do
  52.   Begin
  53.     If On then Ch := 6
  54.           else Ch := $20;
  55.     AH := $01;
  56.     CL := $07;
  57.     Intr($10,regs);
  58.   end;
  59. End;
  60.  
  61. Procedure Display(St:String);
  62. Begin
  63.   Window(1,4,80,22);
  64.   GotoXY(xkeep,ykeep);
  65.   WriteLn(St);                { Write it out to screen }
  66.   Xkeep := WhereX;
  67.   Ykeep := WhereY;
  68.   Window(1,24,80,24);            { Swop back to lower screen }
  69.   GoToXy(Xloc,Yloc);
  70.  
  71. End;
  72.  
  73. Function Time:String;
  74. Var
  75.   X : Word;
  76.   I : Integer;
  77.   Timarr: Array[1..6] of word;
  78.   Timst : Array[1..6] of string[4];
  79.  
  80. Begin
  81.   GetDate(Timarr[3],Timarr[2],Timarr[1],x);
  82.   GetTime(Timarr[4],Timarr[5],Timarr[6],x);
  83.  
  84.   For I := 1 to 6 do
  85.   Begin
  86.     Str(Timarr[I]:2,Timst[I]);
  87.     If Timst[I,1]=' ' then Timst[I,1] := '0';
  88.   End;
  89.  
  90.   Time := timst[1]+'/'+timst[2]+'/'+timst[3]+'  '+
  91.           timst[4]+':'+timst[5]+':'+timst[6];
  92. End;
  93.  
  94. Procedure Get_resp;
  95. Var
  96.   I    : Integer;
  97.  
  98. Begin
  99.  
  100.   Repeat
  101.     regs.di := Ofs(BPQbuff);
  102.     regs.es := Seg(BPQbuff);
  103.     regs.ah := $03;
  104.     regs.al := port;
  105.     intr($7F,regs);
  106.  
  107.     If regs.cx > 0 then             { Is there any data }
  108.     Begin
  109.       Window(1,4,80,22);
  110.       GotoXY(xkeep,ykeep);
  111.       For I := 1 to regs.cx do
  112.       Begin
  113.         Write(Chr(BPQbuff[I]));                { Write it out to screen }
  114.         If BPQbuff[I] = $0D then WriteLn;
  115.       End;
  116.       Xkeep := WhereX;
  117.       Ykeep := WhereY;
  118.       Window(1,24,80,24);            { Swop back to lower screen }
  119.       GoToXy(Xloc,Yloc);
  120.     End;
  121.   Until regs.bx=0;                   { Continue until no more }
  122.  
  123. End;
  124.  
  125. Procedure Moni;     { Procedure to decode monitored packets }
  126. Var
  127.   OutStr : String[80];
  128.   St : String[10];
  129.   I,J    : Integer;
  130.   Info : Boolean;
  131.   pass : Boolean;
  132.  
  133. {*************************** Start of Callsign ************************}
  134. Procedure Callsign(S:Integer);   { Decode callsigns }
  135. Var
  136.   I : Integer;
  137.  
  138. Begin
  139.   I := 1;
  140.   While (I<7) and ((BPQbuff[I+S] Shr 1) <> $20) do
  141.   Begin
  142.     OutStr := OutStr + Chr(BPQbuff[I+S] Shr 1);
  143.     I := I + 1;
  144.   End;
  145.  
  146.   Str(((BPQbuff[S+7] Shr 1) and $0F),St);          { Strip SSID }
  147.   If St <> '0' then
  148.       OutStr := OutStr + '-' +  St;
  149. End;
  150. {************************** Start of Netrom **************************}
  151. Procedure Netrom(S:Integer);
  152. Begin
  153.   WriteLn(OutStr);
  154.   OutStr := '[Netrom data] ';
  155.   Callsign(S+2);
  156.   Outstr := OutStr + ' to ';
  157.   Callsign(S+9);
  158.  
  159.   Case (BPQbuff[S+22] and $0F) of
  160.   1 : OutStr := OutStr + ' <Conn Req>';
  161.   2 : Begin
  162.         OutStr := OutStr + ' <Conn Ack>';
  163.       End;
  164.   3 : OutStr := OutSTr + ' <Disc Req>';
  165.   4 : OutStr := OutStr + ' <Disc Ack>';
  166.   5 : Begin
  167.         OutStr := OutStr + ' <Info>';
  168.         Info := True;
  169.         J := S + 20;                    { Correct counter to show text }
  170.       End;
  171.   6 : OutStr := OutStr + ' <Info Ack>';
  172.   else
  173.      Begin
  174.        Str((BPQbuff[S+22] and $0F),St);
  175.        OutStr := OutStr + ' Type ' + St;
  176.      End
  177.   End;
  178.  
  179. End;
  180.  
  181. Procedure Node_table;
  182. Var
  183.   I,S : Integer;
  184. Begin
  185.   WriteLn(OutStr);
  186.   OutStr := '';
  187.  
  188.   S := 22;
  189.  
  190.   I := 1;
  191.   While (I<7) and ((BPQbuff[I+S]) <> $20) do
  192.   Begin
  193.     OutStr := OutStr + Chr(BPQbuff[I+S]);
  194.     I := I + 1;
  195.   End;
  196.  
  197.   OutStr := OutStr + '   ';
  198.  
  199.   S := S + 6;
  200.   Repeat
  201.     OutStr := OutStr + 'Node: ';
  202.     Callsign(S);
  203.     S := S + 7;
  204.  
  205.     OutStr := OutStr + '/';
  206.     I := 1;
  207.     While (I<7) and (BPQbuff[I+S] <> $20) do
  208.     Begin
  209.       OutStr := OutStr + Chr(BPQbuff[I+S]);
  210.       I := I + 1;
  211.     End;
  212.     S := S + 6;
  213.  
  214.     OutStr := OutStr + ' via ';
  215.     Callsign(S);
  216.     S := S + 7;
  217.  
  218.     Str(BPQbuff[S],St);
  219.     OutStr := OutStr + ' qual:' + st;
  220.     S := S + 1;
  221.     WriteLn(OutStr);
  222.     OutStr := '          ';
  223.  
  224.   Until S >= regs.cx
  225.  
  226. end;
  227.  
  228. {*************************** Start of Header **************************}
  229. Function Header:Boolean;
  230. Var
  231.   I : Integer;
  232.  
  233. Begin
  234.   OutStr := '';
  235.   Info := False;
  236.  
  237.   Callsign(12);                { From callsign }
  238.  
  239.   OutStr := OutStr + '>';
  240.  
  241.   Callsign(5);                 { To callsign }
  242.  
  243.   J := 19;
  244.   While (BPQbuff[J] and $01) <> 1 do
  245.   Begin
  246.     OutStr := OutStr + ',';
  247.     Callsign(J);                { Digi callsign }
  248.     If (BPQbuff[J+7] and $80) = $80 then OutStr := OutStr + '*'; {Digi bit}
  249.     J := J + 7;
  250.   End;
  251.  
  252.   Str((BPQbuff[3] and $0F),St);           { Port number }
  253.   OutStr := OutStr + ' Port=' + St;
  254.  
  255.   Case (BPQbuff[J+1] and $01) of
  256.     0 : Begin                             { An information frame }
  257.           Case BPQbuff[J+2] of            { Case on the PID }
  258.           $CF : Begin
  259.                   OutStr := OutStr + ' [Net/Rom]';
  260.                   Netrom(J);
  261.                 End;
  262.           $F0 : Begin                      { Normal Packet }
  263.                   OutStr := OutStr + ':';
  264.                   Info := True;
  265.                 End;
  266.           Else  Begin                      { Any other PID }
  267.                   Str(BPQbuff[J+2],St);
  268.                   Outstr := OutStr + ' PID '+ St;
  269.                 End;
  270.           End;                             { End of PID case }
  271.         End;
  272.     1 : Begin                              { Must be a U or S frame }
  273.           If (BPQbuff[J+1] and $02)=0 then { Is this an supervisory frame }
  274.           Begin
  275.             St := '';
  276.             Case (BPQbuff[J+1] and $0C) of
  277.               $00 : St := 'RR';
  278.               $04 : St := 'RNR';
  279.               $08 : St := 'REJ';
  280.             End;
  281.  
  282.             OutStr := OutStr + ' <' + St;
  283.             Str((BPQbuff[J+1] Shr 5),St);         { Strip out N(R) }
  284.             OutStr := OutStr + ' R' + St + '>';
  285.           End
  286.           else
  287.           Case (BPQbuff[J+1] and $EC) of      { U Frame }
  288.           0  : Begin
  289.                  OutStr := OutStr + ' <UI>';
  290.                  If ((BPQbuff[6] Shr 1) = Ord('N')) and
  291.                     ((BPQbuff[7] Shr 1) = Ord('O')) and
  292.                     (BPQbuff[22] = $FF ) then
  293.                       Node_table
  294.                  else
  295.                       Info := True;
  296.                End;
  297.           $0C : OutStr := OutStr + ' <DM>';
  298.           $2C : OutStr := OutStr + ' <SABM>';
  299.           $40 : OutStr := OutStr + ' <DISC>';
  300.           $60 : OutStr := OutStr + ' <UA>';
  301.           $84 : OutStr := OutStr + ' <FRMR>';
  302.           End;
  303.         End;
  304.   End;      { End of Info/Super case }
  305.  
  306.   Write(OutStr);
  307.  
  308.   If Info then Header := True
  309.           else Header := False;
  310. End;
  311. {**************************** End of Header ****************************}
  312.  
  313. Begin
  314.     regs.di := Ofs(BPQbuff);
  315.     regs.es := Seg(BPQbuff);
  316.     regs.ah := 11;                  { Monitor function }
  317.     regs.al := port;
  318.     intr($7F,regs);
  319.  
  320.     If regs.cx > 0 then             { Is there any data }
  321.     Begin
  322.       Window(1,4,80,22);
  323.       GotoXY(xkeep,ykeep);
  324.       Last := False;
  325.       Textcolor(Cyan);
  326.  
  327.       If Header then                           { If valid info in frame }
  328.       Begin
  329.         I := J + 3;
  330.         Write(' ');
  331.         While I <= Regs.cx do
  332.         Begin
  333.           Write(Chr(BPQbuff[I]));                { Write it out to screen }
  334.           If BPQbuff[I] = $0D then WriteLn;
  335.           I := I + 1;
  336.         End;
  337.         If BPQbuff[Regs.cx] <> $0D then WriteLn;
  338.       End
  339.       Else
  340.         WriteLn;
  341.  
  342.       Xkeep := WhereX;
  343.       Ykeep := WhereY;
  344.       Window(1,24,80,24);            { Swop back to lower screen }
  345.       GoToXy(Xloc,Yloc);
  346.     End;
  347.     TextColor(White);
  348. End;
  349.  
  350. Procedure Send;
  351. var
  352.   Inp,Out : Integer;
  353.  
  354. begin
  355.  
  356.   For Inp := 1 to Length(LocBuff) do
  357.       BPQbuff[Inp] := Ord(LocBuff[Inp]);  { Convert char to byte }
  358.  
  359.   regs.cx := Length(LocBuff);
  360.   regs.si := Ofs(BPQbuff);
  361.   regs.es := Seg(BPQbuff);
  362.   regs.ah := $02;
  363.   regs.al := port;
  364.   intr($7F,regs);
  365.  
  366. end;
  367.  
  368. Function BPQ_loaded: Boolean;
  369. Var
  370.   Seg ,ofs  : word;
  371.   Seg1,ofs1 : word;
  372.   I         : integer;
  373.   St        : String[7];
  374.  
  375. Begin
  376.   Seg := 0;
  377.   Ofs := $01FC;                        { Address of Int $7F      }
  378.   Ofs1 := memw[Seg:Ofs];               { Find address of BPQcode }
  379.   Seg1 := memw[Seg:Ofs+2];
  380.  
  381.   ofs1 := Ofs1 - 7;                    { Go back 7 bytes in memory }
  382.   St := '';
  383.   For I := 0 to 4 do
  384.   Begin
  385.     ofs := Ofs1 + I;
  386.     St := St + Chr(mem[Seg1:Ofs]);     { Read byte from memory }
  387.   End;
  388.  
  389.   BPQ_loaded := (St='G8BPQ');          { Does it match string }
  390.  
  391. End;
  392.  
  393. Procedure setup;   {read command line}
  394. var
  395.     err: integer;
  396.       i: integer;
  397.       p: integer;
  398.  
  399. begin
  400.   If (ParamCount = 0) then
  401.   Begin
  402.     WriteLn(' You must supply the port number as a parameter ');
  403.     Halt;
  404.   End
  405.   else
  406.   Begin
  407.       Val(Paramstr(1),i,err);
  408.       If (err = 0) then port := i;
  409.   End;
  410. End;
  411.  
  412. Procedure Frames;
  413. Begin
  414.   regs.ah := $07;
  415.   regs.al := port;
  416.   intr($7F,regs);
  417.   GoToXY(35,2);Write('Frames to go = ',regs.cx);
  418. End;
  419.  
  420. Function Buffers:Integer;
  421. Begin
  422.  
  423.   regs.ah := $07;
  424.   regs.al := 1;                  { Use stream 1 to check buffer state }
  425.   intr($7F,regs);
  426.   Buffers := regs.dx;
  427.  
  428. End;
  429.  
  430. Procedure Connect_state;
  431. Begin
  432.   regs.ah := $04;
  433.   regs.al := port;
  434.   intr($7F,regs);
  435.   If regs.cx = 0 then
  436.   begin
  437.     Textcolor(Red);
  438.     Write('Not Connected');
  439.     Connected := False;
  440.     Textcolor(15);
  441.   end
  442.   else
  443.   begin
  444.     Textcolor(Green);
  445.     Write('Connected    ');
  446.     Connected := True;
  447.     Textcolor(15);
  448.   end;
  449.  
  450.   regs.ah := $05;
  451.   regs.al := port;
  452.   intr($7F,regs);
  453.  
  454. End;
  455.  
  456. Procedure Host_Status(Appl:byte;Mon:byte);
  457. Begin
  458.     regs.cl := Mon;
  459.     regs.dl := Appl;
  460.     regs.ah := $01;
  461.     regs.al := port;
  462.     intr($7F,regs);
  463. End;
  464.  
  465. Procedure Node_conn;
  466. Begin
  467.     regs.cx := 1;
  468.     regs.ah := $06;
  469.     regs.al := port;
  470.     intr($7F,regs);
  471.     Connected := True;
  472. End;
  473.  
  474. Procedure Node_disc;
  475. Begin
  476.     regs.cx := 2;
  477.     regs.ah := $06;
  478.     regs.al := port;
  479.     intr($7F,regs);
  480.     Connected := False;
  481. End;
  482.  
  483. Procedure Node_State;
  484. Begin
  485.     regs.ah := $04;               { Find connect status }
  486.     regs.al := port;
  487.     intr($7F,regs);
  488.  
  489.     WriteLn('Node Status  CH  CL  DX  ',regs.ch,'  ',regs.cl,'  ',regs.dx);
  490.  
  491.     regs.ah := $05;               { Ack the node state }
  492.     regs.al := port;
  493.     intr($7F,regs);
  494.  
  495. End;
  496.  
  497. Procedure Node_call;
  498. Begin
  499.     regs.di := Ofs(BPQbuff);
  500.     regs.ES := Seg(BPQbuff);
  501.     regs.ah := $08;                   { Find callsign on stream }
  502.     regs.al := port;
  503.     intr($7F,regs);
  504.  
  505.     IBuffer := '';
  506.  
  507.     For I := 1 to 10 do
  508.     Begin
  509.       IBuffer := IBuffer + Chr(BPQbuff[I]);
  510.     End;
  511.  
  512.     WriteLn('Callsign ',Ibuffer);
  513.  
  514. End;
  515.  
  516. Procedure Stream_status;
  517. Begin
  518.   Window(1,24,80,24);
  519.   GoToXY(25,1);TextColor(128+Green);
  520.   Write('Hit ENTER to stop Status Display');
  521.   TextColor(White);
  522.   Window(1,4,80,22);
  523.   For Row := 0 to 5 do
  524.   Begin
  525.     For col := 1 to 9 do
  526.     Begin
  527.       Stream := (Row*9)+col;
  528.       regs.ah := $04;
  529.       regs.al := stream;
  530.       intr($7F,regs);
  531.       If Regs.cx = 0 then
  532.          Call := 'Disc   '
  533.       else
  534.       Begin
  535.         regs.di := Ofs(BPQbuff);
  536.         regs.ES := Seg(BPQbuff);
  537.         regs.ah := $08;
  538.         regs.al := stream;
  539.         intr($7F,regs);
  540.         Call := '';
  541.         For I := 1 to 10 do
  542.            Call := Call + Chr(BPQBuff[I]);
  543.         regs.ah := $07;
  544.         regs.al := stream;
  545.         intr($7F,regs);
  546.         GotoXY(8*(Col-1)+11,(row*3)+3);Write(regs.bx:2,'/',regs.cx:2);
  547.       End;
  548.       TextColor(Yellow);
  549.       GotoXY(8*(Col-1)+13,(row*3)+1);Write(Stream);
  550.       TextColor(White);
  551.       GotoXY(8*(Col-1)+11,(row*3)+2);Write(Call);
  552.     End;
  553.     GotoXY(1,(row*3)+2);Write('Call');
  554.     GotoXY(1,(row*3)+3);Write('TX/RX q');
  555.   End;
  556. End;
  557. {***************************  Start of main  ******************************}
  558.  
  559. Begin
  560.  
  561.   DirectVideo := False;                  { Write to screen using BIOS calls }
  562.  
  563.   Connected   := False;
  564.   Conok       := False;
  565.   Show_status := False;
  566.   monitor     := $00;
  567.  
  568.   ClrScr;
  569.   xkeep := 1; ykeep := 1;
  570.   xloc  := 1; yloc  := 1;
  571.  
  572.   If not BPQ_Loaded then
  573.   Begin
  574.     WriteLn('BPQ node version 4 not loaded ');
  575.     Halt;
  576.   End;
  577.  
  578.   For I := 1 to 255 do
  579.     BPQbuff[I] := 0;
  580.  
  581.   GotoXY(1,23); For I := 1 to 80 do Write('-');
  582.   GotoXY(1, 3); For I := 1 to 80 do Write('-');
  583.   Window(1,25,80,25);
  584.   Write('Esc - Quit  F1 - connect to switch   F2 - Host   F3 - Mon   F10 - Node status');
  585.  
  586.   Window(1,1,80,2);
  587.  
  588.   Setup;
  589.   Writeln('IMB Terminal   Using Stream ',port);
  590.  
  591.   Host_status(0,0);
  592.   connect_state;
  593.  
  594.   Window(1,4,80,22);
  595.  
  596.   Quit := false;
  597.   locbuff := '';
  598.  
  599.   xkeep := WhereX;
  600.   ykeep := WhereY;
  601.  
  602.   Window(1,24,80,24);
  603.  
  604.   Repeat
  605.     Repeat
  606.       If not Show_status then Get_resp;  { Don't read port if stat display}
  607.       If (not Show_status) and (monitor=$80) then moni;
  608.       If Timest <> Time then
  609.       Begin
  610.         Window(1,1,80,2);
  611.         Cursor(False);
  612.         GoToXY(60,1); Write(Time);
  613.         GoToXY(1 ,2); Connect_state;
  614.         GoToXY(16,2); If Conok then Write('Host connects')
  615.                                else Write('No connects  ');
  616.         GoToXY(35,1); If monitor = $80 then Write('Monitor On ')
  617.                                        else Write('Monitor Off');
  618.         GoToXY(40,2); Frames;
  619.         GoToXY(60,2); Write(' Free Buffers = ',Buffers:3);
  620.         If Show_status then
  621.         Begin
  622.           Window(1,4,80,22);
  623.           Stream_status;
  624.         End;
  625.         Window(1,24,80,24);
  626.         GoToXY(xloc,yloc);
  627.         TimeSt := Time;
  628.         Cursor(True);
  629.       End;
  630.  
  631.       DV_Nice;                   { Give time slice back to DV }
  632.  
  633.     Until Keypressed;
  634.  
  635.     Ch := Readkey;
  636.  
  637.     Case Ord(CH) of
  638.  
  639.     0    : Begin                  { Special key pressed }
  640.              CH := Readkey;
  641.              Case Ord(CH) of
  642.              59 : Begin           { F1 pressed }
  643.                     If Connected then Node_disc
  644.                                  else Node_conn;
  645.                   End;
  646.  
  647.              60 : Begin           { F2 pressed }
  648.                     If conok then
  649.                     Begin
  650.                       Host_status(0,monitor);  { Turn off host }
  651.                       conok := False;
  652.                     end
  653.                     else
  654.                     Begin
  655.                       Host_status(1,monitor);  { Allow host connects }
  656.                       Node_disc;
  657.                       conok := True;
  658.                     end;
  659.                   End;
  660.  
  661.              61 : Begin                 {F3}
  662.                     If monitor = $80 then
  663.                     Begin
  664.                       Monitor := $00;
  665.                       Host_status(0,monitor);
  666.                     end
  667.                     else
  668.                     begin
  669.                       monitor := $80;
  670.                       Host_status(0,monitor);
  671.                     end;
  672.                   End;
  673.  
  674.              68 : Begin           { F10 pressed }
  675.                     Window(1,4,80,22);
  676.                     ClrScr;
  677.  
  678.                     Show_status := true;
  679.  
  680.                     Xkeep := 1;
  681.                     Ykeep := 19;
  682.                     Window(1,24,80,24);
  683.                   End;
  684.  
  685.              End;  { Case for 2nd part of keypress }
  686.            End;
  687.  
  688.     8    : Begin                                { Delete key }
  689.              Delete(LocBuff,length(LocBuff),1); { Remove last character }
  690.              xloc := xloc - 1;
  691.              GoToXY(xloc,yloc);Write(' ');
  692.              GoToXY(xloc,yloc);
  693.            End;
  694.  
  695.     13   : Begin                                { Enter key }
  696.              Show_status := False;
  697.              xloc := 1;
  698.              locbuff := locbuff + #$0D;
  699.              Send;
  700.  
  701.              Window(1,4,80,22);
  702.              GotoXY(xkeep,ykeep);
  703.              TextColor(Lightgray);
  704.              WriteLn(locbuff);                { Write it out to screen }
  705.              Textcolor(White);
  706.              Xkeep := WhereX;
  707.              Ykeep := WhereY;
  708.              Window(1,24,80,24);            { Swop back to lower screen }
  709.              locbuff := '';
  710.              GoToXY(xloc,yloc);
  711.              ClrEol;
  712.            end;
  713.  
  714.     27   : Quit := True;
  715.  
  716.     else
  717.       Begin
  718.         Write(Ch);
  719.         locbuff := locbuff + Ch;
  720.         xloc := xloc + 1;
  721.       end;
  722.     end;    { Case }
  723.  
  724.   Until Quit;
  725.  
  726.   Node_disc;
  727.  
  728.   Window(1,1,80,25);
  729.  
  730.   ClrScr;
  731.  
  732. End.
  733.