awzmodem.pas

Async Professional 4.04

                  zZmodemState := rzWaitFile;
                  zHeaderState := hsNone;
                  SetTimerTrigger(aTimeoutTrigger, aHandshakeWait, True);
                end;

            rzSendBlockPrep :
              if TriggerID = aDataTrigger then begin
                while CharReady and (zDiscardCnt < 2) do begin
                  GetChar(C);
                  Inc(zDiscardCnt);
                end;
                if zDiscardCnt = 2 then
                  zZmodemState := rzSendBlock;
              end else if Integer(TriggerID) = aTimeoutTrigger then begin 
                Inc(aBlockErrors);
                Inc(aTotalErrors);
                if aTotalErrors < aHandshakeRetry then
                  zZmodemState := rzRqstFile
                else
                  zZmodemState := rzCleanup;
              end;

              rzSendBlock :
                if TriggerID = aDataTrigger then begin
                  {Collect the data subpacket}
                  if zpReceiveBlock(P, aDataBlock^) then
                    if (aProtocolStatus = psBlockCheckError) or
                       (aProtocolStatus = psLongPacket) then
                      {Error receiving block, go try again}
                      zZmodemState := rzRqstFile
                    else
                      {Got block OK, go process}
                      zZmodemState := rzSendInit
                  else if aProtocolStatus = psCancelRequested then
                    zZmodemState := rzError;
                end else if Integer(TriggerID) = aTimeoutTrigger then begin 
                  {Timed out waiting for block...}
                  Inc(aBlockErrors);
                  Inc(aTotalErrors);
                  if aBlockErrors < aHandshakeRetry then begin
                    zpPutHexHeader(P, ZNak);
                    SetTimerTrigger(aTimeoutTrigger, aHandshakeWait, True);
                    zZmodemState := rzWaitFile;
                    zHeaderState := hsNone;
                  end else
                    zZmodemState := rzCleanup;
                end;

              rzSendInit :
                begin
                  {Save attention string}
                  Move(aDataBlock^, zAttentionStr, MaxAttentionLen);

                  {Turn on escaping if transmitter requests it}
                  zEscapeAll := (zRcvHeader[ZF0] and EscAll) = EscAll;

                  {Needs an acknowledge}
                  zpPutHexHeader(P, ZAck);
                  {Go wait for ZFile packet}
                  zZmodemState := rzWaitFile;
                  SetTimerTrigger(aTimeoutTrigger, aHandshakeWait, True);
                end;

              rzWaitFile :
                case aProtocolStatus of
                  psGotHeader :
                    begin
                      case zRcvFrame of
                        ZrQInit : {Go send ZrInit again}
                          zZmodemState := rzRqstFile;
                        ZFile : {Beginning of file transfer attempt}
                          begin
                            {Save conversion and transport options}
                            zConvertOpts := zRcvHeader[ZF0];
                            zTransportOpts := zRcvHeader[ZF2];

                            {Save file mgmt options (if not overridden)}
                            if not zFileMgmtOverride then
                              zFileMgmtOpts := zRcvHeader[ZF1];

                            {Set file mgmt default if none specified}
                            if zFileMgmtOpts = 0 then
                              zFileMgmtOpts := zfWriteProtect;

                            {Start collecting the ZFile's data subpacket}
                            zZmodemState := rzCollectFile;
                            aBlockErrors := 0;
                            aTotalErrors := 0;
                            zDataBlockLen := 0;
                            zRcvBlockState := rbData;
                            SetTimerTrigger(aTimeoutTrigger, aHandshakeWait, True);
                          end;

                        ZSInit :  {Sender's transmission options}
                          begin
                            {Start collecting ZSInit's data subpacket}
                            aBlockErrors := 0;
                            zDataBlockLen := 0;
                            zRcvBlockState := rbData;
                            SetTimerTrigger(aTimeoutTrigger,
                                             aHandshakeWait, True);
                            if zWasHex then begin
                              zZmodemState := rzSendBlockPrep;
                              zDiscardCnt := 0;
                            end else
                              zZmodemState := rzSendBlock;
                          end;

                        ZFreeCnt : {Sender is requesting a count of our freespace}
                          begin
                            LongInt(zTransHeader) := DiskFree(0);
                            zpPutHexHeader(P, ZAck);
                          end;

                        ZCommand : {Commands not implemented}
                          begin
                            zpPutHexHeader(P, ZNak);
                          end;

                        ZCompl,
                        ZFin:      {Finished}
                          begin
                            zZmodemState := rzSendFinish;
                            aBlockErrors := 0;
                          end;
                      end;
                      SetTimerTrigger(aTimeoutTrigger, aHandshakeWait, True);
                    end;
                  psNoHeader :
                    {Keep waiting for a header} ;
                  psBlockCheckError,
                  psTimeout :
                    zpBlockError(P, rzRqstFile, rzCleanup, aHandshakeRetry);
                end;

              rzCollectFile :
                if TriggerID = aDataTrigger then begin
                  {Collect the data subpacket}
                  if zpReceiveBlock(P, aDataBlock^) then
                    if (aProtocolStatus = psBlockCheckError) or
                       (aProtocolStatus = psLongPacket) then
                      {Error getting block, go try again}
                      zZmodemState := rzRqstFile
                    else
                      {Got block OK, go extract file info}
                      zZmodemState := rzStartFile
                  else if aProtocolStatus = psCancelRequested then
                    zZmodemState := rzError;
                end else if Integer(TriggerID) = aTimeoutTrigger then begin 
                  {Timeout collecting block}
                  Inc(aBlockErrors);
                  Inc(aTotalErrors);
                  if aBlockErrors < aHandshakeRetry then begin
                    zpPutHexHeader(P, ZNak);
                    SetTimerTrigger(aTimeoutTrigger, aHandshakeWait, True);
                  end else
                    zZmodemState := rzCleanup;
                end;

              rzStartFile :
                begin
                  {Got the data subpacket to the ZFile, extract the file info}
                  zpExtractFileInfo(P);

                  {Call user's LogFile function}
                  aProtocolStatus := psOK;
                  apLogFile(P, lfReceiveStart);

                  {Accept this file}
                  if not apAcceptFile(P, aPathName) then begin
                    zHeaderType := ZSkip;
                    aProtocolStatus := psSkipFile;
                    apLogFile(P, lfReceiveSkip);
                    zZmodemState := rzRqstFile;
                    aForceStatus := True;
                    goto ExitPoint;
                  end;

                  {Prepare to write this file}
                  apPrepareWriting(P);
                  if aProtocolError = ecOK then begin
                    case aProtocolStatus of
                      psCantWriteFile,
                      psFileDoesntExist : {Skip this file}
                        begin
                          zHeaderType := ZSkip;
                          aProtocolStatus := psSkipFile;
                          apLogFile(P, lfReceiveSkip);
                          zZmodemState := rzRqstFile;
                          aForceStatus := True;
                          goto ExitPoint;
                        end;
                    end;
                  end else begin
                    zpCancel(P);
                    zZmodemState := rzError;
                    goto ExitPoint;
                  end;

                  {Start protocol timer now}
                  NewTimer(aTimer, 1);
                  aTimerStarted := True;

                  {Go send the initial ZrPos}
                  zZmodemState := rzSync;
                  aForceStatus := True;
                end;

              rzSync :
                begin
                  {Incoming data will just get discarded so flush inbuf now}
                  FlushInBuffer;

                  {Insert file size into header and send to remote}
                  LongInt(zTransHeader) := aFileOfs;
                  zpPutHexHeader(P, ZrPos);

                  {Set status info}
                  aBytesRemaining := aSrcFileLen - aFileOfs;
                  aBytesTransferred := aFileOfs;

                  zZmodemState := rzStartData;
                  zHeaderState := hsNone;
                  aBlockErrors := 0;
                  SetTimerTrigger(aTimeoutTrigger, aHandshakeWait, True);
                end;

              rzStartData :
                case aProtocolStatus of
                  psGotHeader :
                    case zRcvFrame of
                      ZData :  {One or more data subpackets follow}
                        begin
                          if aFileOfs <> zLastFileOfs then begin
                            Inc(aBlockErrors);
                            Inc(aTotalErrors);
                            if aBlockErrors > MaxBadBlocks then begin
                              zpCancel(P);
                              apProtocolError(P, ecTooManyErrors);
                              zZmodemState := rzError;
                              goto ExitPoint;
                            end;
                            zpPutAttentionString(P);
                            zZmodemState := rzSync;
                          end else begin
                            zZmodemState := rzCollectData;
                            zDataBlockLen := 0;
                            zRcvBlockState := rbData;
                            SetTimerTrigger(aTimeoutTrigger, aHandshakeWait, True);
                         end;
                       end;
                      ZNak : {Nak received}
                        begin
                          Inc(aTotalErrors);
                          Inc(aBlockErrors);
                          if aBlockErrors > MaxBadBlocks then begin
                            zpCancel(P);
                            apProtocolError(P, ecTooManyErrors);
                            zZmodemState := rzError;
                          end else
                            {Resend ZrPos}
                            zZmodemState := rzSync;
                        end;
                      ZFile : {File frame}
                        {Already got a File frame, just go send ZrPos again}
                        zZmodemState := rzSync;
                      ZEof : {End of current file}
                        begin
                          aProtocolStatus := psEndFile;
                          zZmodemState := rzEndOfFile;
                        end;
                      else begin
                        {Error during GetHeader}
                        Inc(aTotalErrors);
                        Inc(aBlockErrors);
                        if aBlockErrors > MaxBadBlocks then begin
                          zpCancel(P);
                          apProtocolError(P, ecTooManyErrors);
                          zZmodemState := rzError;
                          goto ExitPoint;
                        end;
                        zpPutAttentionString(P);
                        zZmodemState := rzSync;
                      end;
                    end;
                  psNoHeader :
                    {Just keep waiting for header} ;
                  psBlockCheckError,
                  psTimeout :
                    zpBlockError(P, rzSync, rzError, aHandshakeRetry);
                end;

              rzCollectData :
                if TriggerID = aDataTrigger then begin
                  SetTimerTrigger(aTimeoutTrigger, aHandshakeWait, True);

                  {Collect the data subpacket}
                  if zpReceiveBlock(P, aDataBlock^) then begin
                    {Block is okay -- process it}
                    case aProtocolStatus of
                      psCancelRequested : {Cancel requested}
                        zZmodemState := rzError;
                      psGotCrcW : {Send requests a wait}
                        begin
                          {Write this block}
                          zpWriteDataBlock(P);
                          if aProtocolError = ecOK then begin
                            {Acknowledge with the current file position}
                            LongInt(zTransHeader) := aFileOfs;
                            zpPutHexHeader(P, ZAck);
                            zZmodemState := rzStartData;
                            zHeaderState := hsNone;
                          end else begin
                            zpCancel(P);
                            zZmodemState := rzError;
                          end;
                        end;
                      psGotCrcQ : {Ack requested}
                        begin
                          {Write this block}
                          zpWriteDataBlock(P);
                          if aProtocolError = ecOK then begin
                            LongInt(zTransHeader) := aFileOfs;
                            zpPutHexHeader(P, ZAck);
                            {Don't change state - will get next data subpacket}
                          end else begin
                            zpCancel(P);
                            zZmodemState := rzError;
                          end;
                        end;
                      psGotCrcG : {Normal subpacket - no response necessary}
                        begin
                          {Write this block}
                          zpWriteDataBlock(P);
                          if aProtocolError <> ecOK then begin
                            zpCancel(P);
                            zZmodemState := rzError;
                          end;
                        end;
                      psGotCrcE : {Last data subpacket}
                        begin
                          {Write this block}
                          zpWriteDataBlock(P);
                          if aProtocolError = ecOK then begin
                            zZmodemState := rzWaitEof;
                            zHeaderState := hsNone;
                            aBlockErrors := 0;
                          end else begin
                            zpCancel(P);
                            zZmodemState := rzError;
                          end;
                        end;
                      else begin
                        {Error in block}
                        if aBlockErrors < MaxBadBlocks then begin
                          zpPutAttentionString(P);
                          zZmodemState := rzSync;
                        end else begin
                          zpCancel(P);
                          apProtocolError(P, ecTooManyErrors);
                          zZmodemState := rzError;
                        end;
                        goto ExitPoint;
                      end;
                    end;

                    {Prepare to collect next block}
                    aForceStatus := True;
                    zDataBlockLen := 0;
                    zRcvBlockState := rbData;
                  end else if aProtocolStatus = psCancelRequested then
                    zZmodemState := rzError

                end else if Integer(TriggerID) = aTimeoutTrigger then begin
                  {Timeout collecting datasubpacket}
                  Inc(aBlockErrors);
                  Inc(aTotalErrors);