awzmodem.pas

Async Professional 4.04

            aHC.SendBreak(1, False);
          $DE : {Remote wants us to pause for one second}
            DelayTicks(18, True);
          else   {Remote wants us to send a normal char}
            aHC.PutChar(Chr(zAttentionStr[I]));
        end;
        Inc(I);
      end;
    end;
  end;

  procedure zpPutCharHex(P : PProtocolData; C : Char);
    {-Sends C as two hex ascii digits}
  var
    B : Byte absolute C;
  begin
    with P^ do begin
      aHC.PutChar(HexDigits[B shr 4]);
      aHC.PutChar(HexDigits[B and $0F]);
    end;
  end;

  procedure zpPutHexHeader(P : PProtocolData; FrameType : Char);
    {-Sends a hex header}
  const
    HexHeaderStr : array[0..4] of Char = ZPad+ZPad+ZDle+ZHex;
  var
    SaveCrc32 : Bool;
    Check     : Cardinal;
    I         : Byte;
    C         : Char;
  begin
    with P^ do begin
      {Initialize the aBlockCheck value}
      SaveCrc32 := zUseCrc32;
      zUseCrc32 := False;
      aBlockCheck := 0;

      {Send the header and the frame type}
      aHC.PutBlock(HexHeaderStr, SizeOf(HexHeaderStr)-1);
      zpPutCharHex(P, FrameType);
      zpUpdateBlockCheck(P, Ord(FrameType));

      {Send the position/flag bytes}
      for I := 0 to SizeOf(zTransHeader)-1 do begin
        zpPutCharHex(P, Char(zTransHeader[I]));
        zpUpdateBlockCheck(P, zTransHeader[I]);
      end;

      {Update Crc16 and send it (hex encoded)}
      zpUpdateBlockCheck(P, 0);
      zpUpdateBlockCheck(P, 0);
      Check := Cardinal(aBlockCheck);
      zpPutCharHex(P, Char(Hi(Check)));
      zpPutCharHex(P, Char(Lo(Check)));

      {End with a carriage return, hibit line feed}
      aHC.PutChar(cCR);
      C := Chr(Ord(cLF) or $80);
      aHC.PutChar(C);

      {Conditionally send Xon}
      if (FrameType <> ZFin) and (FrameType <> ZAck) then
        aHC.PutChar(cXon);

      {Note frame type for status}
      zLastFrame := FrameType;

      {Restore crc type}
      zUseCrc32 := SaveCrc32;
    end;
  end;

  procedure zpGetCharEscaped(P : PProtocolData; var C : Char);
    {-Get a character (handle data link escaping)}
  label
    Escape;
  begin
    with P^ do begin
      zControlCharSkip := False;

      {Go get escaped char if we already have the escape}
      if zEscapePending then
        goto Escape;

      {Get a character}
      aHC.ValidDispatcher.GetChar(C);

      {Process char}
      case C of
        cXon,
        cXoff,
        cXonHi,
        cXoffHi : begin
                    {unescaped control char, ignore it}
                    zControlCharSkip := True;
                    Exit;
                  end;
      end;

      {If not data link escape or cancel then just return the character}
      if (C <> ZDle) then begin
        zCanCount := 0;
        Exit;
      end else if zpGotCancel(P) then
        {Got 5 cancels, ZDle's, in a row}
        Exit;

Escape:
      {Need another character, get it or say we're pending}
      if aHC.CharReady then begin
        zEscapePending := False;
        aHC.ValidDispatcher.GetChar(C);

        {If cancelling make sure we get at least 5 of them}
        if (C = cCan) then begin
          zpGotCancel(P);
          Exit;
        end else begin                                            
          {Must be an escaped character}
          zCanCount := 0;
          case C of
            ZCrcE : {Last DataSubpacket of file}
              aProtocolStatus := psGotCrcE;
            ZCrcG : {Normal DataSubpacket, no response necessary}
              aProtocolStatus := psGotCrcG;
            ZCrcQ : {ZAck or ZrPos requested}
              aProtocolStatus := psGotCrcQ;
            ZCrcW : {DataSubpacket contains file information}
              aProtocolStatus := psGotCrcW;
            ZRub0 :         {Ascii delete}
              C := #$7F;
            ZRub1 :         {Hibit Ascii delete}
              C := #$FF;
            else            {Normal escaped character}
              C := Char(Ord(C) xor $40)
          end;
        end;
      end else
        zEscapePending := True;
    end;
  end;

  procedure zpGetCharHex(P : PProtocolData; var C : Char);
    {-Return a character that was transmitted in hex}
  label
    Hex;

    function NextHexNibble : Byte;
      {-Gets the next char, returns it as a hex nibble}
    var
      C : Char;
    begin
      with P^ do begin
        {Get the next char, assume it's ascii hex character}
        aHC.ValidDispatcher.GetChar(C);

        {Handle cancels}
        if (C = cCan) then begin
          if zpGotCancel(P) then begin
            NextHexNibble := 0;
            Exit;
          end;
        end else
          zCanCount := 0;

        {Ignore errors, they'll eventually show up as bad blocks}
        NextHexNibble := Pos(C, HexDigits) - 1;
      end;
    end;

  begin
    with P^  do begin
      if zHexPending then
        goto Hex;
      zHexChar := NextHexNibble shl 4;
Hex:
      if aHC.CharReady then begin
        zHexPending := False;
        Inc(zHexChar, NextHexNibble);
        C := Chr(zHexChar);
      end else
        zHexPending := True;
    end;
  end;

  function zpCollectHexHeader(P : PProtocolData) : Bool;
    {-Gets the data and trailing portions of a hex header}
  var
    C : Char;
  begin
    with P^ do begin
      {Assume the header isn't ready}
      zpCollectHexHeader := False;

      zpGetCharHex(P, C);
      if zHexPending or (aProtocolStatus = psCancelRequested) then
        Exit;

      {Init block check on startup}
      if zHexHdrState = hhFrame then begin
        aBlockCheck := 0;
        zUseCrc32 := False;
      end;

      {Always update the block check}
      zpUpdateBlockCheck(P, Ord(C));

      {Process this character}
      case zHexHdrState of
        hhFrame :
          zRcvFrame := C;
        hhPos1..hhPos4 :
          zRcvHeader[Ord(zHexHdrState)-1] := Ord(C);
        hhCrc1 :
          {just keep going} ;
        hhCrc2 :
          if not zpVerifyBlockCheck(P) then begin
            aProtocolStatus := psBlockCheckError;
            Inc(aTotalErrors);
            zHeaderState := hsNone;
          end else begin
            {Say we got a good header}
            zpCollectHexHeader := True;
          end;
      end;

      {Goto next state}
      if zHexHdrState <> hhCrc2 then
        Inc(zHexHdrState)
      else
        zHexHdrState := hhFrame;
    end;
  end;

  function zpCollectBinaryHeader(P : PProtocolData; Crc32 : Bool) : Bool;
    {-Collects a binary header, returns True when ready}
  var
    C : Char;
  begin
    with P^ do begin
      {Assume the header isn't ready}
      zpCollectBinaryHeader := False;

      {Get the waiting character}
      zpGetCharEscaped(P, C);
      if zEscapePending or (aProtocolStatus = psCancelRequested) then
        Exit;
      if zControlCharSkip then
        Exit;

      {Init block check on startup}
      if zBinHdrState = bhFrame then begin
        zUseCrc32 := Crc32;
        aBlockCheck := CheckInit[zUseCrc32];
      end;

      {Always update the block check}
      zpUpdateBlockCheck(P, Ord(C));

      {Process this character}
      case zBinHdrState of
        bhFrame :
          zRcvFrame := C;
        bhPos1..bhPos4 :
          zRcvHeader[Ord(zBinHdrState)-1] := Ord(C);
        bhCrc2 :
          if not zUseCrc32 then begin
            if not zpVerifyBlockCheck(P) then begin
              aProtocolStatus := psBlockCheckError;
              Inc(aTotalErrors);
              zHeaderState := hsNone;
            end else begin
              {Say we got a good header}
              zpCollectBinaryHeader := True;
            end;
          end;
        bhCrc4 :
          {Check the Crc value}
          if not zpVerifyBlockCheck(P) then begin
            aProtocolStatus := psBlockCheckError;
            Inc(aTotalErrors);
            zHeaderState := hsNone;
          end else begin
            {Say we got a good header}
            zpCollectBinaryHeader := True;
          end;
      end;

      {Go to next state}
      if zBinHdrState <> bhCrc4 then
        Inc(zBinHdrState)
      else
        zBinHdrState := bhFrame;
    end;
  end;

  procedure zpCheckForHeader(P : PProtocolData);
    {-Samples input stream for start of header}
  var
    C : Char;
  begin
    with P^ do begin
      {Assume no header ready}
      aProtocolStatus := psNoHeader;

      {Process potential header characters}
      while aHC.CharReady do begin

        {Only get the next char if we don't know the header type yet}
        case zHeaderState of
          hsNone, hsGotZPad, hsGotZDle :
            if not zpGetCharStripped(P, C) then
              Exit;
        end;

        {Try to accumulate the start of a header}
        aProtocolStatus := psNoHeader;
        case zHeaderState of
          hsNone :
            if C = ZPad then
              zHeaderState := hsGotZPad;
          hsGotZPad :
            case C of
              ZPad : ;
              ZDle : zHeaderState := hsGotZDle;
              else   zHeaderState := hsNone;
            end;
          hsGotZDle :
            case C of
              ZBin   :
                begin
                  zWasHex := False;
                  zHeaderState := hsGotZBin;
                  zBinHdrState := bhFrame;
                  zEscapePending := False;
                  {if zpCollectBinaryHeader(P, False) then}
                  {  zHeaderState := hsGotHeader;         }
                end;
              ZBin32 :
                begin
                  zWasHex := False;
                  zHeaderState := hsGotZBin32;
                  zBinHdrState := bhFrame;
                  zEscapePending := False;
                  {if zpCollectBinaryHeader(P, True) then}
                  {  zHeaderState := hsGotHeader;        }
                end;
              ZHex   :
                begin
                  zWasHex := True;
                  zHeaderState := hsGotZHex;
                  zHexHdrState := hhFrame;
                  zHexPending := False;
                  {if zpCollectHexHeader(P) then}
                end;
              else
                zHeaderState := hsNone;
            end;
          hsGotZBin :
            if zpCollectBinaryHeader(P, False) then
              zHeaderState := hsGotHeader;
          hsGotZBin32 :
            if zpCollectBinaryHeader(P, True) then
              zHeaderState := hsGotHeader;
          hsGotZHex :
            if zpCollectHexHeader(P) then
              zHeaderState := hsGotHeader;
        end;

        if (zHeaderState = hsGotHeader) and (zRcvFrame = ZEof) and
          (zLastFrame = ZrPos) then
          zHeaderState := hsNone;                                    

        {If we just got a header, note file pos and frame type}
        if zHeaderState = hsGotHeader then begin
          aProtocolStatus := psGotHeader;
          case zLastFrame of
            ZrPos, ZAck, ZData, ZEof :
              {Header contained a reported file position}
              zLastFileOfs := LongInt(zRcvHeader);