Category : Pascal Source Code
Archive   : BPLUS.ZIP
Filename : BPLUS.PAS

 
Output of file : BPLUS.PAS contained in archive : BPLUS.ZIP
{$R-} {Range checking off }
{$B-} {Boolean complete evaluation off }
{$S-} {Stack checking off }
{$I+} {I/O checking on }
{$N-} {No numeric coprocessor }

Unit bplus;

{***
BPLUS.INC - B Plus Protocol Support routines
(derived from BPROTO.INC)

Copyright 1987, CompuServe Incorporated

These routines may be used as-is or in modified form in any
personal computer terminal program to implement support of the
CompuServe B and B Plus Protocols for the purpose of transfering
information between a host and a personal computer.

No warranty, expressed or implied, covers this code, or the specifications
of the B and B Plus Protocols.


Last update:
Russ Ranshaw 16-Dec-87 Corrected Upload Abort problems.
Russ Ranshaw 07-Apr-88 Corrected additional Abort problems.
Russ Ranshaw 09-Apr-88 Added Quote Set to + Packet.
Russ Ranshaw 10-Apr-88 Added Download Resume.
Russ Ranshaw 22-Apr-88 Added File Information to Download.
(File length only.)
Russ Ranshaw 11-May-88 Added check to control Upload degradagtion
under Send Ahead.
Russ Ranshaw 16-May-88 Remove debugging code for release
of Version 2.1
Russ Ranshaw 01-Jun-88 Added externally settable file size for
Downloads. Use ST_Yes_or_No instead of
ST_Prompt to get Y/N response.
Russ Ranshaw 07-Jun-88 Added defensive check to see if Aborting
is already true. Changed comm. rate
calculation.
Russ Ranshaw 23-Jun-88 Add check for in ReSync.
Russ Ranshaw 04-Aug-88 Added WACK intercept to update the
status display, mostly so that resumes
show some activity while the host calculates
it's CRC value.
Russ Ranshaw 12-Aug-88 Moved several statistics values to be
externally accessible. Removed the
hiding of partial files. Added status
code to indicate result of transfer.

Russ Ranshaw 19-Sep-88 Added support for a "fatal abort" which
causes an immediate (almost) exit from
the file transfer process. This is
implemented in Read_Byte if a transfer
abort is in effect. The application can
set BP_Abort_Max to the number of times
ST_Check_Abort must return True to trigger
the fatal abort. The default value is 4.
Also changed the per-character time-out
check in Read_Byte.

***}

{***************
**
** THis module implements the B-Protocol Functions.
**
**
** If you have any questions, contact:
** Russ Ranshaw, CompuServe Incorporated
** [70000,1010]
**
** This source was originally derived from BP.C, written by
** Steve Wilhite, CompuServe Incorporated.
**
****************}

Interface

Uses
Crt,
Dos,
crc,
Async4,
Timers,
BPStatus;

const
UnitVersion = '2.2e';
UnitVerDate = '19 Sep 88';
UnitUpdBy = 'RWR';
BP_Time_Out_Max = 30; { Maximum per-character timeout (seconds) }

type
maxstr = string [255];

var
BP_Auto_Resume : Boolean; { True to automatically attempt transfer }
{ resumption if the Initiator can do it }
BP_Use_File_Size : Boolean; { True to use the following file size if }
BP_Abort_Max : Word; { Number of Abort requests allowed before }
{ performing a "fatal abort." }
BP_File_Size : LongInt; { no "TI" packet is received. }
BP_S_Com_Data : LongInt; { Comm Port Data traffic }
BP_R_Com_Data : LongInt;
BP_S_File_Data : LongInt; { File Data Traffic }
BP_R_File_Data : LongInt;
BP_S_Packet_Count : LongInt; { Packet count }
BP_R_Packet_Count : LongInt;
BP_S_Error_Count : LongInt; { Error count }
BP_R_Error_Count : LongInt;
BP_S_File_Size : LongInt; { Length of file already sent }
BP_R_File_Size : LongInt; { Length of file already received }
BP_S_Remaining : LongInt; { # bytes remaining to be sent }
BP_R_Remaining : LongInt; { # bytes reamining to be received }
BP_Com_Rate : LongInt; { Effective Comm. bytes per second }
BP_Data_Rate : LongInt; { Effective Data bytes per second }
BP_Elapsed_Time : LongInt; { Seconds }
BP_Time_Estimate : LongInt; { Estimated time until completion }
BP_Status_Code : (Success, Failed, Aborted, TimedOut);


{ BP_Quote_This is invoked to set bits in BP_Special_Quote_Set. }
{ It must be called prior to calling BP_DLE_Seen for each character in the }
{ ranges $00 -> $1f and $80 -> $9f that is to be quoted. }
Procedure BP_Quote_This (Value : Integer);

{ BP_Term_ENQ is invoked when Terminal Mode receives from host }
Procedure BP_Term_ENQ;

{ BP_Term_ESC_I is invoked when Terminal Mode receives from host }
Procedure BP_Term_ESC_I (ESC_I_Response : maxstr);

{ BP_DLE_Seen is invoked when Terminal Mode receives from host }
Procedure BP_DLE_Seen;



{===========================================================================}

Implementation

type
QS_Array = array [0..7] of byte;

var
seq_num : integer; { Current Sequence Number - init by Term_ENQ }
checksum : word; { May hold CRC }

{ Initiator's Parameters }
His_WS, { Initiator's Window Send }
His_WR, { Initiator's Window Receive }
His_BS, { Initiator's Block Size }
His_CM : byte; { Initiator's Check Method }
His_QS : QS_Array; { Initiator's Quote Set }
{ The next 3 Parameters are for the B Plus File Transfer Application }
His_DR, { Initiator's Download Recovery Option }
His_UR, { Initiator's Upload Recovery Option }
His_FI : byte; { Initiator's File Information Option }

{ Negotiated Parameters }
Our_WS, { Negotiated Window Send }
Our_WR, { Negotiated Window Receive }
Our_BS, { Negotiated Block Size }
Our_CM : byte; { Negotiated Check Method }
Our_QS : QS_Array; { Our Quote Set }
Our_DR, { Our Download Recovery Option }
Our_UR, { Our Upload Recovery Option }
Our_FI, { Our File Information Option }
Def_DR, { User's preferred DOW Resume option }
Def_BS : byte; { Default Block Size: varies depending }
{ on the baud in use }
Port_Update_Rate : byte; { Number of port bytes between Status }
{ upldates for the Port }
B_Plus : boolean; { True if B Plus in effect }
Use_CRC : boolean; { True if CRC in effect }
BP_Special_Quoting : Boolean;{ True to use BP_Special_Quote_Set }
BP_Special_Quote_Set : QS_Array; { User's specified Quote Set }

Buffer_Size : integer; { Our_BS * 4 }
SA_Max : integer; { 1 if SA not enabled, else Max_SA }
SA_Error_Count : integer; { # of times S_Send_Data called }

Quote_Table : array [0..255] of byte; { The quoting table }

const
DQ_Full : QS_Array =
($ff, $ff, $ff, $ff,
$ff, $ff, $ff, $ff
);
DQ_Default : QS_Array =
($14, $00, $d4, $00, { ETX ENQ DLE XON XOFF NAK }
$00, $00, $00, $00
);
DQ_Minimal : QS_Array =
($14, $00, $d4, $00, { ETX ENQ DLE XON XOFF NAK }
$00, $00, $00, $00
);
DQ_Extended : QS_Array =
($14, $00, $d4, $00, { ETX ENQ DLE XON XOFF NAK }
$00, $00, $50, $00 { XON XOFF }
);

{
Clear_Quote_Table:
Initialize Quote_Table to all zeros (nothing quoted).
}

Procedure Clear_Quote_Table;

var
i : integer;

begin
for i := 0 to 255 do Quote_Table [i] := 0;
end;

{
Update_Quote_Table:
Sets the i-th entry of Quote_Table to the necessary quoting character
according to the i-th bit of the supplied Quote Set.
}

Procedure Update_Quote_Table (var Quote_Set : QS_Array);

var
i, j, k : integer;
b, c : byte;

begin
k := 0;
c := $40;

for i := 0 to 7 do
begin
if i = 4
then { Switch to upper control set }
begin
c := $60;
k := 128;
end;

b := Quote_Set [i];

for j := 0 to 7 do
begin
if (b and $80) <> 0
then Quote_Table [k] := c;

b := b shl 1;
c := c + 1;
k := k + 1;
end;
end;
end;

{ BP_Quote_This sets bits in BP_Special_Quote_Set. }
{ It sets BP_Special_Quoting true to use the special quote set. }
{ If Value = -1, the Special Quote Set is restored to its default. }

Procedure BP_Quote_This (Value: Integer);
var
i, j : integer;

begin
if value in [$00..$1f,$80..$9f]
then
begin
if Value > $1f
then
begin
i := 4;
Value := Value and $1f;
end
else
i := 0;

i := i + Value div 8; { = index into BP_Special_Quote_Set }
j := Value mod 8; { = Bit number in the i-th byte }
BP_Special_Quote_Set [i] := BP_Special_Quote_Set [i] or ($80 shr j);
BP_Special_Quoting := true;
end
else if Value = -1 { Restore the Quote Set? }
then
begin
BP_Special_Quote_Set := DQ_Minimal;
BP_Special_Quoting := false;
end;
end;

{
BP_Term_ENQ is called when the terminal emulator receives the character
from the host. Its purpose is to initialize for B Protocol and tell the
host that we support B Plus.
}


Procedure BP_Term_ENQ;

var
i : integer;

const
dle = $10;

begin
seq_num := 0;
BuffeR_Size := 512; { Set up defaults }
Our_WS := 0;
Our_WR := 0;
Our_BS := 4;
Our_CM := 0;
Our_DR := 0;
Our_UR := 0;
Our_FI := 0;

B_Plus := false; { Not B Plus Protocol }
Use_CRC := false; { Not CRC_16 }
SA_Max := 1; { Single Packet send }
SA_Error_Count := 0; { No Upload errors yet }

{ Set up Our prefered Quoting Mask }
Our_QS := DQ_Minimal;

Clear_Quote_Table;
Update_Quote_Table (Our_QS);

Async_Send (char (dle));
Async_Send ('+');
Async_Send ('+');
Async_Send (char (dle));
Async_Send ('0');
end;

{
BP_Term_ESC_I is called when is received by the terminal emulator.
Note that CompuServe now recognizes the string ",+xxxx" as the final field.
THis provides a checksum (xxxx being the ASCII decimal representation of the
sum of all characters in the response string from # to +. The purpose of
the checksum is to eliminate the need for retransmission and comparison of
the response.
}


Procedure BP_Term_ESC_I (ESC_I_Response : maxstr);
var
i : integer;
t : maxstr;
cks : integer; { Checksum }

begin
cks := 0;

for i := 1 to length (esc_I_response) do
begin
Async_Send (esc_I_response [i]);
cks := cks + ord (esc_I_response [i]);
end;

Async_Send (',');
Async_Send ('+');
cks := cks + ord (',') + ord ('+');

Str (cks, t);

for i := 1 to length (t) do
Async_Send (t [i]);

Async_Send (char ($d)); { }
end;


{
BP_DLE_Seen is called from the main program when the character is
received from the host.

This routine calls Read_Packet and dispatches to the appropriate
handler for the incoming Packet.
}


Procedure BP_DLE_Seen;
const
max_buf_Size = 1032; { Largest data block we can handle }
Max_SA = 2; { Maximum number of waiting Packets }

Def_Buf_Size = 511; { Default data block }
Def_WS = 1; { I can send 2 Packets ahead }
Def_WR = 1; { I can receive single send-ahead }
Def_CM = 1; { I can handle CRC }
Def_DQ = 1; { I can handle non-quoted NUL }
{ (including the `Tf' Packet }
Def_UR = 0; { I can NOT handle Upload Recovery }
Def_FI = 1; { I can handle File Information }

max_Errors = 10;


{ Receive States }

R_Get_DLE = 0;
R_Get_B = 1;
R_Get_Seq = 2;
R_Get_Data = 3;
R_Get_Check = 4;
R_Send_ACK = 5;
R_Timed_Out = 6;
R_Error = 7;
R_Success = 8;

{ Send States }

S_Get_DLE = 1;
S_Get_Num = 2;
S_Have_ACK = 3;
S_Get_Packet = 4;
S_Skip_Packet = 5;
S_Timed_Out = 6;
S_Error = 7;
S_Send_NAK = 8;
S_Send_ENQ = 9;
S_Send_Data = 10;

{ Other Constants }

dle = 16;
etx = 03;
nak = 21;
enq = 05;

type
lstr = string[255];
buffertype = array[0..Max_Buf_Size] of byte;
buf_type = record
seq : integer; { Packet's sequence number }
num : integer; { Number of bytes in Packet }
buf : buffertype; { Actual Packet data }
end;

var
Time_Out_Limit : Word; { # seconds in Read_Byte before time out }
R_Size, { size of receiver buffer }
ch : integer; { current character }

xoff_flag,
Packet_Received, { True if a Packet was received }
Quoted : boolean; { true if ctrl character was quoted }

SA_Buf : array [0..Max_SA] of buf_type; { Send-ahead buffers }

SA_Next_to_ACK : integer; { Which SA_Buf is waiting for an ACK }
SA_Next_to_Fill : integer; { Which SA_Buf is ready for new data }
SA_Waiting : integer; { Number of SA_Buf's waiting for ACK }
Aborting : boolean; { True if aborting the transfer }
Abort_Count : Word; { # times ST_Check_Abort returns True }
Fatal_Abort : Boolean; { True if Abort_Count exceeds BP_Abort_Max }

R_buffer : buffertype;
filename : lstr; { pathname }
i, n : integer;
dummy : boolean;
S_Counter : integer; { Used to pace status update }
R_Counter : integer;
Resume_Flag : Boolean; { True if attempting a DOW resume }

tmp_str : lstr;

Procedure Do_Checksum (ch : integer);
begin
if B_Plus and Use_CRC
then checksum := Upd_CRC (word (ch))
else
begin
checksum := checksum shl 1;

if checksum > 255
then checksum := (checksum and $ff) + 1;

checksum := checksum + ch;

if checksum > 255
then checksum := (checksum and $ff) + 1;
end;
end;

Procedure Send_Byte (ch : char);
begin
Async_Send (ch);
inc (BP_S_Com_Data);
inc (S_Counter);
S_Counter := S_Counter mod Port_Update_Rate;

if S_Counter = 0
then
begin
ST_Display_Value (STComSent, BP_S_Com_Data);
end;
end;

Procedure Send_Quoted_Byte (ch : integer);
begin
ch := ch and $ff;

if Quote_Table [ch] <> 0
then
begin
Send_Byte (char (dle));
Send_Byte (char (Quote_Table [ch]));
end
else Send_Byte (char (ch));
end;

Procedure Send_ACK;
begin
Send_Byte (char (dle));
Send_Byte (char (seq_num + ord ('0')));
end;

Procedure Send_NAK;
begin
Send_Byte (char (nak));
end;


Procedure Send_ENQ;
begin
Send_Byte (char (enq));
end;

Function Read_Byte : boolean;
var
chx : char;
Hiber : word;

begin

ResetTimer (1);

Hiber := Time_Out_Limit;

if Aborting and (Time_Out_Limit > 10)
then Hiber := 10;

while not Async_BuffeR_Check (chx) do
begin
if Word (ElapsedSeconds (1)) >= Hiber
then
begin
if Time_Out_Limit < BP_Time_Out_Max
then Inc (Time_Out_Limit, 5);

Read_Byte := false;
exit;
end;

if Aborting
then if ST_Check_Abort
then
begin
Inc (Abort_Count);
if Abort_Count >= BP_Abort_Max
then
begin
Read_Byte := false;
Fatal_Abort := true;
exit;
end;
end;
end; { while }

ch := ord (chx);

inc (BP_R_Com_Data);
inc (R_Counter);
R_Counter := R_Counter mod Port_Update_Rate;

if R_Counter = 0
then
begin
ST_Display_Value (STComRead, BP_R_Com_Data);
end;
Read_Byte := true;
end;


Function Read_Quoted_Byte : boolean;

begin
Quoted := false;

if Read_Byte = false
then begin
Read_Quoted_Byte := false;
exit;
end;

if ch = dle
then
begin
if Read_Byte = false
then begin
Read_Quoted_Byte := false;
exit;
end;

if ch < $60
then ch := ch and $1f
else ch := (ch and $1f) or $80;

Quoted := true;
end;

Read_Quoted_Byte := true;
end;

{
Increment Sequence Number
}

Function Incr_Seq (value : integer) : integer;
begin
if value = 9
then Incr_Seq := 0
else Incr_Seq := value + 1;
end;

Procedure Send_Failure (Reason : lstr); forward;

Function Read_Packet (Lead_in_Seen, From_Send_Packet : boolean) : boolean;

{ Lead_in_Seen is true if the has been seen already. }

{ From_Send_Packet is true if called from Send_Packet }
{ (causes exit on first error detected) }

{ Returns True if Packet is available from host. }

var
state,
next_seq,
block_num,
errors,
new_cks : word;
i : integer;
NAK_Sent : Boolean; { True if was sent }

begin
if Packet_Received { See if a Packet was picked up on a call to }
then { Get_ACK }
begin
Packet_Received := false;
Read_Packet := true;
exit;
end;

NAK_Sent := false;
fillchar (R_buffer, BuffeR_Size, 0);
next_seq := (seq_num + 1) mod 10;
errors := 0;

if lead_in_seen { Start off on the correct foot }
then state := R_Get_Seq
else State := R_Get_DLE;

while true do
begin
case (State) of
R_Get_DLE :
begin
if not Aborting and ST_Check_Abort
then
begin
ST_Display_String (STMsg, 'Aborting download per your request');
Send_Failure ('AAborted by user');
BP_Status_Code := Aborted;
Read_Packet := false;
exit;
end;

if not Read_Byte
then State := R_Timed_Out
else if (ch and $7F) = dle
then State := R_Get_B
else if (ch and $7F) = enq
then State := R_Send_ACK;
end;


R_Get_B :
begin
if not Read_Byte
then State := R_Timed_Out
else if (ch and $7F) = ord ('B')
then State := R_Get_Seq
else if ch = enq
then State := R_Send_ACK
else if ch = ord (';')
then
begin
ST_Display_Value (STComRead, BP_R_Com_Data); { Keep user informed }
State := R_Get_DLE;
end
else State := R_Get_DLE;
end;

R_Get_Seq :
begin
if Resume_Flag { Improve status display for DOW resume }
then
begin
ResetTimer (3);
BP_R_Com_Data := 2;
end;

if not Read_Byte
then State := R_Timed_Out
else if ch = enq
then State := R_Send_ACK
else
begin
if B_Plus and Use_CRC
then checksum := Init_CRC ($ffff)
else checksum := 0;

block_num := ch - ord ('0');

Do_Checksum (ch);

i := 0;
State := R_Get_Data;
end;
end;

R_Get_Data :
begin
if not Read_Quoted_Byte
then State := R_Timed_Out
else if (ch = etx) and not Quoted
then
begin
Do_Checksum (etx);
State := R_Get_Check;
end
else
begin
R_buffer[i] := ch;
i := i + 1;
Do_Checksum (ch);
end;
end;

R_Get_Check :
begin
if not Read_Quoted_Byte
then State := R_Timed_Out
else
begin
if B_Plus and Use_CRC
then
begin
checksum := Upd_CRC (word (ch));

if not Read_Quoted_Byte
then new_cks := checksum xor $ff
else
begin
checksum := Upd_CRC (word (ch));
new_cks := 0;
end;
end
else new_cks := ch;

if new_cks <> checksum
then State := R_Error
else if R_buffer[0] = ord ('F') { Watch for Failure Packet }
then State := R_Success { which is accepted regardless }
else if block_num = seq_num { Watch for duplicate block }
then State := R_Send_ACK { Simply ACK it }
else if block_num <> next_seq
then State := R_Error { Bad sequence number }
else State := R_Success;
end;
end;

R_Timed_Out :
begin
BP_Status_Code := TimedOut;
State := R_Error;
end;

R_Error :
begin
inc (errors);

if (errors > max_Errors) or (From_Send_Packet) or (Fatal_Abort)
then
begin
Read_Packet := false;

if BP_Status_Code <> TimedOut
then BP_Status_Code := Failed;

if Fatal_Abort
then BP_Status_Code := Aborted;

exit;
end;

if (not NAK_Sent) or (not B_Plus)
then
begin
inc (BP_R_Error_Count);
ST_Display_Value (STErrRead, BP_R_Error_Count);
NAK_Sent := true;
Send_NAK;
end;

State := R_Get_DLE;
end;

R_Send_ACK :
begin
if not Aborting
then Send_ACK;

State := R_Get_DLE; { wait for the next block }
end;

R_Success :
begin
ST_Display_Value (STComRead, BP_R_Com_Data);
ST_Display_Value (STComSent, BP_S_Com_Data);

if not Aborting
then seq_num := block_num;

R_Size := i;
Read_Packet := true;
inc (BP_R_Packet_Count);
ST_Display_Value (STPacRead, BP_R_Packet_Count);
BP_Status_Code := Success;
exit;
end;

end;
end;

end; { Read_Packet }

Procedure Send_Data (BuffeR_Number : integer);
var
i : integer;

begin
with SA_Buf [BuffeR_Number] do
begin
if B_Plus and Use_CRC
then checksum := Init_CRC ($ffff)
else checksum := 0;

Send_Byte (char (dle));
Send_Byte ('B');

Send_Byte (char (seq + ord ('0')));
Do_Checksum (seq + ord ('0'));

for i := 0 to num do
begin
Send_Quoted_Byte (buf [i]);
Do_Checksum (buf[i]);
end;

Send_Byte (char (etx));
Do_Checksum (etx);

if B_Plus and Use_CRC
then Send_Quoted_Byte (checksum shr 8);

Send_Quoted_Byte (checksum);
end;
end;

Function Incr_SA (Old_Value : integer) : integer;
begin
if Old_Value = Max_SA
then Incr_SA := 0
else Incr_SA := Old_Value + 1;
end;

{ ReSync is called to restablish syncronism with the remote. This is
accomplished by sending and waiting for the sequence
to be received, ignoring everything else.

Return is -1 on time out, `B` if seen, else the digit .
}

Function ReSync : integer;
var
State,
Digit_1 : integer;

const
Get_First_DLE = 1;
Get_First_Digit = 2;
Get_Second_DLE = 3;
Get_Second_Digit = 4;

begin
Send_Byte (char (enq)); { Send }
Send_Byte (char (enq));
State := Get_First_DLE;

while true do
begin
case (State) of
Get_First_DLE :
begin
if not Read_Byte
then
begin
ReSync := -1;
exit;
end;

if ch = dle
then State := Get_First_Digit;
end;

Get_First_Digit :
begin
if not Read_Byte
then
begin
ReSync := -1;
exit;
end;

if (ch >= ord ('0')) and (ch <= ord ('9'))
then
begin
Digit_1 := ch;
State := Get_Second_DLE;
end
else if ch = ord ('B')
then
begin
ReSync := ch;
exit;
end;
end;

Get_Second_DLE :
begin
if not Read_Byte
then
begin
ReSync := -1;
exit;
end;

if ch = dle
then State := Get_Second_Digit;
end;

Get_Second_Digit :
begin
if not Read_Byte
then
begin
ReSync := -1;
exit;
end;

if (ch >= ord ('0')) and (ch <= ord ('9'))
then
begin
if Digit_1 = ch
then
begin
ReSync := ch;
exit;
end
else if ch = ord ('B')
then
begin
ReSync := ch;
exit;
end
else
begin
Digit_1 := ch;
State := Get_Second_DLE;
end
end
else State := Get_Second_DLE;
end;

end; { case }
end; { while true }
end;

{
Get_ACK is called to wait until the SA_Buf indicated by SA_Next_to_ACK
has been ACKed by the host.
}

Function Get_ACK : boolean;
var
State,
errors,
block_num,
i : integer;
new_cks : integer;
Sent_ENQ : boolean;
SA_Index : integer;

begin
Packet_Received := false;
errors := 0;
Sent_ENQ := false;
State := S_Get_DLE;

while true do
begin
case (State) of
S_Get_DLE :
begin
if not Aborting and ST_Check_Abort
then
begin
ST_Display_String (STMsg, 'Aborting the upload per your request');
Send_Failure ('AAborted by user');
Get_ACK := false;
BP_Status_Code := Aborted;
exit;
end;

if not Read_Byte
then State := S_Timed_Out
else
begin
if ch = dle
then State := S_Get_Num
else if ch = nak
then State := S_Send_ENQ
else if ch = etx
then State := S_Send_NAK;
end;
end;

S_Get_Num :
begin
if not Read_Byte
then State := S_Timed_Out
else if (ch >= ord ('0')) and (ch <= ord ('9'))
then State := S_Have_ACK { Received ACK }
else if ch = ord ('B')
then
begin
if not Aborting
then State := S_Get_Packet { Try to receive a Packet }
else State := S_Skip_Packet; { Try to skip a Packet }
end
else if ch = nak
then State := S_Send_ENQ
else if ch = ord (';')
then
begin { Received a WACK (Wait Acknowledge) }
ST_Display_Value (STComRead, BP_R_Com_Data); { Keep user informed }
State := S_Get_DLE
end
else State := S_Get_DLE;
end;

S_Get_Packet :
begin
if Read_Packet (true, true)
then
begin
Packet_Received := true;

if R_buffer [0] = ord ('F') { Check for Failure Packet }
then
begin
Send_ACK;
Get_ACK := false;
BP_Status_Code := Failed;
exit;
end;

State := S_Get_DLE; { Stay here to find the ACK }
end
else State := S_Get_DLE; { Receive failed; keep watching for ACK }
end;

S_Skip_Packet :
begin { Skip an incoming Packet }
if not Read_Byte
then State := S_Timed_Out
else if ch = ETX
then
begin { Get the Checksum or CRC }
if not Read_Quoted_Byte
then State := S_Timed_Out
else if not Use_CRC
then State := S_Get_DLE
else if not Read_Quoted_Byte
then State := S_Timed_Out
else State := S_Get_DLE;
end;
end;

S_Have_ACK :
begin
block_num := ch - ord ('0');
ST_Display_Value (STComSent, BP_S_Com_Data);
ST_Display_Value (STComRead, BP_R_Com_Data);

if SA_Buf [SA_Next_to_ACK].seq = block_num
then
begin { THis is the one we're waiting for }
SA_Next_to_ACK := Incr_SA (SA_Next_to_ACK);
SA_Waiting := SA_Waiting - 1;

if SA_Error_Count > 0 { Apply heuristic to control }
then Dec (SA_Error_Count); { Upload Performance degradation }

Get_ACK := true;
exit;
end
else if (SA_Buf [Incr_SA (SA_Next_to_ACK)].seq = block_num) and
(SA_Waiting = 2)
then
begin { Must have missed an ACK }
SA_Next_to_ACK := Incr_SA (SA_Next_to_ACK);
SA_Next_to_ACK := Incr_SA (SA_Next_to_ACK);
SA_Waiting := SA_Waiting - 2;

if SA_Error_Count > 0
then Dec (SA_Error_Count);

Get_ACK := true;
exit;
end
else if SA_Buf [SA_Next_to_ACK].seq = Incr_Seq (block_num)
then
begin
if Sent_ENQ
then State := S_Send_Data { Remote missed first block }
else State := S_Get_DLE; { Duplicate ACK }
end
else
begin
if not Aborting { While aborting, ignore any }
then State := S_Timed_Out { ACKs that have been sent }
else State := S_Get_DLE; { which are not for the failure }
end; { Packet. }

Sent_ENQ := false;
end;

S_Timed_Out :
begin
BP_Status_Code := TimedOut;
State := S_Send_ENQ;
end;

S_Send_NAK :
begin
inc (errors);
inc (BP_S_Error_Count);
ST_Display_Value (STErrSent, BP_S_Error_Count);

if (errors > max_Errors) or Fatal_Abort
then
begin
if BP_Status_Code <> TimedOut
then BP_Status_Code := Failed;

if Fatal_Abort
then BP_Status_Code := Aborted;

Get_ACK := false;
exit;
end;

Send_NAK;

State := S_Get_DLE;
end;

S_Send_ENQ :
begin
inc (errors);
inc (BP_S_Error_Count);
ST_Display_Value (STErrSent, BP_S_Error_Count);

if (errors > max_Errors) or (Aborting and (errors > 3))
then
begin
BP_Status_Code := Failed;
Get_ACK := false;
exit;
end;

ch := ReSync;
if ch = -1
then State := S_Get_DLE
else if ch = ord ('B')
then
begin
if not Aborting
then State := S_Get_Packet { Try to receive a Packet }
else State := S_Skip_Packet; { Try to skip a Packet }
end
else State := S_Have_ACK;
Sent_ENQ := true;
end;

S_Send_Data :
begin
inc (SA_Error_Count, 3);

if SA_Error_Count >= 12 { Stop Upload Send Ahead if too many }
then SA_Max := 1; { errors have occured }

SA_Index := SA_Next_to_ACK;

for i := 1 to SA_Waiting do
begin
Send_Data (SA_Index);
SA_Index := Incr_SA (SA_Index);
end;

State := S_Get_DLE;
Sent_ENQ := false;
end;
end;
end;
end; { Get_ACK }

Function Send_Packet (size : integer) : boolean;
begin
while SA_Waiting >= SA_Max do { Allow for possible drop out of Send Ahead }
if not Get_ACK
then
begin
Send_Packet := false;
exit;
end;

seq_num := Incr_Seq (seq_num);
SA_Buf [SA_Next_to_Fill].seq := seq_num;
SA_Buf [SA_Next_to_Fill].num := size;
Send_Data (SA_Next_to_Fill);
SA_Next_to_Fill := Incr_SA (SA_Next_to_Fill);
SA_Waiting := SA_Waiting + 1;
Send_Packet := true;
inc (BP_S_Packet_Count);
ST_Display_Value (STComSent, BP_S_Com_Data);
ST_Display_Value (STPacSent, BP_S_Packet_Count);
end;

{
SA_Flush is called after sending the last Packet to get host's
ACKs on outstanding Packets.
}

Function SA_Flush : boolean;
begin
while SA_Waiting > 0 do
begin
if not Get_ACK
then
begin
SA_Flush := false;
exit;
end;

SA_Flush := true;
end;

end;

Procedure Send_Failure { Reason : lstr } ;
var
i : integer;
dummy : boolean;

begin
SA_Next_to_ACK := 0;
SA_Next_to_Fill := 0;
SA_Waiting := 0;
Aborting := true; { Inform Get_ACK we're aborting ]}

with SA_Buf [0] do
begin
buf [0] := ord ('F');
for i := 1 to length (Reason) do buf [i] := ord (Reason [i]);
end;

if send_Packet (length (Reason))
then dummy := SA_Flush; { Gotta wait for the Initiator to ACK it }

end;

{ Send_File is called to send a file to the host }
{$I-}

Function Send_File (name : lstr) : boolean;

var n : integer;
data_File : File;

begin
assign (data_File,name);
reset (data_File, 1); { Record size of 1 }

if ioresult > 0
then
begin
ST_Display_String (STMsg, 'Cannot find that file');
Send_Failure ('MFile not found');
Send_File := false;
exit;
end;

BP_S_Remaining := FileSize (Data_File);
ST_Display_Value (STUplRem, BP_S_Remaining);
{ Send_File_Information here ? }

{------------------
BP_S_Com_Data := 0;
BP_R_Com_Data := 0;
ResetTimer (3);
---------------------}

repeat
with SA_Buf [SA_Next_to_Fill] do
begin
buf [0] := ord ('N');

BlockRead (data_File, buf [1], BuffeR_Size, n);
end;

if IOResult > 0
then n := -1;

if n > 0
then
begin
if send_Packet (n) = false
then
begin
Send_File := false;
exit;
end;

BP_S_File_Data := BP_S_File_Data + LongInt (n);
BP_S_File_Size := BP_S_File_Size + LongInt (n);
BP_S_Remaining := BP_S_Remaining - LongInt (n);
ST_Display_Value (STUplSize, BP_S_File_Size);
ST_Display_Value (STDataSent, BP_S_File_Data);
ST_Display_Value (STUplRem, BP_S_Remaining);
BP_Elapsed_Time := ElapsedSeconds (3);
ST_Display_Value (STElapsed, BP_Elapsed_Time);

if BP_Elapsed_Time <> 0
then
begin
BP_Com_Rate := BP_S_Com_Data div BP_Elapsed_Time;
BP_Data_Rate := BP_S_File_Data div BP_Elapsed_Time;
ST_Display_Value (STComRate, BP_Com_Rate);
ST_Display_Value (STDataRate, BP_Data_Rate);

if BP_Data_Rate <> 0
then
begin
BP_Time_Estimate := BP_S_Remaining div BP_Data_Rate;
ST_Display_Value (STRemTime, BP_Time_Estimate);
end;
end;
end;
until not (n > 0);

if n < 0
then
begin
Send_Failure ('EFile read failure');
ST_Display_String (STMsg, 'Read failure...aborting');
Send_File := false;
exit
end;

{ Inform host that the file was sent }

with SA_Buf [SA_Next_to_Fill] do
begin
buf [0] := ord ('T');
buf [1] := ord ('C');
end;

if send_Packet (2) = false
then
begin
close (data_File);
Send_File := false;
exit;
end
else
begin
close (data_File);
if not SA_Flush
then
begin
Send_File := false;
exit;
end;
Send_File := true;
exit;
end;

end; { Send_File }

{$I+}
{
Do_Transport_Parameters is called when a Packet type of + is received.
It sends a Packet of Our local B Plus parameters and sets the Our_xx
parameters to the minimum of the Initiator's and Our own parameters.
}

Procedure Do_Transport_Parameters;
var
Quote_Set_Present : boolean;
i : integer;

begin
if BP_Special_Quoting
then Our_QS := BP_Special_Quote_Set
else Our_QS := DQ_Minimal;

for i := R_Size + 1 to 512 do R_buffer [i] := 0;

His_WS := R_buffer [1]; { Pick out Initiator's parameters }
His_WR := R_buffer [2];
His_BS := R_buffer [3];
His_CM := R_buffer [4];

His_QS [0] := R_buffer [7];
His_QS [1] := R_buffer [8];
His_QS [2] := R_buffer [9];
His_QS [3] := R_buffer [10];
His_QS [4] := R_buffer [11];
His_QS [5] := R_buffer [12];
His_QS [6] := R_buffer [13];
His_QS [7] := R_buffer [14];

His_DR := R_buffer [15];
His_UR := R_buffer [16];
His_FI := R_buffer [17];

if R_Size >= 14
then Quote_Set_Present := true
else Quote_Set_Present := false;

with SA_Buf [SA_Next_to_Fill] do
begin
buf [0] := ord ('+'); { Prepare to return Our own parameters }
buf [1] := Def_WS;
buf [2] := Def_WR;
buf [3] := Def_BS;
buf [4] := Def_CM;
buf [5] := Def_DQ;
buf [6] := 0; { No transport layer here }

for i := 0 to 7 do buf [i + 7] := Our_QS [i];

if BP_Auto_Resume { Set Download Resume according to }
then Def_DR := 2 { user's preference }
else Def_DR := 1;

buf [15] := Def_DR;
buf [16] := Def_UR;
buf [17] := Def_FI;
end;

Update_Quote_Table (DQ_Full); { Send the + Packet under full quoting }

if not Send_Packet (17)
then exit;

if SA_Flush { Wait for host's ACK on Our Packet }
then
begin
if His_WS < Def_WR { Take minimal subset of Transport Params. }
then Our_WR := His_WS { If he can send ahead, we can receive it. }
else Our_WR := Def_WR;

if His_WR < Def_WS { If he can receive send ahead, we can send it. }
then Our_WS := His_WR
else Our_WS := Def_WS;

if His_BS < Def_BS
then Our_BS := His_BS
else Our_BS := Def_BS;

if His_CM < Def_CM
then Our_CM := His_CM
else Our_CM := Def_CM;

if His_DR < Def_DR
then Our_DR := His_DR
else Our_DR := Def_DR;

if His_UR < Def_UR
then Our_UR := His_UR
else Our_UR := Def_UR;

if His_FI < Def_FI
then Our_FI := His_FI
else Our_FI := Def_FI;

if Our_BS = 0
then Our_BS := 4; { Default }

BuffeR_Size := Our_BS * 128;

B_Plus := true;

if Our_CM = 1
then Use_CRC := true;

if Our_WS <> 0
then
SA_Max := Max_SA;
end;

Clear_Quote_Table; { Restore Our Quoting Set }
Update_Quote_Table (Our_QS);

if Quote_Set_Present
then { Insert Initiator's Quote Set }
Update_Quote_Table (His_QS);
end;

{$I-}
{ Check_Keep is called from Receive_File when a fatal error }
{ occurs. It asks the user if the file should be retained }

Procedure Check_Keep (var data_File : File; Name : lstr);
var
P : STStringType;
YN : Char;

begin
close (data_File);

if (not BP_Auto_Resume) or (not B_Plus) or (Our_DR = 0)
then
begin
P := 'Do you wish to retain the partial ' + Name + '? ';
ST_Yes_or_No (P, YN);
end
else
YN := 'Y';

if YN = 'N'
then
begin
erase (data_File);
ST_Display_String (STMsg, 'File erased.');
end
else
begin
{ Hide the file from casual view }
{---- DOS.SetFAttr (data_File, DOS.Hidden); ----}
{---- ST_Display_String (STMsg, 'File retained and hidden.'); ----}
ST_Display_String (STMsg, 'File retained.');
end;
end;

{ Process_File_Information is called from Receive_File when a TI Packet }
{ is received. It extracts the desired information from the Packet. }

Procedure Process_File_Information;

var
Val_Str : string [50];
i, j, n : Integer;
Digit_Seen : boolean;

Procedure Extract_String; { Extract next string of characters }
begin
Digit_Seen := false;
j := 0;
while i <= n do
begin
if (R_Buffer [i] >= ord ('0')) and (R_Buffer [i] <= ord ('9'))
then
begin
Digit_Seen := true;
j := j + 1;
Val_Str [j] := char (R_Buffer [i]);
end
else if Digit_Seen
then
begin
Val_Str [0] := char (j);
exit;
end;

i := i + 1;
end;
end;

begin
n := R_Size - 1;
i := 4; { Skip data type and compression flag }
Extract_String;
Val (Val_Str, BP_R_Remaining, j);
BP_R_Remaining := BP_R_Remaining - BP_R_File_Size; { Adjust for Dow Resume }
ST_Display_Value (STDowRem, BP_R_Remaining);

{ Ignore rest of parameters for now }

BP_S_Packet_Count := 0;
BP_R_Packet_Count := 0;
end;

{ Receive_File is called to receive a file from the host }

Function Receive_File (Name : lstr) : boolean;

var
data_File : File;
status : integer;
File_Length : LongInt; { For download resumption }
Work_String : lstr;
Packet_Len : integer;
i, n : integer;
YN : Char;
Dow_Type : char;
Attribute : word;

begin
assign (data_File, Name);
Dow_Type := 'D'; { Assume normal downloading }

reset (data_File, 1);

if IoResult = 0
then
begin { See if we can try automatic resume }
if (Our_DR > 1) and BP_Auto_Resume
then Dow_Type := 'R' { Remote supports `Tf', let's try it }
else if (Our_DR > 0)
then
begin
ST_Display_String (STMsg, 'File already exists.');
ST_Yes_or_No ('Do you wish to resume downloading? ', YN);

if YN = 'Y'
then Dow_Type := 'R'
else ST_Display_String (STMsg, 'File being overwritten.');
end;

{ Make the file visible }
DOS.SetFAttr (data_File, 0);
end;

case Dow_Type of
'D' :
begin
rewrite (Data_File, 1);
if ioresult > 0
then
begin
Send_Failure ('CCannot create file');
Receive_File := false;
exit;
end;

Send_ACK;
end;

'R' :
begin { Resume download }
reset (Data_File, 1);
if ioresult > 0
then
begin
Send_Failure ('MFile not found');
Receive_File := false;
exit;
end;
ST_Display_String (STMsg, 'Calculating CRC');

with SA_Buf [SA_Next_to_Fill] do
begin
if Dow_Type = 'R'
then
begin
checksum := Init_CRC ($ffff);
repeat
BlockRead (data_File, buf [0], BuffeR_Size, n);
for i := 0 to n - 1 do
begin
checksum := Upd_CRC (word (buf [i]));
end;
until n <= 0;
end
else
checksum := 0;

buf [0] := ord ('T');
buf [1] := ord ('r');

Packet_Len := 2;
File_Length := FileSize (Data_File);

str (File_Length, Work_String);
Work_String := concat (Work_String, ' ');

for i := 1 to length (Work_String) do
begin
buf [Packet_Len] := ord (Work_String [i]);
Packet_Len := Packet_Len + 1;
end;

str (checksum, Work_String);
Work_String := concat (Work_String, ' ');

for i := 1 to length (Work_String) do
begin
buf [Packet_Len] := ord (Work_String [i]);
Packet_Len := Packet_Len + 1;
end;
end;

if not Send_Packet (Packet_Len - 1) { Send_Data sends 0..Size }

then
begin
close (Data_File);
Receive_File := false;
exit;
end;

if not SA_Flush
then
begin
close (Data_File);
Receive_File := false;
exit;
end;

Seek (Data_File, File_Length); { Ready to append }
BP_R_File_Size := File_Length;
ST_Display_Value (STDowSize, BP_R_File_Size);
ST_Display_String (STMsg, 'Host calculating CRC...');
Resume_Flag := true;
end;
end;


{
Process each incoming Packet until 'TC' Packet received or failure
}

BP_R_Packet_Count := 0;
BP_S_Packet_Count := 0;

if BP_Use_File_Size
then BP_R_Remaining := BP_File_Size
else BP_R_Remaining := LongInt (0);

while true do
begin
if Read_Packet (false, false)
then
begin
case chr (R_buffer[0]) of
'N' :
begin
if Resume_Flag
then
begin
ST_Display_String (STMsg, 'Resuming Download');
Resume_Flag := false;
end;

BlockWrite (data_File, R_buffer [1], R_Size - 1, status);

BP_Elapsed_Time := ElapsedSeconds (3);
BP_R_File_Data := BP_R_File_Data + LongInt (R_Size - 1);
ST_Display_Value (STDataRead, BP_R_File_Data);
BP_R_File_Size := BP_R_File_Size + LongInt (status);
ST_Display_Value (STDowSize, BP_R_File_Size);

ST_Display_Value (STElapsed, BP_Elapsed_Time);

if BP_Elapsed_Time <> 0
then
begin
BP_Com_Rate := BP_R_Com_Data div BP_Elapsed_Time;
BP_Data_Rate := BP_R_File_Data div BP_Elapsed_Time;
ST_Display_Value (STComRate, BP_Com_Rate);
ST_Display_Value (STDataRate, BP_Data_Rate);
end
else BP_Data_Rate := 0;

if BP_R_Remaining <> 0
then { Decrement remaining byte count }
begin
BP_R_Remaining := BP_R_Remaining - (R_Size - 1);
ST_Display_Value (STDowRem, BP_R_Remaining);

if BP_Data_Rate <> 0
then
begin
BP_Time_Estimate := BP_R_Remaining div BP_Data_Rate;
ST_Display_Value (STRemTime, BP_Time_Estimate);
end;
end;

if (status <> (R_Size - 1)) or (IOResult <> 0)
then
begin
ST_Display_String (STMsg, 'Write failure...aborting');
Send_Failure ('EWrite failure');
Check_Keep (data_File, Name);
Receive_File := false;
exit;
end;

Send_ACK;
end;

'T' :
begin
if R_buffer[1] = ord ('C')
then
begin
ST_Display_String (STMsg, '*** Transfer Complete ***');
close (data_File);

if IOResult > 0
then
begin
ST_Display_String (STMsg, 'Failure during close...aborting');
Send_Failure ('EError during close');
Check_Keep (data_File, Name);
Receive_File := false;
exit;
end;

Send_ACK;
Receive_File := true;
exit;
end
else if R_Buffer [1] = ord ('I')
then
begin
Send_ACK;
Process_File_Information;
end
else if (R_Buffer [1] = ord ('f')) and BP_Auto_Resume
then { `Tf' Packet implies host failed the }
begin { CRC check on a DOW resume }
close (Data_File); { So...replace the file }
rewrite (Data_File, 1);
if ioresult > 0
then
begin
Send_Failure ('CCannot create file');
ST_Display_String (STMsg, 'CRC check failed; cannot create file');
Receive_File := false;
exit;
end;

if (Our_FI <> 0) or BP_Use_File_Size
then BP_R_Remaining := BP_R_Remaining + BP_R_File_Size;

BP_R_File_Size := 0;
ST_Display_String (STMsg, 'CRC check failed; overwriting file');
Resume_Flag := false;
ResetTimer (3);
BP_S_Com_Data := 0;
BP_R_Com_Data := 0;
Send_ACK;
end
else
begin
ST_Display_String (STMsg, 'Invalid termination Packet...aborting');
Send_Failure ('NInvalid T Packet');
Check_Keep (data_File, Name);
Receive_File := false;
exit;
end;
end;

'F' :
begin
Send_ACK;
ST_Display_String (STMsg, 'Failure Packet received...aborting');
Check_Keep (data_File, Name);
Receive_File := false;
exit;
end;

end;

end
else
begin
if not Aborting
then ST_Display_String (STMsg, 'Download failure');
Check_Keep (data_File, Name);
Receive_File := false;
exit;
end;
end;

end; { Receive_File }

{$I+}

{ =================================================================== }

begin { DLE_Seen }


{
Begin by getting the next character. If it is then enter the
B_Protocol state. Otherwise simply return.
}

Port_Update_Rate := 30;

if not Read_Byte
then exit;

if ch <> ord ('B')
then exit;

SA_Next_to_ACK := 0; { Initialize Send-ahead variables }
SA_Next_to_Fill := 0;
SA_Waiting := 0;
Aborting := false;
Fatal_Abort := false;
Abort_Count := 0;
Packet_Received := false;
Time_Out_Limit := 5; { We'll start with 5 seconds per-char timeout }

{ Establish Data Block Size as a Function of the Baud }
{ The intent is to keep the per-Packet time to 4-5 seconds }

case Async4.PortBps of
bps110, bps150, bps300 :
begin
Def_BS := 1;
Port_Update_Rate := 30;
end;
bps600, bps1200 :
begin
Def_BS := 4;
Port_Update_Rate := 120;
end;
bps1800 :
begin
Def_BS := 6;
Port_Update_Rate := 180;
end;
bps2400, bps4800, bps9600 :
begin
Def_BS := 8;
Port_Update_Rate := 240;
end;
end;

{ received; begin B Protocol }

xoff_flag := true;

R_Counter := 0;
S_Counter := 0;
BP_R_File_Data := LongInt (0);
BP_S_File_Data := LongInt (0);
BP_R_Com_Data := LongInt (0);
BP_S_Com_Data := LongInt (0);
BP_S_Packet_Count := LongInt (0);
BP_R_Packet_Count := LongInt (0);
BP_S_File_Size := LongInt (0);
BP_R_File_Size := LongInt (0);
BP_S_Error_Count := LongInt (0);
BP_R_Error_Count := LongInt (0);
BP_Status_Code := Success;
Resume_Flag := false;

if Read_Packet (true, false)
then
begin
{ Dispatch on the type of Packet just received }

case chr (R_buffer[0]) of
'T': begin { File Transfer Application }
ST_Initialize;
ST_Display_Value (STComRead, BP_R_Com_Data);
BP_S_Com_Data := 0;
BP_R_Com_Data := 0;
ResetTimer (3);

case chr (R_buffer[1]) of
'D' : ST_Display_String (STUpDow, 'Downloading ');
'U' : ST_Display_String (STUpDow, 'Uploading ');
else
begin
ST_Display_String (STMsg, 'Unimplemented Transfer Function');
Send_Failure ('NUnimplemented Transfer Function');
ST_Terminate;
BP_Status_Code := Failed;
exit;
end;
end;

case chr (R_buffer[2]) of
'A': ST_Display_String (STType, 'ASCII');
'B': ST_Display_String (STType, 'Binary');
else
begin
ST_Display_String (STMsg, 'Unimplemented File Type');
Send_Failure ('NUnimplemented file type');
ST_Terminate;
BP_Status_Code := Failed;
exit;
end;
end;

i := 2;
filename := '';

while (R_buffer[i] <> 0) and (i < R_Size - 1) do
begin
i := i + 1;
filename := filename + chr (R_buffer[i]);
end;

ST_Display_String (STFile, filename);
BP_S_Packet_Count := LongInt (0);
BP_R_Packet_Count := LongInt (0);

if R_buffer[1] = ord ('U')
then
dummy := Send_File (filename)
else
dummy := Receive_File (filename);

if dummy
then BP_Status_Code := Success;

Delay (3000);
ST_Terminate;
end;

'+': { Received Transport Parameters Packet }
begin
Do_Transport_Parameters;
end;

else
begin { Unknown Packet; tell the host we don't know }
Send_Failure ('NUnknown Packet Type');
BP_Status_Code := Failed;
end;

end; { of case }

end; { of if Read_Packet then}

end; { DLE_Seen }

begin
{ Unit Initialization }

BP_Auto_Resume := false;
BP_Use_File_Size := false;
BP_Special_Quoting := false;
BP_Special_Quote_Set := DQ_Minimal; { We _HAVE_ to quote these! }
BP_Status_Code := Success;
BP_Abort_Max := 4;
End.


  3 Responses to “Category : Pascal Source Code
Archive   : BPLUS.ZIP
Filename : BPLUS.PAS

  1. Very nice! Thank you for this wonderful archive. I wonder why I found it only now. Long live the BBS file archives!

  2. This is so awesome! 😀 I’d be cool if you could download an entire archive of this at once, though.

  3. But one thing that puzzles me is the “mtswslnkmcjklsdlsbdmMICROSOFT” string. There is an article about it here. It is definitely worth a read: http://www.os2museum.com/wp/mtswslnk/