awxmodem.pas

Async Professional 4.04

    with P^ do begin
      if xGMode then
        xpGetHandshakeChar := GReq
      else if xCRCMode then
        xpGetHandshakeChar := CrcReq
      else
        xpGetHandshakeChar := ChkReq;
    end;
  end;

  function xpProcessHandshake(P : PProtocolData) : Boolean;
    {-Process handshake, return true if OK}
  var
    C : Char;
  begin
    with P^ do begin
      {If we get here we know a character is waiting}
      aHC.ValidDispatcher.GetChar(C);
      aProtocolStatus := psOK;
      case C of
        cCan : {Remote requested a cancel}
          begin
            aProtocolStatus := psCancelRequested;
            aForceStatus := True;
          end;
        ChkReq : {Set checksum mode}
          begin
            aCheckType := bcChecksum1;
            xCRCMode := False;
          end;
        CrcReq : {Set CRC mode}
          begin
            aCheckType := bcCrc16;
            xCRCMode := True;
          end;
        GReq : {Set G mode (streaming mode)}
          begin
            aCheckType := bcCrc16;
            xCRCMode := True;
            xGMode := True;
          end;
        else begin {Unexpected character}
          aProtocolStatus := psProtocolError;
          aForceStatus := True;
        end;
      end;

      {Update the protocol type}
      if aProtocolStatus = psOK then
        aCurProtocol := GetProtocolType(xCRCMode, x1KMode, xGMode,
                                        not IsXProtocol(aCurProtocol));

      xpProcessHandshake := aProtocolStatus = psOK;
    end;
  end;

  function xpProcessBlockReply(P : PProtocolData) : Boolean;
    {-Process reply to last block; return True for ack}
  var
    C : Char;
  begin
    with P^ do begin
      {Handle GMode (all blocks are assumed to succeed)}
      if xGMode then begin
        aProtocolStatus := psOK;
        Inc(aBytesTransferred, aBlockLen);
        Dec(aBytesRemaining, aBlockLen);
        if aBytesRemaining < 0 then
          aBytesRemaining := 0;
        Inc(aBlockNum);
        Inc(aFileOfs, aBlockLen);

        {Check for cancel from remote}
        if aHC.CharReady then begin
          aHC.ValidDispatcher.GetChar(C);
          if (C = cCan) or (C = cNak) then begin
            aProtocolStatus := psCancelRequested;
            aForceStatus := True;
          end;
        end;
        xpProcessBlockReply := aProtocolStatus = psOK;
      end else begin
        {Get the reply}
        aHC.ValidDispatcher.GetChar(C);

        {Process the reply}
        case C of
          cAck : {Block was acknowledged}
            begin
              aProtocolStatus := psOK;
              Inc(aBytesTransferred, aBlockLen);
              Dec(aBytesRemaining, aBlockLen);
              if aBytesRemaining < 0 then
                aBytesRemaining := 0;
              Inc(aBlockNum);
              Inc(aFileOfs, aBlockLen);
            end;
          cCan : {Cancel}
            begin
              aProtocolStatus := psCancelRequested;
              aForceStatus := True;
            end;
          else {Nak or unexpected character}
            Inc(aBlockErrors);
            Inc(aTotalErrors);
            if C = cNak then
              aProtocolStatus := psBlockCheckError
            else
              aProtocolStatus := psProtocolError;
            aForceStatus := True;
        end;
        xpProcessBlockReply := aProtocolStatus = psOK;
      end;
    end;
  end;

  procedure xpTransmitBlock(P : PProtocolData; var Block : TDataBlock;
                            BLen : Cardinal; BType : Char);
    {-Transmits one data block}
  var
    I : Integer;
  begin
    with P^ do begin
      if aBlockErrors > xMaxBlockErrors then
        {Too many errors}
        if x1KMode and (aBlockLen = 1024) then begin
          {1KMode - reduce the block size and try again}
          aBlockLen := 128;
          xStartChar := cSoh;
          aBlockErrors := 0;
        end else begin
          {Std Xmodem - have to cancel}
          xpCancel(P);
          apProtocolError(P, ecTooManyErrors);
          Exit;
        end;

      {Send the StartBlock char, the block sequence and its compliment}
      with aHC do begin
        PutChar(xStartChar);
        PutChar(Char(Lo(aBlockNum)));
        PutChar(Char(not Lo(aBlockNum)));
      end;
      {Init the aBlockCheck value}
      aBlockCheck := 0;

      {Send the data on its way}
      aHC.PutBlock(Block, aBlockLen);

      {Calculate the check character}
      if xCRCMode then
        for  I := 1 to aBlockLen do
          aBlockCheck :=
            apUpdateCrc(Byte(Block[I]), aBlockCheck)
      else
        for I := 1 to aBlockLen do
          aBlockCheck :=
            apUpdateCheckSum(Byte(Block[I]), aBlockCheck);

      {Send the check character}
      if xCRCMode then begin
        aBlockCheck := apUpdateCrc(0, aBlockCheck);
        aBlockCheck := apUpdateCrc(0, aBlockCheck);
        aHC.PutChar(Char(Hi(aBlockCheck)));
        aHC.PutChar(Char(Lo(aBlockCheck)));
      end else
        aHC.PutChar(Char(aBlockCheck));
    end;
  end;

  procedure TransmitEot(P : PProtocolData; First : Boolean);
    {-Transmit an Xmodem EOT (end of transfer)}
  begin
    with P^ do begin
      aProtocolStatus := psOK;
      if First then begin
        aBlockErrors := 0;
        xNaksReceived := 0;
      end;

      {Ensure no stale ACKs are in the Rx buffer}
      aHC.FlushInBuffer;
      {Send the Eot char}
      aHC.PutChar(cEot);
    end;
  end;

  function ProcessEotReply(P : PProtocolData) : Boolean;
    {-Get a response to an EOT, return True for ack or cancel}
  var
    C : Char;
  begin
    with P^ do begin
      {Get the response}
      aHC.ValidDispatcher.GetChar(C);
      case C of
        cAck : {Receiver acknowledged Eot, this transfer is over}
          begin
            ProcessEotReply := True;
            aProtocolStatus := psEndFile;
          end;
        cCan : {Receiver asked to cancel, this transfer is over}
          begin
            ProcessEotReply := True;
            aProtocolStatus := psCancelRequested;
            aForceStatus := True;
          end;
        cNak : {Some Xmodems always NAK the first 1 or 2 EOTs}
                {So, don't count them as errors till we get 3 }
          begin
            ProcessEotReply := False;
            Inc(xNaksReceived);
            If xNaksReceived >= 3 then begin
              xpCancel(P);
              apProtocolError(P, ecTooManyErrors);
            end;
          end;
        else {Unexpected character received}
          ProcessEotReply := False;
          Inc(aBlockErrors);
          Inc(aTotalErrors);
          aProtocolStatus := psProtocolError;
      end
    end;
  end;

  procedure xpSendHandshakeChar(P : PProtocolData; Handshake : Char);
    {-Send the current handshake char}
  begin
    with P^ do
      {If in Gmode, filter out all standard Acks}
      if not xGmode or (Handshake <> cAck) then
        aHC.PutChar(Handshake);
  end;

  function xpCheckForBlockStart(P : PProtocolData; var C : Char) : Boolean;
    {-Scan input buffer for start char, return True if found}
  begin
    with P^ do begin
      aProtocolStatus := psOK;
      xpCheckForBlockStart := False;

      {Ready to scan...}
      aBlockErrors := 0;
      while aHC.CharReady do begin

        {Check the next character}
        aHC.ValidDispatcher.GetChar(C);
        case C of
          cSoh, cStx, cEot, cCan :
            begin
              xpCheckForBlockStart := True;
              Exit;
            end;
          else begin
            aProtocolStatus := psProtocolError;
            aForceStatus := True;
            xEotCounter := 0;
            xCanCounter := 0;
          end;
        end;
      end;
    end;
  end;

  function xpProcessBlockStart(P : PProtocolData;
                               C : Char) : TProcessBlockStart;
    {-Standard action for block start characters}
  begin
    with P^ do begin
      case C of
        cSoh :
          begin
            xpProcessBlockStart := pbs128;
            aBlockLen := 128;
            aBlkIndex := 0;
          end;
        cStx :
          begin
            xpProcessBlockStart := pbs1024;
            aBlockLen := 1024;
            aBlkIndex := 0;
          end;
        cCan :
          begin
            xEotCounter := 0;
            Inc(xCanCounter);
            if xCanCounter > 2 then begin
              xpProcessBlockStart := pbsCancel;
              xpCancel(P);
            end else
              xpProcessBlockStart :=  pbsNone;
          end;
        cEot :
          begin
            xCanCounter := 0;
            Inc(xEotCounter);
            if xEotCounter = 1 then begin
              xpProcessBlockStart := pbsNone;
              aHC.PutChar(cNak);
              aHC.SetTimerTrigger(aTimeoutTrigger, xBlockWait, True);
            end else begin
              xpProcessBlockStart := pbsEOT;
              aProtocolStatus := psEndFile;
              aHC.PutChar(cAck);
            end;
          end;
        else
          xpProcessBlockStart := pbsNone;
      end;
    end;
  end;

  function xpCollectBlock(P : PProtocolData; var Block : TDataBlock) : Boolean;
    {-Collect received data into DataBlock, return True for full block}
  var
    TotalLen : Cardinal;
    C : Char;
  begin
    with P^ do begin
      xHandshake := cNak;
      TotalLen := aBlockLen + xOverheadLen;
      while aHC.CharReady and (aBlkIndex < TotalLen) do begin
        aHC.ValidDispatcher.GetChar(C);
        Inc(aBlkIndex);
        Block[aBlkIndex] := C;
      end;
      xpCollectBlock := aBlkIndex = TotalLen;
    end;
  end;

  procedure xpReceiveBlock(P : PProtocolData; var Block : TDataBlock;
                           var BlockSize : Cardinal; var HandShake : Char);
    {-Process the data already in Block}
  type
    LHW = record
      L,H : Char;
    end;
  var
    R1, R2 : Byte;
    I      : Cardinal;
    Check  : Word;
  begin
    with P^ do begin
      {Get and compare block sequence numbers}
      R1 := Byte(Block[1]);
      R2 := Byte(Block[2]);
      if (not R1) <> R2 then begin
        Inc(aBlockErrors);
        Inc(aTotalErrors);
        xpCancel(P);
        aProtocolStatus := psSequenceError;
        apProtocolError(P, ecSequenceError);
        Exit;
      end;

      {Calculate the block check value}
      aBlockCheck := 0;
      if xCRCMode then
        for I := 3 to aBlockLen+2 do
          aBlockCheck := apUpdateCrc(Byte(Block[I]), aBlockCheck)
      else
        for I := 3 to aBlockLen+2 do
          aBlockCheck := apUpdateCheckSum(Byte(Block[I]), aBlockCheck);

      {Check the block-check character}
      if xCRCMode then begin
        aBlockCheck := apUpdateCrc(0, aBlockCheck);
        aBlockCheck := apUpdateCrc(0, aBlockCheck);
        LHW(Check).H := Block[aBlockLen+3];
        LHW(Check).L := Block[aBlockLen+4];
      end else begin
        Check := Byte(Block[aBlockLen+3]);
        aBlockCheck := aBlockCheck and $FF;
      end;

      if Check <> aBlockCheck then begin
        {Block check error}
        Inc(aBlockErrors);
        Inc(aTotalErrors);
        aHC.FlushInBuffer;
        aProtocolStatus := psBlockCheckError;
        Exit;
      end;

      {Check the block sequence for missing or duplicate blocks}
      if (aBlockNum <> 0) and (R1 = Lo(aBlockNum-1)) then begin
        {This is a duplicate block}
        HandShake := cAck;
        aBlockErrors := 0;
        aProtocolStatus := psDuplicateBlock;
        Exit;