awbplus.pas

测试用例

                bpSendFailure(P, 'EToo many errors');
                bBPlusState := tbError;
              end;
            end;

          tbEndOfFile :
            begin
              {Send TransferComplete packet}
              with bSBuffer[bNext2Fill] do begin
                Buf^[1] := 'C';
                bpSendPacket(P, 'T', 1);
                Dispatcher.SetTimerTrigger(aTimeoutTrigger, aHandshakeWait, True);
                bBPlusState := tbEofAck;
              end;
              {if bSAWaiting = 0 then begin}
              Dispatcher.SetTimerTrigger(aTimeoutTrigger,
                               aHandshakeWait, True);
              bAckState := acGetDLE;
              {end;}
            end;

          tbEofAck :
            if bpCollectAck(P) then
              if aProtocolError = ecOK then begin
                bBPlusState := tbCleanup;
                aForceStatus := True;
              end else begin
                bpSendFailure(P, 'EToo many errors');
                aForceStatus := True;
                bBPlusState := tbError;
              end;

          tbError :
            begin
              {Save failure status}
              aSaveError := aProtocolError;

              {Start waiting for acknowledgment (failure packet already sent)}
              bBPlusState := tbWaitErrorAck;
              bAckState := acGetDLE;
              Dispatcher.SetTimerTrigger(aTimeoutTrigger, aFinishWait, True);
            end;

          tbWaitErrorAck :
            if bpCollectAck(P) then begin
              aProtocolError := aSaveError;
              aForceStatus := True;
              bBPlusState := tbCleanup;
            end;

          tbCleanup :
            begin
              apFinishReading(P);

              {Log file}
              if aProtocolError = ecOK then
                apLogFile(P, lfTransmitOK)
              else
                apLogFile(P, lfTransmitFail);

              apShowLastStatus(P);
              Dispatcher.FlushInBuffer;
              bBPlusState := tbDone;
              apSignalFinish(P);
            end;
        end;

        {Stay in state machine or exit}
        case bBPlusState of
          {Stay only if data ready}
          tbCheckAck,
          tbWaitErrorAck,
          tbEofAck        : Finished := not Dispatcher.CharReady;

          {Stay because there is more work to do}
          tbInitial,
          tbGetBlock,
          tbSendData,
          tbEndOfFile,
          tbError,
          tbCleanup       : Finished := False;

          {Exit, waiting for new trigger}
          tbWaitFreeSpace : Finished := not Dispatcher.CharReady;

          {Done state, always exit}
          tbDone          : Finished := True;
          else              Finished := True;
        end;

        {Store aProtocolStatus}
        aSaveStatus := aProtocolStatus;

        {If staying is state machine force data ready}
        TriggerID := aDataTrigger;
      until Finished;
    end;

    {$IFDEF Win32}
    LeaveCriticalSection(P^.aProtSection);
    {$ENDIF}
  end;

  procedure bpPrepareReceive(P : PProtocolData);
    {-Prepare to receive BPlus parts}
  begin
    with P^ do begin
      {Init the state machine}
      bBPlusState := rbInitial;
      aProtocolError := ecOK;
      aSaveStatus := psOK;
      aSaveError := ecOK;

      {bpCollectPacket should now use aTimeoutTrigger for timer}
      bCurTimer := aTimeoutTrigger;
    end;
  end;

  procedure bpReceive(Msg, wParam : Cardinal;
                     lParam : LongInt);
    {-Perform one increment of a protocol receive}
  var
    TriggerID   : Cardinal absolute wParam;
    P           : PProtocolData;
    Finished    : Bool;
    C           : Char;
    I           : Integer;
    SaveSize    : LongInt;
    S           : String;
    StatusTicks : LongInt;
    Dispatcher      : TApdBaseDispatcher;
  begin

    {Get the protocol pointer from data pointer 1}
    Dispatcher := TApdBaseDispatcher(PortList[LH(lParam).H]);
    with Dispatcher do
      GetDataPointer(Pointer(P), 1);

    with P^ do begin
      {$IFDEF Win32}
      EnterCriticalSection(aProtSection);

      {Exit if protocol was cancelled while waiting for crit section}
      if bBPlusState = rbDone then begin
        LeaveCriticalSection(aProtSection);
        Exit;
      end;
      {$ENDIF}

      {Force TriggerID for TriggerAvail messages}
      if Msg = apw_TriggerAvail then
        TriggerID := aDataTrigger;

      repeat

        {Nothing to do if state is rbDone}
        if bBPlusState = rbDone then begin
          {$IFDEF Win32}
          LeaveCriticalSection(aProtSection);
          {$ENDIF}
          Exit;
        end;

        {Restore last status}
        aProtocolStatus := aSaveStatus;

        case aProtocolStatus of
          psCancelRequested,
          psFileRejected : ;
          else begin
            if Msg = apw_ProtocolCancel then begin
              if bBPlusState = rbWaitErrorAck then
                bBPlusState := rbCleanup
              else begin
                {Send failure packet}
                bpSendFailure(P, 'AAborted by user');
                aProtocolStatus := psCancelRequested;
                bBPlusState := rbError;
              end;
              aForceStatus := True;
            end else if Integer(TriggerID) = aNoCarrierTrigger then begin 
              bBPlusState := tbCleanup;
              aProtocolStatus := psAbortNoCarrier;
            end;
          end;
        end;

        {Show status at requested intervals and after significant events}
        if aForceStatus or (Integer(TriggerID) = aStatusTrigger) then begin 
          if aSaveError <> ecOK then
            aProtocolError := aSaveError;
          if Dispatcher.TimerTicksRemaining(aStatusTrigger,
                                  StatusTicks) <> 0 then
            StatusTicks := 0;
          if StatusTicks <= 0 then begin                              
            apShowStatus(P, 0);
            Dispatcher.SetTimerTrigger(aStatusTrigger, aStatusInterval, True);
            aForceStatus := False;
          end;
          if Integer(TriggerID) = aStatusTrigger then begin         
            {$IFDEF Win32}
            LeaveCriticalSection(aProtSection);
            {$ENDIF}
            Exit;
          end;
        end;

        {Main state processor}
        case bBPlusState of
          rbInitial :
            begin
              {apResetStatus(P);}
              aBlockNum := 0;
              aElapsedTicks := 0;
              aBlockErrors := 0;
              aTotalErrors := 0;
              apShowFirstStatus(P);

              {Start waiting for first packet}
              Dispatcher.SetTimerTrigger(aTimeoutTrigger, aHandshakeWait, True);
              aSaveError := ecOK;
              bBPlusState := rbGetDLE;
            end;

          rbGetDLE :
            if TriggerID = aDataTrigger then begin
              Dispatcher.GetChar(C);
              if C = cDLE then
                bBPlusState := rbGetB
            end else if Integer(TriggerID) = aTimeoutTrigger then  
              bBPlusState := rbSendEnq;

          rbGetB :
            if TriggerID = aDataTrigger then begin
              Dispatcher.GetChar(C);
              if C = 'B' then begin
                bBPlusState := rbCollectPacket;
                bNAKSent := False;
                bNextSeq := IncSequence(bSeqNum);
                aBlockErrors := 0;
                bPacketState := psGetSeq;
              end else
                bBPlusState := rbSendEnq;
            end else if Integer(TriggerID) = aTimeoutTrigger then  
              bBPlusState := rbSendEnq;

          rbCollectPacket :
            if TriggerID = aDataTrigger then begin
              if bpCollectPacket(P) then begin
                {Got a complete packet -- process it}
                if aProtocolError = ecOK then begin
                  aBlockErrors := 0;
                  bBPlusState := rbProcessPacket;
                  aForceStatus := True;
                end else begin
                  {Too many errors, let rbSendEnq handle}
                  bBPlusState := rbSendEnq;
                  Dispatcher.SetTimerTrigger(aTimeoutTrigger, aHandshakeWait, True);
                end;
              end;
            end else if Integer(TriggerID) = aTimeoutTrigger then begin
              {Timeout error, let rbSendEnq handle}
              bBPlusState := rbSendEnq;
              Dispatcher.SetTimerTrigger(aTimeoutTrigger, aHandshakeWait, True);
            end;

          rbProcessPacket :
            begin
              aForceStatus := True;
              case bLastType of
                'N':  {Next data packet, write it to file}
                  begin
                    {Call the write method to write this block}
                    bFailed := apWriteProtocolBlock(P,
                               PDataBlock(bRBuffer)^, bRSize-1);

                    {Process result}
                    if bFailed then begin
                      bpSendFailure(P, 'EWrite failure');
                      aForceStatus := True;
                      bBPlusState := rbError;
                    end else begin
                      Inc(aFileOfs, bRSize-1);
                      Dec(aBytesRemaining, bRSize-1);
                      Inc(aBytesTransferred, bRSize-1);
                      aElapsedTicks := ElapsedTime(aTimer);
                      bpSendAck(P);

                      {Prepare to get next packet}
                      bBPlusState := rbGetDLE;
                      NewTimer(aReplyTimer, aHandshakeWait);
                    end;
                  end;

                'T':     {Transfer control packet, process per second byte}
                  begin
                    case bRBuffer^[1] of
                      'C':   {Transfer Complete packet}
                        begin
                          apFinishWriting(P);
                          bpSendAck(P);
                          bBPlusState := rbCleanup;
                        end;

                      'I':   {Transfer Info packet, we only use FileSize field here}
                        begin
                          bpSendAck(P);
                          I := 4;
                          S := '';
                          while (I <= bRSize-1) and
                                (bRBuffer^[I] >= '0') and
                                (bRBuffer^[I] <= '9') do begin
                            S := S + bRBuffer^[I];
                            Inc(I);
                          end;
                          Val(S, aSrcFileLen, I);
                          if I <> 0 then
                            aSrcFileLen := 0;
                          aBytesRemaining :=
                            aSrcFileLen - aBytesTransferred;

                          {Get next packet}
                          bBPlusState := rbGetDLE;
                        end;

                      'f':   {Host bFailed Resume, rewrite the file}
                        begin
                          bpHandleResumeFail(P);
                          bBPlusState := rbGetDLE;
                        end;

                      else begin
                          {Unknown T packet type}
                          apProtocolError(P, ecProtocolError);
                          bpSendFailure(P, 'NInvalid T Packet');
                          bBPlusState := rbError;
                        end;
                    end;
                  end;

                'F':    {Failure packet, exit immediately}
                  begin
                    aProtocolStatus := psCancelRequested;
                    aForceStatus := True;
                    bpSendAck(P);
                    bBPlusState := rbCleanup;
                  end;
               else begin
                    {Unsupported packet type, exit immediately}
                    apProtocolError(P, ecProtocolError);
                    bpSendFailure(P, 'NUnknown packet type');
                    bBPlusState := rbError;
                  end;
              end;
            end;

          rbSendEnq :
            begin
              aProtocolStatus := psTimeout;
              Inc(aBlockErrors);
              Inc(aTotalErrors);
              if aBlockErrors > BPErrorMax then begin
                apProtocolError(P, ecTimeout);
                bpSendFailure(P, 'ATimeout');
                bBPlusState := rbError;
              end else
                bBPlusState := rbGetDLE;
            end;

          rbError :
            begin
              {Save failure status}
              aSaveError := aProtocolError;

              {Start waiting for acknowledgment (failure packet already sent)}
              bBPlusState := rbWaitErrorAck;
              bAckState := acGetDLE;
              NewTimer(aReplyTimer, aFinishWait);
            end;

          rbWaitErrorAck :
            if bpCollectAck(P) then begin
              aProtocolError := aSaveError;
              aForceStatus := True;
              bBPlusState := rbCleanup;
            end;

         rbCleanup :
            begin
              {Close file}
              SaveSize := aSrcFileLen;
              apFinishWriting(P);
              aSrcFileLen := SaveSize;

              {Log receive status}
              if aProtocolError <> ecOK then
                apLogFile(P, lfReceiveFail)
              else
                apLogFile(P, lfReceiveOK);

              apShowLastStatus(P);
              Dispatcher.FlushInBuffer;
              bBPlusState := rbDone;
              apSignalFinish(P);
            end;
        end;

        {Stay in state machine or exit}
        case bBPlusState of
          {Stay in state machine of more data ready}
          rbGetDLE,
          rbGetB,
          rbWaitErrorAck,
          rbCollectPacket      : Finished := not Dispatcher.CharReady;

          {Stay in state machine}
          rbFinished,
          rbCleanup,
          rbProcessPacket,
          rbSendEnq,
          rbError              : Finished := False;

          {Ex