awbplus.pas

测试用例

(***** BEGIN LICENSE BLOCK *****
 * Version: MPL 1.1
 *
 * The contents of this file are subject to the Mozilla Public License Version
 * 1.1 (the "License"); you may not use this file except in compliance with
 * the License. You may obtain a copy of the License at
 * http://www.mozilla.org/MPL/
 *
 * Software distributed under the License is distributed on an "AS IS" basis,
 * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License
 * for the specific language governing rights and limitations under the
 * License.
 *
 * The Original Code is TurboPower Async Professional
 *
 * The Initial Developer of the Original Code is
 * TurboPower Software
 *
 * Portions created by the Initial Developer are Copyright (C) 1991-2002
 * the Initial Developer. All Rights Reserved.
 *
 * Contributor(s):
 *
 * ***** END LICENSE BLOCK ***** *)

{*********************************************************}
{*                   AWBPLUS.PAS 4.06                    *}
{*********************************************************}
{* Deprecated CompuServe B+ protocol (CompuServe doesn't *}
{* support this anymore                                  *}
{*********************************************************}

{Global defines potentially affecting this unit}
{$I AWDEFINE.INC}

{Options required for this unit}
{$V-,I-,B-,F+,A-,X+}

{$IFDEF Win32}
{$J+}
{$ENDIF}

unit AwBPlus;
  {-Provides CIS B+ remote (not host) protocol}

interface

uses
  WinTypes,
  WinProcs,
  Messages,
  SysUtils,
  OoMisc,
  AwUser,
  AwTPcl,
  AwAbsPcl,
  AdPort; 

const
  {For estimating protocol transfer times}
  BPlusTurnDelay = 0;        {Millisecond turnaround delay}
  BPlusOverHead  = 20;       {Default overhead for each data subpacket}

{Constructors/destructors}
function bpInit(var P : PProtocolData; H : TApdCustomComPort;
                Options : Cardinal) : Integer;
procedure bpDone(var P : PProtocolData);

function bpReinit(P : PProtocolData) : Integer;
procedure bpDonePart(P : PProtocolData);

{Terminal mode methods}
function bpProcessENQ(P : PProtocolData) : Integer;
function bpProcessESCI(P : PProtocolData; X, Y : Byte) : Integer;
function bpPrepareProcessDLE(P : PProtocolData;
                             var ATimerIndex : Cardinal) : Integer;
function bpProcessDLE(P : PProtocolData; IsData : Bool;
                      var Ready, Start, Upload : Bool) : Integer;

{Control}
procedure bpPrepareReceive(P : PProtocolData);
procedure bpReceive(Msg, wParam : Cardinal;
                   lParam : LongInt);
procedure bpPrepareTransmit(P : PProtocolData);
procedure bpTransmit(Msg, wParam : Cardinal;
                    lParam : LongInt);


implementation

const
  {Default ParamsRecord values}
  DefDR : Byte = 1;   {Can handle Download Resume}
  DefBS : Byte = 16;  {Default to 128 * DefBS (2048) byte packets}
  DefWS = 1;          {Can handle send ahead}
  DefWR = 2;          {Can receive up to 2 packets ahead}
  DefCM = 1;          {Can handle CRC blockchecking}
  DefDQ = 1;          {Can handle special quoting including non-quoted NUL}
  DefUR = 0;          {Can NOT handle Upload Recovery (not supported by CIS)}
  DefFI = 1;          {Can handle File Info packet}
  DefXP = 0;          {FTP/GIF does not use TransportLayer}

  aDataTrigger = 0;

  function IncSequence(Value : Integer) : Integer;
    {-Increment a Sequence Number var}
  begin
    IncSequence := (Succ(Value) mod 10);
  end;

  procedure SendByte(P : PProtocolData; C : Char);
  begin
    with P^ do
      aHC.PutChar(C);
  end;

  function IncSA(P : PProtocolData; Value : Integer) : Integer;
  begin
    with P^ do
      if Value = bSAMax then
        IncSA := 1
      else
        IncSA := Value + 1;
  end;

  procedure UpdateBlockCheck(P : PProtocolData; CurByte : Byte);
    {-Update the CRC/bChecksum to reflect the new byte}

    function UpdCrc(CurByte : Byte; CurCrc : Cardinal) : Cardinal;
      {-Due to an oddity in the CIS handling of CRC's, we use this special
        version of UpdateCrc rather than the one in APMISC.  This function
        requires the CRC lookup table in APMISC.}
    begin
      UpdCrc := CrcTable[((CurCrc shr 8) xor CurByte) and $FF] xor
                (CurCrc shl 8);
    end;

  begin
    with P^ do begin
      if aCheckType = bcCrc16 then
        bChecksum := UpdCRC(CurByte,bChecksum)
      else begin
        bChecksum := bChecksum shl 1;
        if bChecksum > 255 then
          bChecksum := (bChecksum and $FF) + 1;
        bChecksum := bChecksum + CurByte;
        if bChecksum > 255 then
          bChecksum := (bChecksum and $FF) + 1;
      end;
    end;
  end;

  procedure SendQuotedByte(P : PProtocolData; C : Char);
    {-Quote and transmit I}
  var
    B : Byte absolute C;
  begin
    with P^ do begin
      if bQuoteTable[B] <> #0 then begin
        SendByte(P, cDLE);
        SendByte(P, bQuoteTable[B]);
      end else
        SendByte(P, Chr(B));
    end;
  end;

  procedure bpSendAck(P : PProtocolData);
    {-Send Ack}
  begin
    with P^ do begin
      SendByte(P, cDLE);
      SendByte(P, Chr(bSeqNum + Ord('0')));
    end;
  end;

  procedure bpSendNAK(P : PProtocolData);
    {-Send Nak}
  begin
    SendByte(P, cNAK);
  end;

  procedure bpSendData(P : PProtocolData; BNum : Integer);
  var
    I : Integer;
  begin
    with P^ do begin
      with bSBuffer[BNum] do begin
        if bBPlusMode and (aCheckType = bcCrc16) then
          bChecksum := $FFFF
        else
          bChecksum := 0;

        SendByte(P, cDLE);
        SendByte(P, 'B');

        SendByte(P, Chr(Seq+Ord('0')));
        UpdateBlockCheck(P, Byte(Seq+Ord('0')));

        SendByte(P, PType);
        UpdateBlockCheck(P, Byte(PType));

        for I := 1 to Num do begin
          SendQuotedByte(P, Buf^[I]);
          UpdateBlockCheck(P, Byte(Buf^[I]));
        end;

        SendByte(P, cETX);
        UpdateBlockCheck(P, Byte(cETX));

        if bBPlusMode and (aCheckType = bcCrc16) then
          SendQuotedByte(P, Char(Hi(bChecksum)));
        SendQuotedByte(P, Char(Lo(bChecksum)));
      end;
    end;
  end;

  procedure bpSendPacket(P : PProtocolData; APacketType : Char; Size : Integer);
    {-Send a packet of data}
  begin
    with P^ do begin
      bSeqNum := IncSequence(bSeqNum);
      with bSBuffer[bNext2Fill] do begin
        Seq   := bSeqNum;
        Num   := Size;
        PType := APacketType;
      end;
      bpSendData(P, bNext2Fill);
      bNext2Fill := IncSA(P, bNext2Fill);
      Inc(bSAWaiting);
    end;
  end;

  procedure bpSendFailure(P : PProtocolData; Reason : String);
    {-Send a failure packet}
  begin
    with P^ do begin
      bNext2ACK := 1;
      bNext2Fill := 1;
      bSAWaiting := 0;
      bAborting := True;

      with bSBuffer[1] do
        Move(Reason[1], Buf^[1], Length(Reason));

      bpSendPacket(P, 'F', Length(Reason));
    end;
  end;

  procedure bpGetCharQuoted(P : PProtocolData; var C : Char);
    {-Return a character that was transmitted bQuoted}
  label
    Quote;
  begin
    with P^ do begin
      bQuoted := False;

      if bQuotePending then
        goto Quote;
      aHC.ValidDispatcher.GetChar(C);
      if C <> cDLE then
        Exit;

    Quote:
      bQuoted := True;
      if aHC.CharReady then begin
        bQuotePending := False;
        aHC.ValidDispatcher.GetChar(C);
        if C < #$60 then
          C := Char(Ord(C) and $1F)
        else
          C := Char((Ord(C) and $1F) or $80);
      end else
        bQuotePending := True;
    end;
  end;

  function bpCollectPacket(P : PProtocolData) : Bool;
    {-Collect a packet}
  var
    C : Char;
    Finished : Bool;
  begin
    bpCollectPacket := False;

    with P^ do begin
      repeat
        {Reset char timer each time a new character is received}
        aHC.SetTimerTrigger(bCurTimer, aHandshakeWait, True);

        {Process current packet collection state}
        case bPacketState of
          psGetDLE :
            begin
              aHC.ValidDispatcher.GetChar(C);
              case C of
                cDLE : bPacketState := psGetB;
                cENQ : bPacketState := psSendAck;
              end;
            end;

          psGetB :
            begin
              aHC.ValidDispatcher.GetChar(C);
              case C of
                'B'  : bPacketState := psGetSeq;
                ';'  : bPacketState := psGetDLE;
                cEnq : bPacketState := psSendAck;
                else   bPacketState := psGetDLE;
              end;
            end;

          psGetSeq :
            begin
              {Reset timer to discount time spent verifying CRCs}
              if bResumeFlag then
                NewTimer(aTimer, 1);

              aHC.ValidDispatcher.GetChar(C);
              case C of
                cEnq : bPacketState := psSendAck
                else begin
                  if aCheckType = bcCrc16 then
                    bChecksum := $FFFF
                  else
                    bChecksum := 0;
                  UpdateBlockCheck(P, Byte(C));
                  bPacketNum := Ord(C)-Ord('0');
                  bPacketState := psGetType;
                end;
              end;
            end;

          psGetType :
            begin
              bpGetCharQuoted(P, C);
              if bQuotePending then
                Exit;
              UpdateBlockCheck(P, Byte(C));
              bLastType := C;
              bIdx := 1;
              bPacketState := psGetData;
            end;

          psGetData :
            {Stay here while data available...}
            while aHC.CharReady do begin
              bpGetCharQuoted(P, C);
              if bQuotePending then
                Exit;
              UpdateBlockCheck(P, Byte(C));
              if (C = cETX) and not bQuoted then begin
                bPacketState := psGetCheck1;
                Exit;
              end else begin
                bRBuffer^[bIdx] := C;
                Inc(bIdx);
              end;
            end;

          psGetCheck1 :
            begin
              bpGetCharQuoted(P, C);
              if bQuotePending then
                Exit;
              if aCheckType = bcCrc16 then begin
                UpdateBlockCheck(P, Byte(C));
                bPacketState := psGetCheck2;
              end else begin
                bNewChk := Byte(C);
                bPacketState := psCheckCheck;
              end;
            end;

          psGetCheck2 :
            begin
              bpGetCharQuoted(P, C);
              if bQuotePending then
                Exit;
              UpdateBlockCheck(P, Byte(C));
              bNewChk := 0;
              bPacketState := psCheckCheck;
            end;

          psCheckCheck :
            begin
              if bNewChk <> bChecksum then begin
                {bChecksum/CRC error}
                aProtocolStatus := psBlockCheckError;
                aForceStatus := True;
                bPacketState := psError;
              end else if bLastType = 'F' then
                {Always accept failure packet}
                bPacketState := psSuccess
              else if bPacketNum = bSeqNum then begin
                {Dupe packet}
                aProtocolStatus := psDuplicateBlock;
                aForceStatus := True;
                bPacketState := psSendAck;
              end else if bPacketNum <> bNextSeq then begin
                {Out-of-sequence error...}
                if bPacketNum <> IncSequence(bNextSeq) then begin
                  {...and not a possible SA packet after error}
                  apProtocolError(P, ecSequenceError);
                  aForceStatus := True;
                  bPacketState := psGetDLE;
                end else
                  bPacketState := psGetDLE;
              end else begin
                aProtocolStatus := psOk;
                aForceStatus := True;
                bPacketState := psSuccess;
              end;
            end;

          psError :
            begin
              Inc(aTotalErrors);
              Inc(aBlockErrors);
              if (aBlockErrors > BPErrorMax) then begin
                bpCollectPacket := True;
                Exit;
              end;
              if not bNAKSent or not bBPlusMode then begin