home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Media Share 9
/
MEDIASHARE_09.ISO
/
bbs
/
bpq407a.zip
/
BPQ407A.EXE
/
SAMPS.ZIP
/
TERM4.PAS
< prev
Wrap
Pascal/Delphi Source File
|
1991-02-02
|
18KB
|
733 lines
Program Term4;
{$M 2512,0,1024}
{ Terminal program Version 1.0 by Martin Stubbs G8IMB }
{ Written specifically to test the new BPQ interface }
{ Comments and improvements welcome }
Uses Crt,Dos;
const
CR = #$0D;
LF = #$0A;
CRLF = CR+LF;
var
Ch : Char;
err : Integer;
I : integer;
p : Integer;
S : Byte;
port : Integer;
Stream : Byte;
Call : String[10];
TimeSt : String[20];
Conok : Boolean;
Connected : Boolean;
Monitor : Byte;
Last : Boolean;
Quit : Boolean;
xloc,yloc : Integer;
xkeep,ykeep : Integer;
row,col : Integer;
Show_status : Boolean;
Regs : Registers;
BPQbuff : Array [1..256] of byte;
IBuffer : String[255];
locbuff : String[255];
Procedure DV_Nice; {Give time slice to next task}
begin
regs.ax := $1000;
Intr($15, regs);
end;
Procedure Cursor(On:Boolean);
Begin
With regs do
Begin
If On then Ch := 6
else Ch := $20;
AH := $01;
CL := $07;
Intr($10,regs);
end;
End;
Procedure Display(St:String);
Begin
Window(1,4,80,22);
GotoXY(xkeep,ykeep);
WriteLn(St); { Write it out to screen }
Xkeep := WhereX;
Ykeep := WhereY;
Window(1,24,80,24); { Swop back to lower screen }
GoToXy(Xloc,Yloc);
End;
Function Time:String;
Var
X : Word;
I : Integer;
Timarr: Array[1..6] of word;
Timst : Array[1..6] of string[4];
Begin
GetDate(Timarr[3],Timarr[2],Timarr[1],x);
GetTime(Timarr[4],Timarr[5],Timarr[6],x);
For I := 1 to 6 do
Begin
Str(Timarr[I]:2,Timst[I]);
If Timst[I,1]=' ' then Timst[I,1] := '0';
End;
Time := timst[1]+'/'+timst[2]+'/'+timst[3]+' '+
timst[4]+':'+timst[5]+':'+timst[6];
End;
Procedure Get_resp;
Var
I : Integer;
Begin
Repeat
regs.di := Ofs(BPQbuff);
regs.es := Seg(BPQbuff);
regs.ah := $03;
regs.al := port;
intr($7F,regs);
If regs.cx > 0 then { Is there any data }
Begin
Window(1,4,80,22);
GotoXY(xkeep,ykeep);
For I := 1 to regs.cx do
Begin
Write(Chr(BPQbuff[I])); { Write it out to screen }
If BPQbuff[I] = $0D then WriteLn;
End;
Xkeep := WhereX;
Ykeep := WhereY;
Window(1,24,80,24); { Swop back to lower screen }
GoToXy(Xloc,Yloc);
End;
Until regs.bx=0; { Continue until no more }
End;
Procedure Moni; { Procedure to decode monitored packets }
Var
OutStr : String[80];
St : String[10];
I,J : Integer;
Info : Boolean;
pass : Boolean;
{*************************** Start of Callsign ************************}
Procedure Callsign(S:Integer); { Decode callsigns }
Var
I : Integer;
Begin
I := 1;
While (I<7) and ((BPQbuff[I+S] Shr 1) <> $20) do
Begin
OutStr := OutStr + Chr(BPQbuff[I+S] Shr 1);
I := I + 1;
End;
Str(((BPQbuff[S+7] Shr 1) and $0F),St); { Strip SSID }
If St <> '0' then
OutStr := OutStr + '-' + St;
End;
{************************** Start of Netrom **************************}
Procedure Netrom(S:Integer);
Begin
WriteLn(OutStr);
OutStr := '[Netrom data] ';
Callsign(S+2);
Outstr := OutStr + ' to ';
Callsign(S+9);
Case (BPQbuff[S+22] and $0F) of
1 : OutStr := OutStr + ' <Conn Req>';
2 : Begin
OutStr := OutStr + ' <Conn Ack>';
End;
3 : OutStr := OutSTr + ' <Disc Req>';
4 : OutStr := OutStr + ' <Disc Ack>';
5 : Begin
OutStr := OutStr + ' <Info>';
Info := True;
J := S + 20; { Correct counter to show text }
End;
6 : OutStr := OutStr + ' <Info Ack>';
else
Begin
Str((BPQbuff[S+22] and $0F),St);
OutStr := OutStr + ' Type ' + St;
End
End;
End;
Procedure Node_table;
Var
I,S : Integer;
Begin
WriteLn(OutStr);
OutStr := '';
S := 22;
I := 1;
While (I<7) and ((BPQbuff[I+S]) <> $20) do
Begin
OutStr := OutStr + Chr(BPQbuff[I+S]);
I := I + 1;
End;
OutStr := OutStr + ' ';
S := S + 6;
Repeat
OutStr := OutStr + 'Node: ';
Callsign(S);
S := S + 7;
OutStr := OutStr + '/';
I := 1;
While (I<7) and (BPQbuff[I+S] <> $20) do
Begin
OutStr := OutStr + Chr(BPQbuff[I+S]);
I := I + 1;
End;
S := S + 6;
OutStr := OutStr + ' via ';
Callsign(S);
S := S + 7;
Str(BPQbuff[S],St);
OutStr := OutStr + ' qual:' + st;
S := S + 1;
WriteLn(OutStr);
OutStr := ' ';
Until S >= regs.cx
end;
{*************************** Start of Header **************************}
Function Header:Boolean;
Var
I : Integer;
Begin
OutStr := '';
Info := False;
Callsign(12); { From callsign }
OutStr := OutStr + '>';
Callsign(5); { To callsign }
J := 19;
While (BPQbuff[J] and $01) <> 1 do
Begin
OutStr := OutStr + ',';
Callsign(J); { Digi callsign }
If (BPQbuff[J+7] and $80) = $80 then OutStr := OutStr + '*'; {Digi bit}
J := J + 7;
End;
Str((BPQbuff[3] and $0F),St); { Port number }
OutStr := OutStr + ' Port=' + St;
Case (BPQbuff[J+1] and $01) of
0 : Begin { An information frame }
Case BPQbuff[J+2] of { Case on the PID }
$CF : Begin
OutStr := OutStr + ' [Net/Rom]';
Netrom(J);
End;
$F0 : Begin { Normal Packet }
OutStr := OutStr + ':';
Info := True;
End;
Else Begin { Any other PID }
Str(BPQbuff[J+2],St);
Outstr := OutStr + ' PID '+ St;
End;
End; { End of PID case }
End;
1 : Begin { Must be a U or S frame }
If (BPQbuff[J+1] and $02)=0 then { Is this an supervisory frame }
Begin
St := '';
Case (BPQbuff[J+1] and $0C) of
$00 : St := 'RR';
$04 : St := 'RNR';
$08 : St := 'REJ';
End;
OutStr := OutStr + ' <' + St;
Str((BPQbuff[J+1] Shr 5),St); { Strip out N(R) }
OutStr := OutStr + ' R' + St + '>';
End
else
Case (BPQbuff[J+1] and $EC) of { U Frame }
0 : Begin
OutStr := OutStr + ' <UI>';
If ((BPQbuff[6] Shr 1) = Ord('N')) and
((BPQbuff[7] Shr 1) = Ord('O')) and
(BPQbuff[22] = $FF ) then
Node_table
else
Info := True;
End;
$0C : OutStr := OutStr + ' <DM>';
$2C : OutStr := OutStr + ' <SABM>';
$40 : OutStr := OutStr + ' <DISC>';
$60 : OutStr := OutStr + ' <UA>';
$84 : OutStr := OutStr + ' <FRMR>';
End;
End;
End; { End of Info/Super case }
Write(OutStr);
If Info then Header := True
else Header := False;
End;
{**************************** End of Header ****************************}
Begin
regs.di := Ofs(BPQbuff);
regs.es := Seg(BPQbuff);
regs.ah := 11; { Monitor function }
regs.al := port;
intr($7F,regs);
If regs.cx > 0 then { Is there any data }
Begin
Window(1,4,80,22);
GotoXY(xkeep,ykeep);
Last := False;
Textcolor(Cyan);
If Header then { If valid info in frame }
Begin
I := J + 3;
Write(' ');
While I <= Regs.cx do
Begin
Write(Chr(BPQbuff[I])); { Write it out to screen }
If BPQbuff[I] = $0D then WriteLn;
I := I + 1;
End;
If BPQbuff[Regs.cx] <> $0D then WriteLn;
End
Else
WriteLn;
Xkeep := WhereX;
Ykeep := WhereY;
Window(1,24,80,24); { Swop back to lower screen }
GoToXy(Xloc,Yloc);
End;
TextColor(White);
End;
Procedure Send;
var
Inp,Out : Integer;
begin
For Inp := 1 to Length(LocBuff) do
BPQbuff[Inp] := Ord(LocBuff[Inp]); { Convert char to byte }
regs.cx := Length(LocBuff);
regs.si := Ofs(BPQbuff);
regs.es := Seg(BPQbuff);
regs.ah := $02;
regs.al := port;
intr($7F,regs);
end;
Function BPQ_loaded: Boolean;
Var
Seg ,ofs : word;
Seg1,ofs1 : word;
I : integer;
St : String[7];
Begin
Seg := 0;
Ofs := $01FC; { Address of Int $7F }
Ofs1 := memw[Seg:Ofs]; { Find address of BPQcode }
Seg1 := memw[Seg:Ofs+2];
ofs1 := Ofs1 - 7; { Go back 7 bytes in memory }
St := '';
For I := 0 to 4 do
Begin
ofs := Ofs1 + I;
St := St + Chr(mem[Seg1:Ofs]); { Read byte from memory }
End;
BPQ_loaded := (St='G8BPQ'); { Does it match string }
End;
Procedure setup; {read command line}
var
err: integer;
i: integer;
p: integer;
begin
If (ParamCount = 0) then
Begin
WriteLn(' You must supply the port number as a parameter ');
Halt;
End
else
Begin
Val(Paramstr(1),i,err);
If (err = 0) then port := i;
End;
End;
Procedure Frames;
Begin
regs.ah := $07;
regs.al := port;
intr($7F,regs);
GoToXY(35,2);Write('Frames to go = ',regs.cx);
End;
Function Buffers:Integer;
Begin
regs.ah := $07;
regs.al := 1; { Use stream 1 to check buffer state }
intr($7F,regs);
Buffers := regs.dx;
End;
Procedure Connect_state;
Begin
regs.ah := $04;
regs.al := port;
intr($7F,regs);
If regs.cx = 0 then
begin
Textcolor(Red);
Write('Not Connected');
Connected := False;
Textcolor(15);
end
else
begin
Textcolor(Green);
Write('Connected ');
Connected := True;
Textcolor(15);
end;
regs.ah := $05;
regs.al := port;
intr($7F,regs);
End;
Procedure Host_Status(Appl:byte;Mon:byte);
Begin
regs.cl := Mon;
regs.dl := Appl;
regs.ah := $01;
regs.al := port;
intr($7F,regs);
End;
Procedure Node_conn;
Begin
regs.cx := 1;
regs.ah := $06;
regs.al := port;
intr($7F,regs);
Connected := True;
End;
Procedure Node_disc;
Begin
regs.cx := 2;
regs.ah := $06;
regs.al := port;
intr($7F,regs);
Connected := False;
End;
Procedure Node_State;
Begin
regs.ah := $04; { Find connect status }
regs.al := port;
intr($7F,regs);
WriteLn('Node Status CH CL DX ',regs.ch,' ',regs.cl,' ',regs.dx);
regs.ah := $05; { Ack the node state }
regs.al := port;
intr($7F,regs);
End;
Procedure Node_call;
Begin
regs.di := Ofs(BPQbuff);
regs.ES := Seg(BPQbuff);
regs.ah := $08; { Find callsign on stream }
regs.al := port;
intr($7F,regs);
IBuffer := '';
For I := 1 to 10 do
Begin
IBuffer := IBuffer + Chr(BPQbuff[I]);
End;
WriteLn('Callsign ',Ibuffer);
End;
Procedure Stream_status;
Begin
Window(1,24,80,24);
GoToXY(25,1);TextColor(128+Green);
Write('Hit ENTER to stop Status Display');
TextColor(White);
Window(1,4,80,22);
For Row := 0 to 5 do
Begin
For col := 1 to 9 do
Begin
Stream := (Row*9)+col;
regs.ah := $04;
regs.al := stream;
intr($7F,regs);
If Regs.cx = 0 then
Call := 'Disc '
else
Begin
regs.di := Ofs(BPQbuff);
regs.ES := Seg(BPQbuff);
regs.ah := $08;
regs.al := stream;
intr($7F,regs);
Call := '';
For I := 1 to 10 do
Call := Call + Chr(BPQBuff[I]);
regs.ah := $07;
regs.al := stream;
intr($7F,regs);
GotoXY(8*(Col-1)+11,(row*3)+3);Write(regs.bx:2,'/',regs.cx:2);
End;
TextColor(Yellow);
GotoXY(8*(Col-1)+13,(row*3)+1);Write(Stream);
TextColor(White);
GotoXY(8*(Col-1)+11,(row*3)+2);Write(Call);
End;
GotoXY(1,(row*3)+2);Write('Call');
GotoXY(1,(row*3)+3);Write('TX/RX q');
End;
End;
{*************************** Start of main ******************************}
Begin
DirectVideo := False; { Write to screen using BIOS calls }
Connected := False;
Conok := False;
Show_status := False;
monitor := $00;
ClrScr;
xkeep := 1; ykeep := 1;
xloc := 1; yloc := 1;
If not BPQ_Loaded then
Begin
WriteLn('BPQ node version 4 not loaded ');
Halt;
End;
For I := 1 to 255 do
BPQbuff[I] := 0;
GotoXY(1,23); For I := 1 to 80 do Write('-');
GotoXY(1, 3); For I := 1 to 80 do Write('-');
Window(1,25,80,25);
Write('Esc - Quit F1 - connect to switch F2 - Host F3 - Mon F10 - Node status');
Window(1,1,80,2);
Setup;
Writeln('IMB Terminal Using Stream ',port);
Host_status(0,0);
connect_state;
Window(1,4,80,22);
Quit := false;
locbuff := '';
xkeep := WhereX;
ykeep := WhereY;
Window(1,24,80,24);
Repeat
Repeat
If not Show_status then Get_resp; { Don't read port if stat display}
If (not Show_status) and (monitor=$80) then moni;
If Timest <> Time then
Begin
Window(1,1,80,2);
Cursor(False);
GoToXY(60,1); Write(Time);
GoToXY(1 ,2); Connect_state;
GoToXY(16,2); If Conok then Write('Host connects')
else Write('No connects ');
GoToXY(35,1); If monitor = $80 then Write('Monitor On ')
else Write('Monitor Off');
GoToXY(40,2); Frames;
GoToXY(60,2); Write(' Free Buffers = ',Buffers:3);
If Show_status then
Begin
Window(1,4,80,22);
Stream_status;
End;
Window(1,24,80,24);
GoToXY(xloc,yloc);
TimeSt := Time;
Cursor(True);
End;
DV_Nice; { Give time slice back to DV }
Until Keypressed;
Ch := Readkey;
Case Ord(CH) of
0 : Begin { Special key pressed }
CH := Readkey;
Case Ord(CH) of
59 : Begin { F1 pressed }
If Connected then Node_disc
else Node_conn;
End;
60 : Begin { F2 pressed }
If conok then
Begin
Host_status(0,monitor); { Turn off host }
conok := False;
end
else
Begin
Host_status(1,monitor); { Allow host connects }
Node_disc;
conok := True;
end;
End;
61 : Begin {F3}
If monitor = $80 then
Begin
Monitor := $00;
Host_status(0,monitor);
end
else
begin
monitor := $80;
Host_status(0,monitor);
end;
End;
68 : Begin { F10 pressed }
Window(1,4,80,22);
ClrScr;
Show_status := true;
Xkeep := 1;
Ykeep := 19;
Window(1,24,80,24);
End;
End; { Case for 2nd part of keypress }
End;
8 : Begin { Delete key }
Delete(LocBuff,length(LocBuff),1); { Remove last character }
xloc := xloc - 1;
GoToXY(xloc,yloc);Write(' ');
GoToXY(xloc,yloc);
End;
13 : Begin { Enter key }
Show_status := False;
xloc := 1;
locbuff := locbuff + #$0D;
Send;
Window(1,4,80,22);
GotoXY(xkeep,ykeep);
TextColor(Lightgray);
WriteLn(locbuff); { Write it out to screen }
Textcolor(White);
Xkeep := WhereX;
Ykeep := WhereY;
Window(1,24,80,24); { Swop back to lower screen }
locbuff := '';
GoToXY(xloc,yloc);
ClrEol;
end;
27 : Quit := True;
else
Begin
Write(Ch);
locbuff := locbuff + Ch;
xloc := xloc + 1;
end;
end; { Case }
Until Quit;
Node_disc;
Window(1,1,80,25);
ClrScr;
End.