home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / OOBPLS10.ZIP / OOBPLUS.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1992-11-06  |  53.5 KB  |  1,810 lines
  1. {$A+,B-,D-,E-,F+,I-,L-,N-,O+,R-,S-,V-}
  2.  
  3. {***********************************************}
  4. {*             OOBPLUS.PAS  1.0                *}
  5. {*       Copyright (c) Steve Sneed 1991        *}
  6. {*            All Rights Reserved              *}
  7. {*                                             *}
  8. {*  Provided to TurboPower Software for their  *}
  9. {*   use or distribution with their products   *}
  10. {***********************************************}
  11.  
  12. unit OOBPlus;  {CompuServe B+ protocol objects}
  13.  
  14. {*** PLEASE SEE OOBPLUS.DOC BEFORE USING THIS UNIT! ***}
  15.  
  16. {$I APDEFINE.INC}
  17.  
  18. {The following define is used to specify status updates at more frequent
  19.  intervals than normal.  This makes the status display more informative and
  20.  causes the "Time to go" field to just about tick like a clock on downloads,
  21.  but it can have a negative effect on thruput at higher bps rates and can
  22.  cause the CPS field to "jitter" somewhat, especially on uploads.}
  23.  
  24. {.$DEFINE ShowRates}
  25.  
  26.  
  27. {$IFNDEF UseOpro}
  28. {$IFDEF SupportGIF}
  29.     !!! The options selected are incompatible with this unit !!!
  30. {$ENDIF}
  31. {$ENDIF}
  32.  
  33. interface
  34.  
  35. uses
  36.   DOS,
  37.   OpString,
  38.   OpCrt,
  39.   ApMisc,
  40.   ApTimer,
  41.   ApPort,
  42.   ApInt14,
  43.   ApUart,
  44.   OOCom,
  45.   OOAbsPcl;
  46.  
  47. const
  48.   UnitVers = '1.2j';
  49.   UnitDate = '02-Nov-92';
  50.  
  51. const
  52.   CounterOn : Boolean = False;
  53.   CPSCount  : LongInt = 0;
  54.  
  55. var
  56.   CPSTimer  : EventTimer;
  57.  
  58. const
  59.     {consts needed here for status, continued from ApMisc}
  60.   ecResync    = 9980;
  61.   ecWaitACK   = 9981;
  62.   ecDropout   = 9982;
  63.   ecHostCan   = 9983;
  64.   ecFileIO    = 9984;
  65.   ecTryResume = 9985;
  66.   ecHostResume= 9986;
  67.   ecResumeOK  = 9987;
  68.   ecResumeBad = 9988;
  69.   ecOverwrite = 9989;
  70.   ecUnPacket  = 9990;
  71.  
  72.   BP_Timeout_Max = 15;   {max allowed timeout per-char}
  73.   BP_Error_Max = 10;     {max sequential errors}
  74.   BP_Buffer_Max = 1032;  {largest data block available}
  75.   BP_Abort_Max = 3;      {number of abort requests req'd to trigger Override}
  76.   BP_SendAhead_Max = 2;  {max number of packets we can send ahead}
  77.  
  78.     {minimum <ESC><'I'> (and GIF support interrogation) response strings}
  79.   ESCI_Response : String[80] = '#OZ3,OzCIS1,AC,CA,SSxx,GF,PB,DT';
  80.  
  81.     {see the GIF87a or 89a spec for explanation of these codes}
  82.   GIFReplyEGA  = '#89a;1;0,320,200,4,0;0,640,200,2,2;0,640,350,4,2';
  83.   GIFReplyCGA  = '#89a;1;0,320,200,2,0;0,640,200,1,0';
  84.   GIFReplyHGC  = '#89a;1;0,720,350,1,0';
  85.   GIFReplyNONE = '';
  86.   GIFReply : String[60] = GIFReplyEGA;
  87.  
  88. type
  89.     {used by GetResumeProc for resume request handling}
  90.   ResumeResultType = (xfrResume, xfrOverwrite, xfrRename, xfrAbort);
  91.  
  92.   BufferType = Array[0..BP_Buffer_Max] of Byte;  {a buffer of data}
  93.   SABuffType =                                   {windowing buffer:}
  94.     record
  95.       Seq : Integer;                             {this sequence number}
  96.       Num : Integer;                             {this packet's data size}
  97.       Buf : BufferType;                          {this packet's data}
  98.     end;
  99.   SPackets = Array[0..BP_SendAhead_Max] of SABuffType;
  100.  
  101.   QuoteArray = Array[0..7] of Byte;         {for quoting params sets}
  102.  
  103. const
  104.   DQFull    :      {all chars in ranges $00..$1F and $80..$9F}
  105.     QuoteArray = ($FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF);
  106.   DQDefault :      {ETX ENQ DLE XON XOFF NAK}
  107.     QuoteArray = ($14, $00, $D4, $00, $00, $00, $00, $00);
  108.   DQExtend  :      {same as DQDefault plus XON & XOFF w/ high bit set}
  109.     QuoteArray = ($14, $00, $D4, $00, $00, $00, $50, $00);
  110.   DQClassic :      {Classic B set, all chars in range $00..$1F}
  111.     QuoteArray = ($FF, $FF, $FF, $FF, $00, $00, $00, $00);
  112.  
  113. type
  114.   ParamsRecord =                            {xfer params record:}
  115.     record
  116.       WinSend,                              {send window size}
  117.       WinRecv,                              {recv window size}
  118.       BlkSize,                              {block size (* 128)}
  119.       ChkType  : Byte;                      {check type, chksum or CRC}
  120.       QuoteSet : QuoteArray;                {chars to quote}
  121.       DROpt,                                {DL Recovery option}
  122.       UROpt,                                {UL Recovery option}
  123.       FIOpt    : Byte;                      {File Info option}
  124.     end;
  125.  
  126.     {protocol direction options}
  127.   DirectionType = (Upload, Download, Unknown);
  128.  
  129.   BPProtocolPtr = ^BPProtocol;
  130.   GetResumeProc = function(BPP : BPProtocolPtr) : ResumeResultType;
  131.   ChkAbortProc = function : Boolean;
  132.  
  133.   BPProtocol =                               {abstract BPlus object:}
  134.     object(AbstractProtocol)
  135.       Ch        : Integer;                   {curr char sent/recd}
  136.       Quoted    : Boolean;                   {true if last ch recd was quoted}
  137.       QuoteTable: Array[0..255] of Byte;     {our active quoting table}
  138.       Checksum  : Word;                      {may hold CRC}
  139.       Direction : DirectionType;             {upload or download}
  140.       DefResume : ResumeResultType;          {default resume handling}
  141.       GetResume : GetResumeProc;             {determine how to handle resume}
  142.       ChkAbort  : ChkAbortProc;              {see if user wants an abort}
  143.  
  144.       HisParams : ParamsRecord;              {host's parameters}
  145.       OurParams : ParamsRecord;              {our parameters}
  146.  
  147.       AbortCount: Integer;                   {# of abort requests so far}
  148.       ResumeFlag: Boolean;                   {true if resuming an aborted dl}
  149.       ResumeOK  : Boolean;                   {true if resume was successful}
  150.       Aborting  : Boolean;                   {true if processing abort}
  151.       FatalAbort: Boolean;                   {true if OverrideAbort}
  152.       ShowStatus: Boolean;                   {False only for GIF}
  153.       PacketRecd: Boolean;                   {true if packet recd in SendPacket}
  154.       BPlus     : Boolean;                   {true if in full B+ mode}
  155.       ClassicB  : Boolean;                   {true for "original" B proto}
  156.       UseSQuote : Boolean;                   {true if using special quote set}
  157.       LastXferOK: Boolean;                   {true if last xfer completed OK}
  158.       SQuoteSet : QuoteArray;                {user's specified quote set}
  159.  
  160.       RSize     : Integer;                   {size of last recd buffer}
  161.       BuffeRSize: Integer;                   {current allowed recv size}
  162.       RBuffer   : BufferType;                {receive buffer}
  163.       SBuffer   : SPackets;                  {sending buffers}
  164.       SeqNum    : Integer;                   {current xmit sequence number}
  165.       Next2ACK  : Integer;                   {packet pending ACK}
  166.       Next2Fill : Integer;                   {packet to load for send}
  167.       SAMax     : Integer;                   {highest current sendahead cnt}
  168.       SAWaiting : Integer;                   {# of packets outstanding ACKs}
  169.       SAErrors  : Integer;                   {keep track of SendAhead errors}
  170.  
  171.       R_Raw     : LongInt;                   {vars for status display}
  172.       R_Packets : LongInt;
  173.       S_Raw     : LongInt;
  174.       S_Packets : LongInt;
  175. {$IFDEF ShowRates}
  176.       R_Counter : LongInt;
  177.       S_Counter : LongInt;
  178. {$ENDIF}
  179.  
  180.       constructor Init(AP : AbstractPortPtr);
  181.       destructor Done; virtual;
  182.  
  183.       {...public methods called by terminal handlers}
  184.       procedure bpHandleENQ;
  185.         {-handle an <ENQ> from host}
  186.       procedure bpHandleESCI;
  187.         {-handle <ESC><'I'> (VT52 terminal capabilities inquiry) from host}
  188.       function bpDLESeen : Boolean; virtual;
  189.         {-called when <DLE> seen from host, starts protocol}
  190.  
  191.       {...other publics}
  192.       procedure bpSetResumeProc(RP : GetResumeProc);
  193.         {-set our ResumeProc for this instance}
  194.       procedure bpSetChkAbortProc(CAP : ChkAbortProc);
  195.         {-set our ChkAbortProc for this instance}
  196.       procedure bpSendACK;
  197.         {-send acknowledgement of receipt for good packet}
  198.  
  199.       {...private methods}
  200.       procedure UpdateStatus(W : Word);
  201.       procedure UpdateQuoteTable(QS : QuoteArray);
  202.       procedure QuoteThis(Value : Integer);
  203.       procedure apResetProtocol; virtual;
  204.       procedure apUpdateBlockCheck(CurByte : Byte); virtual;
  205.       function CheckAbort : Boolean;
  206.       procedure SendByte(C : Char);
  207.       procedure SendQuotedByte(I : Integer);
  208.       procedure SendNAK;
  209.       procedure SendENQ;
  210.       function IncSequence(Value : Integer) : Integer;
  211.       function ReadByte : Boolean;
  212.       function ReadQuotedByte : Boolean;
  213.       procedure SendFailure(Reason : String);
  214.       function ReadPacket(LeadInSeen, FromSend : Boolean) : Boolean;
  215.       procedure SendData(BNum : Integer);
  216.       function IncSA(Value : Integer) : Integer;
  217.       function ReSync : Integer;
  218.       function GetACK : Boolean;
  219.       function SAFlush : Boolean;
  220.       function SendPacket(Size : Integer) : Boolean;
  221.       function SendTransport : Boolean;
  222.       procedure ProcessTransportParams(SendXPortInfo : Boolean);
  223.       procedure bpInitVars;
  224.     end;
  225.  
  226.   BPProtoFTPPtr = ^BPProtoFTP;
  227.   BPProtoFTP =
  228.     object(BPProtocol)
  229.       constructor Init(AP : AbstractPortPtr;
  230.                        DefaultResume : ResumeResultType);
  231.       destructor Done; virtual;
  232.  
  233.       {...public/virtual methods}
  234.       function bpDLESeen : Boolean; virtual;
  235.       procedure apPrepareReading; virtual;
  236.       procedure apFinishReading; virtual;
  237.       procedure apFinishWriting; virtual;
  238.       procedure apPrepareWriting; virtual;
  239.  
  240.       {...private methods}
  241.       procedure SendFile;
  242.       procedure RecvFile;
  243.     end;
  244.  
  245.   BPProtoGIFPtr = ^BPProtoGIF;
  246.   BPProtoGIF =
  247.     object(BPProtocol)
  248.       constructor Init(AP : AbstractPortPtr);
  249.       destructor Done; virtual;
  250.  
  251.       {...public/virtual methods}
  252.       function bpDLESeen : Boolean; virtual;
  253.       function bpGetGIFDataBlock(var P;
  254.                                  var PSize : Word;
  255.                                  var IsLast : Boolean) : Boolean;
  256.     end;
  257.  
  258. function bpStatusStr(Code : Word) : String;
  259.   {-provides override functionality for ApMisc's StatusStr function}
  260.  
  261. procedure NoUserStatus(AP : AbstractProtocolPtr; First, Last : Boolean);
  262.   {-empty status display proc, forced to be used during GIF services}
  263.  
  264. implementation
  265.  
  266. const
  267.     {byte/int type char consts}
  268.   ETX = 3;
  269.   ENQ = 5;
  270.   DLE = 16;
  271.   NAK = 21;
  272.  
  273.     {default ParamsRecord values}
  274.   DefDR : Byte = 1;   {can handle Download Resume}
  275.   DefBS : Byte = 8;   {default to 128 * DefBS (1024) byte packets}
  276.   DefWS = 1;          {can handle send ahead}
  277.   DefWR = 2;          {can receive up to 2 packets ahead}
  278.   DefCM = 1;          {can handle CRC blockchecking}
  279.   DefDQ = 1;          {can handle special quoting including non-quoted NUL}
  280.   DefUR = 0;          {can NOT handle Upload Recovery (not supported by CIS)}
  281.   DefFI = 1;          {can handle File Info packet}
  282.   DefXP = 0;          {FTP/GIF does not use TransportLayer}
  283.  
  284.  
  285.   function Long2Str(L : LongInt) : String;
  286.   var
  287.     S : String;
  288.   begin
  289.     Str(L,S);
  290.     Long2Str := S;
  291.   end;
  292.  
  293.   function bpStatusStr(Code : Word) : String;
  294.   var
  295.     S : String;
  296.   begin
  297.     case Code mod 10000 of
  298.       ecResync:
  299.         S := 'Resyncing with host';
  300.       ecWaitACK:
  301.         S := 'Received Wait-ACK from host';
  302.       ecDropout:
  303.         S := 'Dropout';
  304.       ecHostCan:
  305.         S := 'Host requested cancel';
  306.       ecFileIO:
  307.         S := 'Disk IO error';
  308.       ecTryResume:
  309.         S := 'Processing Resume: calculating CRC';
  310.       ecHostResume:
  311.         S := 'Host calculating CRC';
  312.       ecResumeOK:
  313.         S := 'Resuming original download';
  314.       ecResumeBad:
  315.         S := 'CRC check failed, rewinding';
  316.       ecOverwrite:
  317.         S := 'Overwriting original file';
  318.       ecUnPacket:
  319.         S := 'Unknown packet type received';
  320.       else
  321.         S := ApMisc.StatusStr(Code);
  322.     end;
  323.     bpStatusStr := S;
  324.   end;
  325.  
  326.   procedure NoUserStatus(AP : AbstractProtocolPtr; First, Last : Boolean);
  327.   begin
  328.     {do-nothing status procedure}
  329.   end;
  330.  
  331.   constructor BPProtocol.Init(AP : AbstractPortPtr);
  332.   begin
  333.     if NOT AbstractProtocol.InitCustom(AP,DefProtocolOptions) then Fail;
  334.     ProtType := UserProt1;
  335.     ProtocolTypeString[ProtType] := 'Classic B';
  336.     CheckType := bcChecksum1;
  337.     SetShowStatusProc(NoUserStatus);
  338.     UseSQuote := False;
  339.     SQuoteSet := DQDefault;
  340.     DefResume := xfrRename;  {rename for safety}
  341.     @GetResume := NIL;
  342.     @ChkAbort := NIL;
  343.     Direction := Unknown;
  344.     case (AP^.Pr^.CurBaud div 10) of
  345.       0..30 :
  346.         DefBS := 1;
  347.       31..120 :
  348.         DefBS := 4;
  349.       else
  350.         DefBS := 8;
  351.     end;
  352.   end;
  353.  
  354.   destructor BPProtocol.Done;
  355.   begin
  356.     AbstractProtocol.Done;
  357.   end;
  358.  
  359.   procedure BPProtocol.bpSetResumeProc(RP : GetResumeProc);
  360.     {-set our function to get type of resume handling needed}
  361.   begin
  362.     GetResume := RP;
  363.   end;
  364.  
  365.   procedure BPProtocol.bpSetChkAbortProc(CAP : ChkAbortProc);
  366.     {-set our function to see if an abort was requested by the user}
  367.   begin
  368.     ChkAbort := CAP;
  369.   end;
  370.  
  371.   procedure BPProtocol.UpdateStatus(W : Word);
  372.     {-simplified UserStatus call}
  373.   begin
  374.     if W = 0 then
  375.       AsyncStatus := 0
  376.     else
  377.       APort^.GotError(W);
  378.     UserStatus(@Self,False,False);
  379.   end;
  380.  
  381.   procedure BPProtocol.UpdateQuoteTable(QS : QuoteArray);
  382.     {-update our QuoteTable to match the QS quotearray}
  383.   var
  384.     I,J,K : Integer;
  385.     B,C : Byte;
  386.   begin
  387.     K := 0;
  388.     C := $40;
  389.  
  390.     for I := 0 to 7 do begin
  391.       if I = 4 then begin
  392.         K := 128;
  393.         C := $60;
  394.       end;
  395.       B := QS[I];
  396.  
  397.       for J := 0 to 7 do begin
  398.         if (B and $80) <> 0 then
  399.           QuoteTable[K] := C;
  400.         B := B shl 1;
  401.         Inc(C);
  402.         Inc(K);
  403.       end;
  404.     end;
  405.   end;
  406.  
  407.   procedure BPProtocol.QuoteThis(Value : Integer);
  408.     {-quote <value> char, or reset quotetable if Value = -1}
  409.   var
  410.     I,J : Integer;
  411.   begin
  412.     if Value in [$00..$1F,$80..$9F] then begin
  413.       if Value > $1F then begin
  414.         I := 4;
  415.         Value := Value and $1F;
  416.       end
  417.       else I := 0;
  418.  
  419.       I := I + Value div 8;
  420.       J := Value mod 8;
  421.       SQuoteSet[i] := SQuoteSet[i] or ($80 shr J);
  422.       UseSQuote := True;
  423.     end
  424.     else if Value = -1 then begin
  425.       UseSQuote := False;
  426.       SQuoteSet := DQDefault;
  427.     end;
  428.   end;
  429.  
  430.   procedure BPProtocol.apResetProtocol;
  431.     {-init important session-dependant protocol vars}
  432.   begin
  433.     SeqNum := 0;
  434.     SAMax := 1;
  435.     SAErrors := 0;
  436.     BuffeRSize := 512;
  437.     AbortCount := 0;
  438.     FatalAbort := False;
  439.     LastXferOK := False;
  440.     BPlus := False;
  441.     ClassicB := True;
  442.     CheckType := bcChecksum1;
  443.     FillChar(QuoteTable,SizeOf(QuoteTable),0);
  444.     FillChar(OurParams,SizeOf(OurParams),0);
  445.     OurParams.BlkSize := 4;
  446.     OurParams.QuoteSet := DQDefault;
  447.     UpdateQuoteTable(DQDefault);
  448.  
  449.     BytesTransferred := 0;
  450.     ElapsedTics := 0;
  451.     SrcFileLen := 0;
  452.     SrcFileDate := 0;
  453.     PathName := '';
  454.   end;
  455.  
  456.   procedure BPProtocol.bpHandleENQ;
  457.     {-called when the terminal handler receives an <ENQ>}
  458.   begin
  459.     Aborting := False;
  460.     apResetProtocol;
  461.     APort^.PutString(#16'++'#16'0');
  462.   end;
  463.  
  464.   procedure BPProtocol.bpHandleESCI;
  465.     {-called by terminal handler when <ESC><'I'> seen at port}
  466.   var
  467.     S : String;
  468.     T : String[5];
  469.     XRes,YRes,P : Integer;
  470.   begin
  471.     S := ESCI_Response;
  472.       {make sure tailer is in place for later}
  473.     if Pos(',+',S) = 0 then
  474.       S := S + ',+';
  475.       {if 'SSxx' part of string, insert our screen size values}
  476.     P := Pos('SSxx',S);
  477.     if P > 0 then begin
  478.       XRes := (Lo(WindMax) - Lo(WindMin));
  479.       YRes := (Hi(WindMax) - Hi(WindMin));
  480.       S[p+2] := Chr(YRes+31);
  481.       S[p+3] := Chr(XRes+31);
  482.     end;
  483.       {build the string's checksum and append it to the string}
  484.     XRes := 0;
  485.     for P := 1 to Length(S) do
  486.       Inc(XRes,Ord(S[p]));
  487.     Str(XRes,T);
  488.     S := S + T;
  489.       {send the response}
  490. (*
  491.     for P := 1 to Length(S) do
  492. {!!}  WriteSes(S[p]);
  493. *)
  494.     APort^.PutString(S+^M);
  495.   end;
  496.  
  497.   procedure BPProtocol.apUpdateBlockCheck(CurByte : Byte);
  498.     {-update the CRC/checksum to reflect the new byte}
  499.  
  500.     function UpdCrc(CurByte : Byte; CurCrc : Word) : Word;
  501.       {-due to an oddity in the CIS handling of CRC's, we use this special
  502.         version of UpdateCrc rather than the one in APMISC.  This function
  503.         requires the CRC lookup table in APMISC.}
  504.     begin
  505.       UpdCrc := CrcTable[((CurCrc shr 8) xor CurByte) and $ff] xor
  506.                 (CurCrc shl 8);
  507.     end;
  508.  
  509.   begin
  510.     if GetCheckType = bcCrc16 then
  511.       Checksum := UpdCRC(CurByte,Checksum)
  512.     else begin           {use classic B's odd checksum method}
  513.       Checksum := Checksum shl 1;
  514.       if Checksum > 255 then
  515.         Checksum := (Checksum and $00FF) + 1;
  516.       Checksum := Checksum + CurByte;
  517.       if Checksum > 255 then
  518.         Checksum := (Checksum and $00FF) + 1;
  519.     end;
  520.   end;
  521.  
  522.   function BPProtocol.CheckAbort : Boolean;
  523.   begin
  524.     if @ChkAbort <> NIL then
  525.       CheckAbort := ChkAbort
  526.     else
  527.       CheckAbort := (KeyPressed) and (ReadKey = #27);
  528.   end;
  529.  
  530.   procedure BPProtocol.SendByte(C : Char);
  531.   begin
  532.     with APort^ do begin
  533.       while NOT TransReady do ;
  534.       PutChar(C);
  535.     end;
  536.     Inc(S_Raw);
  537.     if CounterOn then
  538.       Inc(CPSCount);
  539.  
  540. {$IFDEF ShowRates}
  541.     Inc(S_Counter);
  542.     S_Counter := S_Counter mod (APort^.Pr^.CurBaud div 10);
  543.     if S_Counter = 0 then
  544.       UpdateStatus(0);
  545. {$ENDIF}
  546.   end;
  547.  
  548.   procedure BPProtocol.SendQuotedByte(I : Integer);
  549.   begin
  550.     I := I and $FF;
  551.     if QuoteTable[i] <> 0 then begin
  552.       SendByte(cDLE);
  553.       SendByte(Chr(QuoteTable[i]));
  554.     end
  555.     else SendByte(Chr(i));
  556.   end;
  557.  
  558.   procedure BPProtocol.bpSendACK;
  559.   begin
  560.     SendByte(cDLE);
  561.     SendByte(Chr(SeqNum + Ord('0')));
  562.   end;
  563.  
  564.   procedure BPProtocol.SendNAK;
  565.   begin
  566.     SendByte(cNAK);
  567.   end;
  568.  
  569.   procedure BPProtocol.SendENQ;
  570.   begin
  571.     SendByte(cENQ);
  572.   end;
  573.  
  574.   function BPProtocol.ReadByte : Boolean;
  575.   var
  576.     ET : EventTimer;
  577.     C : Char;
  578.   begin
  579.     ReadByte := False;
  580.       {set timeout based on the Aborting state}
  581.     if Aborting then
  582.       NewTimer(ET,Secs2Tics(10))
  583.     else
  584.       NewTimer(ET,Secs2Tics(30));
  585.  
  586.       {wait for char, checking for OverrideAbort request}
  587.     while NOT APort^.CharReady do begin
  588.       if TimerExpired(ET) then
  589.         exit;
  590.       if (Aborting) and (CheckAbort) then begin
  591.         inc(AbortCount);
  592.         if AbortCount >= BP_Abort_Max then begin
  593.           FatalAbort := True;
  594.           exit;
  595.         end;
  596.       end;
  597.     end;
  598.  
  599.     APort^.GetChar(C);
  600.     ReadByte := (AsyncStatus = ecOK);
  601.     Ch := Ord(C);
  602.     inc(R_Raw);
  603.     if CounterOn then
  604.       Inc(CPSCount);
  605.  
  606. {$IFDEF ShowRates}
  607.     Inc(R_Counter);
  608.     R_Counter := R_Counter mod (APort^.Pr^.CurBaud div 10);
  609.     if R_Counter = 0 then
  610.       UpdateStatus(0);
  611. {$ENDIF}
  612.   end;
  613.  
  614.   function BPProtocol.ReadQuotedByte : Boolean;
  615.     {receive a byte, unquoting if needed}
  616.   begin
  617.     ReadQuotedByte := False;
  618.     Quoted := False;
  619.  
  620.     if NOT ReadByte then exit;
  621.     if Char(Ch) = cDLE then begin
  622.       if NOT ReadByte then exit;
  623.       if Ch < $60 then
  624.         Ch := Ch and $1F
  625.       else
  626.         Ch := (Ch and $1F) or $80;
  627.       Quoted := True;
  628.     end;
  629.     ReadQuotedByte := True;
  630.   end;
  631.  
  632.   function BPProtocol.IncSequence(Value : Integer) : Integer;
  633.     {-increment a Sequence Number var}
  634.   begin
  635.     IncSequence := (Succ(Value) mod 10);
  636.   end;
  637.  
  638.   function BPProtocol.ReadPacket(LeadInSeen, FromSend : Boolean) : Boolean;
  639.   const
  640.     R_Get_DLE     = 0;
  641.     R_Get_B       = 1;
  642.     R_Get_Seq     = 2;
  643.     R_Get_Data    = 3;
  644.     R_Get_Check   = 4;
  645.     R_Send_ACK    = 5;
  646.     R_Timed_Out   = 6;
  647.     R_Error       = 7;
  648.     R_Success     = 8;
  649.   var
  650.     State : Byte;
  651.     NextSeq, Idx, PacketNum : Integer;
  652.     NewChk : Word;
  653.     OldChk : Word absolute BlockCheck;
  654.     NAKSent : Boolean;
  655.   begin
  656.     ReadPacket := True;        {assume success for now}
  657.     if PacketRecd then begin
  658.       PacketRecd := False;
  659.       exit;
  660.     end;
  661.  
  662.       {set initial values}
  663.     NAKsent := False;
  664.     NextSeq := IncSequence(SeqNum);
  665.     BlockErrors := 0;
  666.     if LeadInSeen then
  667.       State := R_Get_Seq
  668.     else
  669.       State := R_Get_DLE;
  670.  
  671.     while True do
  672.       case State of
  673.         R_Get_DLE :
  674.           begin
  675.             if NOT(Aborting) and (CheckAbort) then begin
  676.               UpdateStatus(epNonFatal + ecCancelRequested);
  677.               SendFailure('AAborted by user');
  678.               Aborting := True;
  679.               ReadPacket := False;
  680.               exit;
  681.             end;
  682.             if not ReadByte then
  683.               State := R_Timed_Out
  684.             else if Ch = DLE then    {saw DLE}
  685.               State := R_Get_B
  686.             else if Ch = ENQ then    {respond to ENQ}
  687.               State := R_Send_ACK;
  688.           end;
  689.  
  690.         R_Get_B :
  691.           begin
  692.             if not ReadByte then
  693.               State := R_Timed_Out
  694.             else if Ch = Ord('B') then         {saw B}
  695.               State := R_Get_Seq
  696.             else if Ch = Ord(';') then begin   {saw "wait-acknowledge"}
  697.               UpdateStatus(epNonFatal + ecWaitACK);
  698.               State := R_Get_DLE;
  699.             end
  700.             else if State = ENQ then           {respond to ENQ}
  701.               State := R_Send_ACK
  702.             else
  703.               State := R_Get_DLE;
  704.           end;
  705.  
  706.         R_Get_Seq :
  707.           begin
  708.             if ResumeFlag then begin  {if resuming, reset vars for accuracy}
  709.               NewTimer(Timer,Secs2Tics(SecsPerDay));
  710.               R_Raw := 2;
  711.             end;
  712.             if not ReadByte then
  713.               State := R_Timed_Out
  714.             else if Ch = ENQ then
  715.               State := R_Send_ACK
  716.             else begin
  717.               if (GetCheckType = bcCrc16) then
  718.                 Checksum := $FFFF
  719.               else
  720.                 Checksum := 0;
  721.               apUpdateBlockCheck(Byte(Ch));
  722.               PacketNum := Ch - ord('0');
  723.               Idx := 0;
  724.               State := R_Get_Data;
  725.             end;
  726.           end;
  727.  
  728.         R_Get_Data :
  729.           begin
  730.             if not ReadQuotedByte then
  731.               State := R_Timed_Out
  732.             else begin
  733.               apUpdateBlockCheck(Byte(Ch));
  734.               if (Ch = ETX) and NOT(Quoted) then
  735.                 State := R_Get_Check
  736.               else begin
  737.                 RBuffer[Idx] := Byte(Ch);
  738.                 Inc(Idx);
  739.               end;
  740.             end;
  741.           end;
  742.  
  743.         R_Get_Check :
  744.           begin
  745.             if not ReadQuotedByte then
  746.               State := R_Timed_Out
  747.             else begin
  748.               if (GetCheckType = bcCrc16) then begin
  749.                 apUpdateBlockCheck(Byte(Ch));
  750.                 if not ReadQuotedByte then
  751.                   NewChk := Checksum xor $FF
  752.                 else begin
  753.                   NewChk := 0;
  754.                   apUpdateBlockCheck(Byte(Ch));
  755.                 end;
  756.               end
  757.               else NewChk := Ch;
  758.  
  759.               if NewChk <> Checksum then begin   {checksum/CRC error}
  760.                 UpdateStatus(epNonFatal + ecBlockCheckError);
  761.                 State := R_Error;
  762.               end
  763.               else if RBuffer[0] = Ord('F') then   {*always* accept a}
  764.                 State := R_Success                   {failure packet!}
  765.               else if PacketNum = SeqNum then begin      {dupe packet}
  766.                 UpdateStatus(epNonFatal + ecDuplicateBlock);
  767.                 State := R_Send_ACK;
  768.               end
  769.               else if PacketNum <> NextSeq then begin {out-of-sequence packet}
  770.                 UpdateStatus(epNonFatal + ecSequenceError);
  771.                 State := R_Get_DLE;
  772.               end
  773.               else
  774.                 State := R_Success;
  775.             end;
  776.           end;
  777.  
  778.         R_Timed_Out :
  779.           begin
  780.             UpdateStatus(epNonFatal + ecTimeout);
  781.             State := R_Error;
  782.           end;
  783.  
  784.         R_Error :
  785.           begin
  786.             Inc(TotalErrors);
  787.             Inc(BlockErrors);
  788.             if (BlockErrors > BP_Error_Max) or (FromSend) or (FatalAbort) then begin
  789.               ReadPacket := False;
  790.               exit;
  791.             end;
  792.             if NOT(NAKSent) or NOT(BPlus) then begin
  793.               NAKSent := True;
  794.               SendNAK;
  795.             end;
  796.             State := R_Get_DLE;
  797.           end;
  798.  
  799.         R_Send_ACK :
  800.           begin
  801.             if NOT Aborting then
  802.               bpSendACK;
  803.             State := R_Get_DLE;
  804.           end;
  805.  
  806.         R_Success :
  807.           begin
  808.             if NOT Aborting then
  809.               SeqNum := PacketNum;
  810.             ResumeFlag := False;
  811.             RSize := Idx;
  812.             Inc(R_Packets);
  813.             Exit;
  814.           end;
  815.       end;
  816.   end;
  817.  
  818.   procedure BPProtocol.SendData(BNum : Integer);
  819.   var
  820.     I : Integer;
  821.   begin
  822.     with SBuffer[BNum] do begin
  823.       if (BPlus) and (GetCheckType = bcCrc16) then
  824.         Checksum := $FFFF
  825.       else
  826.         Checksum := 0;
  827.  
  828.       SendByte(cDLE);
  829.       SendByte('B');
  830.  
  831.       SendByte(Chr(Seq+Ord('0')));
  832.       apUpdateBlockCheck(Byte(Seq+Ord('0')));
  833.  
  834.       for i := 0 to Num do begin
  835.         SendQuotedByte(Buf[i]);
  836.         apUpdateBlockCheck(Buf[i]);
  837.       end;
  838.  
  839.       SendByte(cETX);
  840.       apUpdateBlockCheck(ETX);
  841.  
  842.       if (BPlus) and (GetCheckType = bcCrc16) then
  843.         SendQuotedByte(Hi(Checksum));
  844.       SendQuotedByte(Lo(Checksum));
  845.     end;
  846.   end;
  847.  
  848.   function BPProtocol.IncSA(Value : Integer) : Integer;
  849.   begin
  850.     if Value = SAMax then
  851.       IncSA := 0
  852.     else
  853.       IncSA := Value + 1;
  854.   end;
  855.  
  856.   function BPProtocol.ReSync : Integer;
  857.   const
  858.     GetDLE1    = 1;
  859.     GetDigit1  = 2;
  860.     GetDLE2    = 3;
  861.     GetDigit2  = 4;
  862.   var
  863.     State  : Integer;
  864.     Digit1 : Integer;
  865.   begin
  866.     UpdateStatus(epNonFatal + ecResync);
  867.     ReSync := -1;
  868.     SendByte(cENQ);  {send <ENQ><ENQ>}
  869.     SendByte(cENQ);
  870.     State := GetDLE1;
  871.  
  872.     while True do
  873.       case State of
  874.         GetDLE1 :
  875.           begin
  876.             if not ReadByte then
  877.               exit;
  878.             if Ch = DLE then
  879.               State := GetDigit1;
  880.           end;
  881.  
  882.         GetDigit1 :
  883.           begin
  884.             if not ReadByte then
  885.               exit;
  886.             if Ch = Ord('B') then begin
  887.               ReSync := Ch;
  888.               exit;
  889.             end
  890.             else if (Ch >= Ord('0')) and (Ch <= Ord('9')) then begin
  891.               Digit1 := Ch;
  892.               State := GetDLE2;
  893.             end;
  894.           end;
  895.  
  896.         GetDLE2 :
  897.           begin
  898.             if not ReadByte then
  899.               exit;
  900.             if Ch = DLE then
  901.               State := GetDigit2;
  902.           end;
  903.  
  904.         GetDigit2 :
  905.           begin
  906.             if not ReadByte then
  907.               exit;
  908.             if (Ch >= Ord('0')) and (Ch <= Ord('9')) then begin
  909.               if Digit1 = Ch then begin
  910.                 ReSync := Ch;
  911.                 exit;
  912.               end
  913.               else if Ch = Ord('B') then begin
  914.                 ReSync := Ord('B');
  915.                 exit;
  916.               end
  917.               else begin
  918.                 Digit1 := Ch;
  919.                 State := GetDLE2;
  920.               end;
  921.             end
  922.             else State := GetDLE2;
  923.           end;
  924.       end;
  925.   end;
  926.  
  927.   function BPProtocol.GetACK : Boolean;
  928.   const
  929.     S_Get_DLE     = 0;
  930.     S_Get_Num     = 1;
  931.     S_Have_ACK    = 2;
  932.     S_Get_Packet  = 3;
  933.     S_Skip_Packet = 4;
  934.     S_Timed_Out   = 5;
  935.     S_Error       = 6;
  936.     S_Send_NAK    = 7;
  937.     S_Send_ENQ    = 8;
  938.     S_Send_Data   = 9;
  939.   var
  940.     State : Byte;
  941.     PacketNum, Idx : Integer;
  942.     SAIdx : Integer;
  943.     SentENQ : Boolean;
  944.   begin
  945.     GetACK := True;
  946.     PacketRecd := False;
  947.     SentENQ := False;
  948.     BlockErrors := 0;
  949.     State := S_Get_DLE;
  950.  
  951.     while True do
  952.       case State of
  953.         S_Get_DLE :
  954.           begin
  955.             if NOT(Aborting) and (CheckAbort) then begin    {user wants out}
  956.               UpdateStatus(epNonFatal + ecCancelRequested);
  957.               SendFailure('AAborted by user');
  958.               GetACK := False;
  959.               exit;
  960.             end;
  961.             if not ReadByte then
  962.               State := S_Timed_Out
  963.             else begin
  964.               case Ch of
  965.                 DLE : State := S_Get_Num;              {potential ACK}
  966.                 NAK : State := S_Send_ENQ;             {packet error}
  967.                 ETX : State := S_Send_NAK;             {sequence problem}
  968.               end;
  969.             end;
  970.           end;
  971.  
  972.         S_Get_Num :
  973.           begin
  974.             if not ReadByte then
  975.               State := S_Timed_Out
  976.             else begin
  977.               if (Ch >= Ord('0')) and (Ch <= Ord('9')) then
  978.                 State := S_Have_ACK                   {we have an ACK, check it}
  979.               else if Ch = Ord('B') then begin        {incomming data packet,}
  980.                 if Aborting then                      {handle as needed}
  981.                   State := S_Skip_Packet
  982.                 else
  983.                   State := S_Get_Packet;
  984.               end
  985.               else if Ch = NAK then                   {sequence problem}
  986.                 State := S_Send_ENQ
  987.               else if Ch = Ord(';') then begin
  988.                 UpdateStatus(epNonFatal + ecWaitACK); {show the user}
  989.                 State := S_Get_DLE;
  990.               end
  991.               else
  992.                 State := S_Get_DLE;
  993.             end;
  994.           end;
  995.  
  996.         S_Get_Packet :
  997.           begin
  998.             if ReadPacket(True, True) then begin   {read the packet}
  999.               PacketRecd := True;
  1000.               if RBuffer[0] = Ord('F') then begin  {ACK any failure packet}
  1001.                 bpSendACK;                           {and drop out}
  1002.                 GetACK := False;
  1003.                 exit;
  1004.               end;
  1005.               Next2ACK := IncSA(Next2ACK);  {keep our SendAhead straight}
  1006.               Dec(SAWaiting);
  1007.               GetACK := True;
  1008.               exit;
  1009.             end
  1010.             else State := S_Get_DLE;  {read failed, keep looking for ACK}
  1011.           end;
  1012.  
  1013.         S_Skip_Packet:
  1014.           begin
  1015.             if not ReadByte then             {read bytes til an ETX arrives}
  1016.               State := S_Timed_Out
  1017.             else if Ch = ETX then begin
  1018.               if not ReadQuotedByte then     {read & skip checksum}
  1019.                 State := S_Timed_Out
  1020.               else if GetCheckType <> bcCrc16 then
  1021.                 State := S_Get_DLE
  1022.               else if not ReadQuotedByte then  {read & skip 2nd byte of CRC}
  1023.                 State := S_Timed_Out
  1024.               else
  1025.                 State := S_Get_DLE;
  1026.             end;
  1027.           end;
  1028.  
  1029.         S_Have_ACK :
  1030.           begin
  1031.             PacketNum := Ch - Ord('0');
  1032.             if SBuffer[Next2ACK].Seq = PacketNum then begin  {the one!}
  1033.               Next2ACK := IncSA(Next2ACK);
  1034.               Dec(SAWaiting);
  1035.               if SAErrors > 0 then
  1036.                 Dec(SAErrors);
  1037.               GetACK := True;
  1038.               exit;
  1039.             end
  1040.             else if (SBuffer[IncSA(Next2ACK)].Seq = PacketNum) and
  1041.                     (SAWaiting = 2) then begin     {must have missed an ACK}
  1042.               UpdateStatus(epNonFatal + ecSequenceError);
  1043.               Dec(SAWaiting,2);
  1044.               Next2ACK := IncSA(Next2ACK);  {inc twice to skip the miss}
  1045.               Next2ACK := IncSA(Next2ACK);
  1046.               if SAErrors > 0 then
  1047.                 Dec(SAErrors);
  1048.               GetACK := True;
  1049.               exit;
  1050.             end
  1051.             else if SBuffer[Next2ACK].Seq = IncSequence(PacketNum) then begin
  1052.               if SentENQ then
  1053.                 State := S_Send_Data   {remote missed first packet}
  1054.               else
  1055.                 State := S_Get_DLE;    {duplicate ACK}
  1056.             end
  1057.             else begin
  1058.               if Aborting then
  1059.                 State := S_Get_DLE
  1060.               else
  1061.                 State := S_Timed_Out;
  1062.             end;
  1063.             SentENQ := False;
  1064.           end;
  1065.  
  1066.         S_Timed_Out :
  1067.           begin
  1068.             UpdateStatus(epNonFatal + ecTimeout);
  1069.             State := S_Send_ENQ;
  1070.           end;
  1071.  
  1072.         S_Send_NAK :
  1073.           begin
  1074.             Inc(BlockErrors);
  1075.             Inc(TotalErrors);
  1076.             if (BlockErrors > BP_Error_Max) or (FatalAbort) then begin
  1077.               GetACK := False;
  1078.               exit;
  1079.             end;
  1080.             SendNAK;
  1081.             State := S_Get_DLE;
  1082.           end;
  1083.  
  1084.         S_Send_ENQ :
  1085.           begin
  1086.             Inc(BlockErrors);
  1087.             Inc(TotalErrors);
  1088.             if (BlockErrors > BP_Error_Max) or (FatalAbort) then begin
  1089.               GetACK := False;
  1090.               exit;
  1091.             end;
  1092.             Ch := ReSync;         {try to resync with host}
  1093.             if Ch = -1 then
  1094.               State := S_Get_DLE
  1095.             else if Ch = Ord('B') then begin
  1096.               if Aborting then
  1097.                 State := S_Skip_Packet
  1098.               else
  1099.                 State := S_Get_Packet;
  1100.             end
  1101.             else
  1102.               State := S_Have_ACK;
  1103.             SentENQ := True;
  1104.           end;
  1105.  
  1106.         S_Send_Data :
  1107.           begin
  1108.             inc(SAErrors,3);
  1109.             if SAErrors >= 12 then  {if too many SA errors, cease SendAhead}
  1110.               SAMax := 1;
  1111.             SAIdx := Next2ACK;      {flush all pending packets to send}
  1112.             for Idx := 1 to SAWaiting do begin
  1113.               SendData(SAIdx);
  1114.               SAIdx := IncSA(SAIdx);
  1115.             end;
  1116.             SentENQ := False;
  1117.             State := S_Get_DLE;
  1118.           end;
  1119.       end;
  1120.   end;
  1121.  
  1122.   function BPProtocol.SAFlush : Boolean;
  1123.     {-get ACKs on outstanding packets after last packet sent}
  1124.   begin
  1125.     SAFlush := False;
  1126.     while SAWaiting > 0 do
  1127.       if not GetACK then
  1128.         exit;
  1129.     SAFlush := True;
  1130.   end;
  1131.  
  1132.   function BPProtocol.SendPacket(Size : Integer) : Boolean;
  1133.     {-send a packet of data}
  1134.   begin
  1135.     SendPacket := False;
  1136.     while SAWaiting >= SAMax do   {allow for SendAhead dropout}
  1137.       if not GetACK then
  1138.         exit;
  1139.  
  1140.     SeqNum := IncSequence(SeqNum);
  1141.     SBuffer[Next2Fill].Seq := SeqNum;
  1142.     SBuffer[Next2Fill].Num := Size;
  1143.     SendData(Next2Fill);
  1144.     Next2Fill := IncSA(Next2Fill);
  1145.     Inc(SAWaiting);
  1146.     Inc(S_Packets);
  1147.     SendPacket := True;
  1148.   end;
  1149.  
  1150.   procedure BPProtocol.SendFailure(Reason : String);
  1151.     {-send a failure packet}
  1152.   begin
  1153.     Next2ACK := 0;
  1154.     Next2Fill := 0;
  1155.     SAWaiting := 0;
  1156.     Aborting := True;
  1157.  
  1158.     with SBuffer[0] do begin
  1159.       Buf[0] := Ord('F');
  1160.       Move(Reason[1],Buf[1],Length(Reason));
  1161.     end;
  1162.     if SendPacket(Length(Reason)) then
  1163.       if SAFlush then ;
  1164.   end;
  1165.  
  1166.   function BPProtocol.SendTransport : Boolean;
  1167.     {-send our transport settings}
  1168.   begin
  1169.     ClassicB := False;     {if we're here, it's at least QuickB}
  1170.     ProtocolTypeString[ProtType] := 'Quick B';
  1171.  
  1172.     with SBuffer[Next2Fill] do begin
  1173.       Buf[0] := Ord('+');
  1174.       Buf[1] := DefWS;
  1175.       Buf[2] := DefWR;
  1176.       Buf[3] := DefBS;
  1177.       Buf[4] := DefCM;
  1178.       Buf[5] := DefDQ;
  1179.       Buf[6] := DefXP;
  1180.       Move(OurParams.QuoteSet,Buf[7],8);
  1181.       Buf[15] := DefDR;
  1182.       Buf[16] := DefUR;
  1183.       Buf[17] := DefFI;
  1184.     end;
  1185.     SendTransport := (SendPacket(17)) and (SAFlush);
  1186.   end;
  1187.  
  1188.   procedure BPProtocol.ProcessTransportParams(SendXPortInfo : Boolean);
  1189.     {-process received "+" packet, send our params if not a host}
  1190.   var
  1191.     QSP : Boolean;
  1192.   begin
  1193.     if UseSQuote then
  1194.       OurParams.QuoteSet := SQuoteSet
  1195.     else
  1196.       OurParams.QuoteSet := DQDefault;
  1197.     FillChar(RBuffer[RSize+1],SizeOf(RBuffer)-RSize,0);
  1198.     Move(RBuffer[1],HisParams.WinSend,4);
  1199.     Move(RBuffer[7],HisParams.QuoteSet,11);
  1200.  
  1201.     QSP := (RSize >= 14);
  1202.     UpdateQuoteTable(DQFull);        {send '+' packet under FULL quoting}
  1203.  
  1204.     if SendXPortInfo then            {don't send + packet if we're a host}
  1205.       if NOT SendTransport then exit;
  1206.  
  1207.       {make a minimal set of parameters to work from}
  1208.     if HisParams.WinSend < DefWR
  1209.       then OurParams.WinSend := HisParams.WinSend
  1210.       else OurParams.WinSend := DefWR;
  1211.     if OurParams.WinSend <> 0 then      {if > 0, we can use all windows}
  1212.       SAMax := BP_SendAhead_Max;
  1213.  
  1214.     if HisParams.WinRecv < DefWS
  1215.       then OurParams.WinRecv := HisParams.WinRecv
  1216.       else OurParams.WinRecv := DefWS;
  1217.  
  1218.     if HisParams.BlkSize < DefBS
  1219.       then OurParams.BlkSize := HisParams.BlkSize
  1220.       else OurParams.BlkSize := DefBS;
  1221.     if OurParams.BlkSize = 0 then
  1222.       OurParams.BlkSize := 4;           {default is 512-byte packets}
  1223.     BuffeRSize := (OurParams.BlkSize * 128);
  1224.  
  1225.     if HisParams.ChkType < DefCM
  1226.       then OurParams.ChkType := HisParams.ChkType
  1227.       else OurParams.ChkType := DefCM;
  1228.     if OurParams.ChkType > 0 then       {if = 1, we need CRC blockchecking}
  1229.       CheckType := bcCrc16;
  1230.  
  1231.     if HisParams.DROpt < DefDR
  1232.       then OurParams.DROpt := HisParams.DROpt
  1233.       else OurParams.DROpt := DefDR;
  1234.  
  1235.     if HisParams.UROpt < DefUR
  1236.       then OurParams.UROpt := HisParams.UROpt
  1237.       else OurParams.UROpt := DefUR;
  1238.  
  1239.     if HisParams.FIOpt < DefFI
  1240.       then OurParams.FIOpt := HisParams.FIOpt
  1241.       else OurParams.FIOpt := DefFI;
  1242.  
  1243.     FillChar(QuoteTable,SizeOf(QuoteTable),0);  {clear the Quote Table}
  1244.     UpdateQuoteTable(OurParams.QuoteSet);       {set our quoting}
  1245.     if QSP then                                 {if host sent a set,}
  1246.       UpdateQuoteTable(HisParams.QuoteSet);     {add his as well}
  1247.     BPlus := True;                              {now using full B+}
  1248.     ProtocolTypeString[ProtType] := 'B Plus';
  1249.   end;
  1250.  
  1251.   procedure BPProtocol.bpInitVars;
  1252.     {-init vars that need resetting each time a DLE is seen}
  1253.   begin
  1254.     FillChar(SBuffer,SizeOf(SBuffer),0);
  1255.     Next2ACK  := 0;
  1256.     Next2Fill := 0;
  1257.     SAWaiting := 0;
  1258.     SAMax := 1;
  1259.     AbortCount := 0;
  1260.     R_Packets := 0;
  1261.     R_Raw := 0;
  1262.     S_Packets := 0;
  1263.     S_Raw := 0;
  1264. {$IFDEF ShowRates}
  1265.     R_Counter := 0;
  1266.     S_Counter := 0;
  1267. {$ENDIF}
  1268.     TotalErrors := 0;
  1269.     ShowStatus := True;
  1270.     FatalAbort := False;
  1271.     PacketRecd := False;
  1272.     ResumeFlag := False;
  1273.     Direction := Unknown;
  1274.   end;
  1275.  
  1276.   function BPProtocol.bpDLESeen : Boolean;
  1277.     {-called by terminal handler when <DLE> seen.  *MUST* be overridden!}
  1278.   begin
  1279.     RunError(211);
  1280.   end;
  1281.  
  1282. {==== BPProtoFTP Methods ===================================================}
  1283.  
  1284.   constructor BPProtoFTP.Init(AP : AbstractPortPtr;
  1285.                               DefaultResume : ResumeResultType);
  1286.   begin
  1287.     if NOT BPProtocol.Init(AP) then Fail;
  1288.     DefResume := DefaultResume;
  1289.   end;
  1290.  
  1291.   destructor BPProtoFTP.Done;
  1292.   begin
  1293.     BPProtocol.Done;
  1294.   end;
  1295.  
  1296.   procedure BPProtoFTP.apPrepareReading;
  1297.     {-open file to be sent to host}
  1298.   var
  1299.     Result : Integer;
  1300.   begin
  1301.       {preset display vars}
  1302.     SrcFileLen := 0;
  1303.     BytesRemaining := 0;
  1304.     BytesTransferred := 0;
  1305.  
  1306.       {open the file}
  1307.     Assign(WorkFile,PathName);
  1308.     Reset(WorkFile,1);
  1309.     Result := IOResult;
  1310.     if Result <> 0 then
  1311.       UpdateStatus(epNonFatal+Result);
  1312.  
  1313.       {set our open flag}
  1314.     FileOpen := (Result = 0);
  1315.  
  1316.       {reset display vars}
  1317.     if FileOpen then begin
  1318.       SrcFileLen := FileSize(WorkFile);
  1319.       BytesRemaining := SrcFileLen;
  1320.       BytesTransferred := 0;
  1321.         {reset timer for greater accuracy}
  1322.       NewTimer(Timer,TicsPerDay);
  1323.         {reset packet counts to reflect only data}
  1324.       S_Packets := 0;
  1325.       R_Packets := 0;
  1326.     end;
  1327.   end;
  1328.  
  1329.   procedure BPProtoFTP.apFinishReading;
  1330.     {-close file sent to host}
  1331.   begin
  1332.       {close workfile}
  1333.     if FileOpen then
  1334.       Close(WorkFile);
  1335.     if IOResult = 0 then ;
  1336.     FileOpen := False;
  1337.   end;
  1338.  
  1339.   procedure BPProtoFTP.SendFile;
  1340.     {-upload a file to the host}
  1341.   var
  1342.     N : Integer;
  1343.     Result : Integer;
  1344.     BS : Integer;
  1345.   begin
  1346.     LastXferOK := False;
  1347.     Direction := Upload;
  1348.     BS := OurParams.BlkSize * 128;
  1349.  
  1350.       {open the file if we can}
  1351.     apPrepareReading;
  1352.     if not FileOpen then begin
  1353.       SendFailure('MFile not found');
  1354.       exit;
  1355.     end;
  1356.  
  1357.       {display current status}
  1358.     UserStatus(@Self,False,False);
  1359.  
  1360.       {loop sending packets til error or complete}
  1361.     repeat
  1362.       with SBuffer[Next2Fill] do begin
  1363.         Buf[0] := Ord('N');                    {"Next Packet" type packet}
  1364.         BlockRead(WorkFile,Buf[1],BS,N);
  1365.         Result := IOResult;
  1366.         if Result <> 0 then N := -1;
  1367.       end;
  1368.       if N > 0 then begin
  1369.         if NOT SendPacket(N) then begin
  1370.           AsyncStatus := epNonFatal + ecHostCan;
  1371.           UserStatus(@Self,False,False);
  1372.           apFinishReading;
  1373.           exit;
  1374.         end;
  1375.           {update display vars}
  1376.         Dec(BytesRemaining,N);
  1377.         Inc(BytesTransferred,N);
  1378.         UserStatus(@Self,False,False);
  1379.       end;
  1380.     until N <= 0;
  1381.       {close the file}
  1382.     apFinishReading;
  1383.  
  1384.       {if we had an error, display it and go home}
  1385.     if N < 0 then begin
  1386.       UpdateStatus(epNonFatal+Result);
  1387.       SendFailure('EFile read failure');
  1388.       exit;
  1389.     end;
  1390.  
  1391.       {send "Transfer Complete" packet}
  1392.     with SBuffer[Next2Fill] do begin
  1393.       Buf[0] := Ord('T');
  1394.       Buf[1] := Ord('C');
  1395.       if (SendPacket(2)) and (SAFlush) then
  1396.         LastXferOK := True;
  1397.     end;
  1398.     AsyncStatus := ecOK;
  1399.   end;
  1400.  
  1401.   procedure BPProtoFTP.apFinishWriting;
  1402.     {-close file recd from host}
  1403.   begin
  1404.     if FileOpen then
  1405.       Close(WorkFile);
  1406.     if IOResult = 0 then ;
  1407.     FileOpen := False;
  1408.   end;
  1409.  
  1410.   procedure BPProtoFTP.apPrepareWriting;
  1411.     {-opens a file to receive, handles resume/overwrite request}
  1412.   label
  1413.     ExitPoint;
  1414.   var
  1415.     Dir : DirStr;
  1416.     Name : NameStr;
  1417.     Ext : ExtStr;
  1418.     Result : Word;
  1419.     Res : ResumeResultType;
  1420.     OvrW : Boolean;
  1421.     ET : EventTimer;
  1422.     I : Integer;
  1423.     S,T : PathStr;
  1424.     F : LongInt;
  1425.   begin
  1426.     {Does the file exist already?}
  1427.     ResumeFlag := False;
  1428.     ResumeOK := False;
  1429.     FileOpen := False;
  1430.     OvrW := False;
  1431.     Assign(WorkFile, PathName);
  1432.     Reset(WorkFile, 1);
  1433.     Result := IOResult;
  1434.  
  1435.     {Exit on errors other than FileNotFound}
  1436.     if (Result <> 0) and (Result <> 2) then begin
  1437.       APort^.GotError(epFatal+Result);
  1438.       goto ExitPoint;
  1439.     end;
  1440.  
  1441.     {if file exists process potential resume}
  1442.     if (Result = 0) then begin
  1443.       if (@GetResume <> NIL) then
  1444.         Res := GetResume(@Self)
  1445.       else
  1446.         Res := DefResume;
  1447.       case Res of
  1448.         xfrAbort:
  1449.           begin
  1450.             APort^.GotError(epNonFatal+ecFileAlreadyExists);
  1451.             goto ExitPoint;
  1452.           end;
  1453.         xfrResume:
  1454.           ResumeFlag := True;
  1455.         xfrRename:
  1456.           APort^.GotError(epNonFatal + ecFileRenamed);
  1457.         xfrOverwrite:
  1458.           begin
  1459.             APort^.GotError(epNonFatal + ecOverwrite);
  1460.             OvrW := True;
  1461.           end;
  1462.       end;
  1463.     end;
  1464.  
  1465.     if ResumeFlag then begin
  1466.         {calculate CRC on existing file's contents}
  1467.       UpdateStatus(epNonFatal + ecTryResume);
  1468.       NewTimer(ET,Secs2Tics(SecsPerDay));
  1469.       F := FileSize(WorkFile);
  1470.       with SBuffer[Next2Fill] do begin
  1471.         Seek(WorkFile,0);
  1472.         Checksum := $FFFF;
  1473.         repeat
  1474.           BlockRead(WorkFile,Buf[0],512,Result);
  1475.           for I := 0 to (Result - 1) do
  1476.             apUpdateBlockCheck(Buf[i]);
  1477.           if ElapsedTimeInSecs(ET) >= 10 then begin  {Send WACK so host knows}
  1478.             NewTimer(ET,Secs2Tics(SecsPerDay));      {we're busy}
  1479.             SendByte(cDLE);
  1480.             SendByte(';');
  1481.             UpdateStatus(epNonFatal + ecTryResume);  {notify user}
  1482.           end;
  1483.         until (Result = 0) or (IOResult <> 0);
  1484.  
  1485.           {send the host a "Tr" packet with our info}
  1486.         FillChar(Buf,SizeOf(Buf),0);
  1487.         Buf[0] := Ord('T');
  1488.         Buf[1] := Ord('r');
  1489.           {send filesize and CRC}
  1490.         S := Long2Str(F) + ' ' + Long2Str(Checksum) + ' ';
  1491.         Move(S[1],Buf[2],Length(S));
  1492.  
  1493.         if NOT(SendPacket(Length(S)+1)) then
  1494.           goto ExitPoint;
  1495.         if NOT(SAFlush) then
  1496.           goto ExitPoint;     {fatal error!}
  1497.  
  1498.         UpdateStatus(epNonFatal + ecHostResume);   {notify user}
  1499.         BytesTransferred := F;                {make calculations correct}
  1500.         Seek(WorkFile,F);                     {position ourselves}
  1501.         AsyncStatus := IOResult;
  1502.         if AsyncStatus <> 0 then begin        {whoops!}
  1503.           Inc(AsyncStatus,epNonFatal);
  1504.           goto ExitPoint;
  1505.         end;
  1506.         ResumeOK := True;
  1507.         FileOpen := True;
  1508.         exit;
  1509.       end;
  1510.     end
  1511.  
  1512.     else begin
  1513.       Close(WorkFile);
  1514.       if IOResult = 0 then ;
  1515.  
  1516.       {Change the file name if needed}
  1517.       if (Result = 0) and NOT(ResumeFlag) and NOT(OvrW) then begin
  1518.         FSplit(Pathname, Dir, Name, Ext);
  1519.         Name[1] := '$';
  1520.         Pathname := Dir + Name + Ext;
  1521.         APort^.GotError(epNonFatal+ecFileRenamed);
  1522.       end;
  1523.  
  1524.       {Give status a chance to show that the file was renamed}
  1525.       UserStatus(@Self, False, False);
  1526.       AsyncStatus := ecOk;
  1527.  
  1528.       {Ok to rewrite file now}
  1529.       Assign(WorkFile, Pathname);
  1530.       Rewrite(WorkFile, 1);
  1531.       Result := IOResult;
  1532.       if Result <> 0 then begin
  1533.         APort^.GotError(epFatal+Result);
  1534.         goto ExitPoint;
  1535.       end;
  1536.       FileOpen := True;
  1537.       bpSendACK;     {acknowledge the T packet}
  1538.       exit;
  1539.     end;
  1540.  
  1541. ExitPoint:
  1542.     Close(WorkFile);
  1543.     if IOResult <> 0 then ;
  1544.   end;
  1545.  
  1546.   procedure BPProtoFTP.RecvFile;
  1547.     {-receive a file downloaded from the host}
  1548.   var
  1549.     Dir : DirStr;
  1550.     Name : NameStr;
  1551.     Ext : ExtStr;
  1552.     I : Integer;
  1553.     S : String[40];
  1554.   begin
  1555.     Direction := Download;
  1556.     LastXferOK := False;
  1557.     BytesRemaining := 0;
  1558.     BytesTransferred := 0;
  1559.     SrcFileLen := 0;
  1560.     apPrepareWriting;
  1561.     if (ResumeFlag) and NOT(ResumeOK) then   {we failed}
  1562.       exit;
  1563.     if AsyncStatus <> ecOK then begin        {notify host}
  1564.       SendFailure('CCannot create file');
  1565.       exit;
  1566.     end;
  1567.     NewTimer(Timer,Secs2Tics(SecsPerDay));
  1568.  
  1569.     while True do begin
  1570.       if ReadPacket(False,False) then begin
  1571.         ElapsedTics := ElapsedTime(Timer);
  1572.         case Chr(RBuffer[0]) of
  1573.           'F':    {"Failure" packet means we outta here}
  1574.             begin
  1575.               UpdateStatus(epNonFatal + ecHostCan);
  1576.               bpSendACK;
  1577.               apFinishWriting;
  1578.               exit;
  1579.             end;
  1580.  
  1581.           'N':    {"Next data" packet, write it to file}
  1582.             begin
  1583.               Inc(BytesTransferred, RSize-1);    {update our data recd var}
  1584.               BytesRemaining := SrcFileLen-BytesTransferred;
  1585.               BlockWrite(WorkFile, RBuffer[1], RSize-1, I);
  1586.               ElapsedTics := ElapsedTime(Timer);    {allow for write time}
  1587.               if (I <> RSize-1) or (IOResult <> 0) then begin
  1588.                 apFinishWriting;
  1589.                 UpdateStatus(epNonFatal + ecFileIO);
  1590.                 SendFailure('EWrite failure');
  1591.                 exit;
  1592.               end;
  1593.               UserStatus(@Self,False,False);
  1594.               bpSendACK;
  1595.             end;
  1596.  
  1597.           'T':     {A transfer control packet, process per second byte}
  1598.             begin
  1599.               case Chr(RBuffer[1]) of
  1600.                 'C':   {"Transfer Complete" packet}
  1601.                   begin
  1602.                     UpdateStatus(epNonFatal + ecEndFile);
  1603.                     apFinishWriting;
  1604.                     bpSendACK;
  1605.                     AsyncStatus := ecOK;
  1606.                     LastXferOK := True;
  1607.                     exit;
  1608.                   end;
  1609.  
  1610.                 'I':   {"Transfer Info" packet; we only use FileSize field here}
  1611.                   begin
  1612.                     bpSendACK;
  1613.                     I := 4;   {skip data type and compression flags}
  1614.                     S := '';
  1615.                     while (I <= RSize-1) and (Chr(RBuffer[i]) in ['0'..'9']) do begin
  1616.                       S := S + Chr(RBuffer[i]);
  1617.                       Inc(I);
  1618.                     end;
  1619.                     Val(S,BytesRemaining,I);
  1620.                     if I <> 0 then
  1621.                       BytesRemaining := 0;
  1622.                     SrcFileLen := BytesRemaining;
  1623.                     R_Packets := 0;  {reset packet counts to reflect data}
  1624.                     S_Packets := 0;
  1625.                     NewTimer(Timer,Secs2Tics(SecsPerDay));  {reset timer for accuracy}
  1626.                   end;
  1627.  
  1628.                 'f':   {"Host Failed Resume"; rewrite the file}
  1629.                   begin
  1630.                     Close(WorkFile);
  1631.                       {if we default to Rename, rename the file}
  1632.                     if DefResume = xfrRename then begin
  1633.                       FSplit(Pathname, Dir, Name, Ext);
  1634.                       Name[1] := '$';
  1635.                       Pathname := Dir + Name + Ext;
  1636.                       Assign(WorkFile, PathName);
  1637.                       APort^.GotError(epNonFatal+ecFileRenamed);
  1638.                     end;
  1639.                       {otherwise just overwrite}
  1640.                     Rewrite(WorkFile,1);
  1641.                     if IOResult <> 0 then begin
  1642.                       FileOpen := False;
  1643.                       UpdateStatus(epNonFatal + ecFileIO);
  1644.                       SendFailure('CCannot create file');
  1645.                       exit;
  1646.                     end;
  1647.                     BytesTransferred := 0;
  1648.                     UpdateStatus(epNonFatal + ecResumeBad);
  1649.                     ResumeFlag := False;
  1650.                     R_Packets := 0;  {reset packet counts to reflect data}
  1651.                     S_Packets := 0;
  1652.                     bpSendACK;
  1653.                     NewTimer(Timer,Secs2Tics(SecsPerDay));  {reset timer for accuracy}
  1654.                   end;
  1655.  
  1656.                 else   {I dunno, boss!}
  1657.                   begin
  1658.                     UpdateStatus(epNonFatal + ecUnexpectedChar);
  1659.                     SendFailure('NInvalid T Packet');
  1660.                     apFinishWriting;
  1661.                     exit;
  1662.                   end;
  1663.               end;
  1664.             end;
  1665.         end;
  1666.       end
  1667.       else begin    {got a packet type we don't understand}
  1668.         UpdateStatus(epNonFatal+ecUnPacket);
  1669.         apFinishWriting;
  1670.         exit;
  1671.       end;
  1672.     end;
  1673.   end;
  1674.  
  1675.   function BPProtoFTP.bpDLESeen : Boolean;
  1676.     {-main handler called from terminal loop when <DLE> seen from host}
  1677.   label
  1678.     Skip;
  1679.   var
  1680.     I : Integer;
  1681.     Upl : Boolean;
  1682.   begin
  1683.     bpDLESeen := False;
  1684.     if Aborting then exit;
  1685.     bpInitVars;
  1686.  
  1687.       {<DLE> already seen, try to get 'B'}
  1688.     if NOT(ReadByte) or ((Ch and $7F) <> Ord('B')) then exit;
  1689.  
  1690.     UserStatus(@Self,True,False);
  1691.  
  1692.       {<DLE><'B'> seen, begin protocol processing}
  1693.     if ReadPacket(True,False) then begin
  1694.       case Chr(RBuffer[0]) of
  1695.         '+':                           {'+' packet: request for XPort params}
  1696.           with APort^ do begin
  1697.             ProcessTransportParams(True);
  1698.             UserStatus(@Self,False,True);
  1699.             exit;
  1700.           end;
  1701.  
  1702.         'T':                           {'T' packet: Trigger FTP services}
  1703.           begin
  1704.               {Draw the initial status screen}
  1705.               {verify direction}
  1706.             if NOT(Chr(RBuffer[1]) in ['D','U']) then begin
  1707.               UpdateStatus(epNonfatal + ecUnexpectedChar);
  1708.               SendFailure('NUnimplemented Transfer Function');
  1709.               UserStatus(@Self,False,True);
  1710.               exit;
  1711.             end;
  1712.               {verify file type}
  1713.             if NOT(Chr(RBuffer[2]) in ['A','B','I']) then begin
  1714.               UpdateStatus(epNonfatal + ecUnexpectedChar);
  1715.               SendFailure('NUnimplemented File Type');
  1716.               UserStatus(@Self,False,True);
  1717.               exit;
  1718.             end;
  1719.               {retrieve pathname}
  1720.             PathName := '';
  1721.             I := 2;
  1722.             while (RBuffer[i] <> 0) and (I < RSize-1) do begin
  1723.               Inc(I);
  1724.               PathName := PathName + Upcase(Chr(RBuffer[i]));
  1725.             end;
  1726.  
  1727.             if Chr(RBuffer[2]) = 'A' then
  1728.               SetEfficiencyParms(10,1)       {empirically-developed values}
  1729.             else
  1730.               SetEfficiencyParms(45,1);
  1731.  
  1732.             Upl := (Chr(RBuffer[1]) = 'U');
  1733.             if Upl then
  1734.               SendFile
  1735.             else
  1736.               RecvFile;
  1737.  
  1738.             UserStatus(@Self,False,True);
  1739.             bpDLESeen := True;
  1740.             exit;
  1741.           end;
  1742.  
  1743.         else
  1744.           begin                     {else an unsupported packet type}
  1745.             UserStatus(@Self,True,False);
  1746.             UpdateStatus(epNonFatal + ecUnexpectedChar);
  1747.             SendFailure('NUnknown packet type');
  1748.             UserStatus(@Self,False,True);
  1749.             exit;
  1750.           end;
  1751.       end;
  1752.     end;
  1753.   end;
  1754.  
  1755. {=== BPProtoGIF Methods ====================================================}
  1756.  
  1757.   constructor BPProtoGIF.Init(AP : AbstractPortPtr);
  1758.   begin
  1759.     if NOT BPProtocol.Init(AP) then Fail;
  1760.   end;
  1761.  
  1762.   destructor BPProtoGIF.Done;
  1763.   begin
  1764.     BPProtocol.Done;
  1765.   end;
  1766.  
  1767.   function BPProtoGIF.bpDLESeen : Boolean;
  1768.     {-called by terminal handler when <DLE> seen at port}
  1769.   begin
  1770.     bpDLESeen := False;
  1771.     if Aborting then exit;
  1772.     bpInitVars;
  1773.       {make sure we don't display status info}
  1774.     SetShowStatusProc(NoUserStatus);
  1775.  
  1776.       {<DLE> already seen, try to get 'B'}
  1777.     if NOT(ReadByte) or (Ch <> Ord('B')) then exit;
  1778.  
  1779.       {<DLE><'B'> seen, handle '+' packet (others handled from within
  1780.        your GIF decoder - see the documentation)}
  1781.     if ReadPacket(True,False) then begin
  1782.       if Chr(RBuffer[0]) = '+' then begin
  1783.         ProcessTransportParams(True);
  1784.         bpDLESeen := True;
  1785.       end
  1786.       else begin
  1787.         SendFailure('NUnknown packet type');
  1788.       end;
  1789.     end;
  1790.   end;
  1791.  
  1792.   function BPProtoGIF.bpGetGIFDataBlock(var P;
  1793.                                         var PSize : Word;
  1794.                                         var IsLast : Boolean) : Boolean;
  1795.     {-get next packet of GIF data into P}
  1796.   begin
  1797.     if ReadPacket(False,False) then begin
  1798.       bpGetGIFDataBlock := True;
  1799.       IsLast := ((Chr(RBuffer[0]) = 'T') and (Chr(RBuffer[1]) = 'C')) or
  1800.                 (Chr(RBuffer[0]) = 'F');
  1801.       Move(RBuffer[1],P,RSize-1);
  1802.       PSize := RSize-1;
  1803.     end
  1804.     else
  1805.       bpGetGIFDataBlock := False;
  1806.   end;
  1807.  
  1808. end.
  1809.  
  1810.