awbplus.pas

测试用例

      I := Pos('SSxx',S);
      if I > 0 then begin
        S[I+2] := Chr(Y+31);
        S[I+3] := Chr(X+31);
      end;

      {Build the string's bChecksum and append it to the string}
      X := 0;
      for I := 1 to Length(S) do
        Inc(X, Ord(S[I]));
      Str(X, T);
      S := S + T;

      {Send the response}
      bpProcessESCI := aHC.ValidDispatcher.PutString(S+^M);
    end;
  end;

  function bpPrepareProcessDLE(P : PProtocolData;
                               var ATimerIndex : Cardinal) : Integer;
    {-Start <DLE> processing, returns timer index}
  begin
    with P^ do begin
      if aCurProtocol <> BPlus then begin
        bpPrepareProcessDLE := ecBadProtocolFunction;
        Exit;
      end;

      aProtocolStatus := psOK;
      aProtocolError := ecOK;
      bpPrepareProcessDLE := ecOK;
      bTermState := tpsWaitB;
      bTimerIndex := aHC.AddTimerTrigger;
      ATimerIndex := bTimerIndex;
      if bTimerIndex > 0 then begin
        aHC.SetTimerTrigger(bTimerIndex, aHandshakeWait, True);
        bCurTimer := bTimerIndex;
      end else
        bpPrepareProcessDLE := ATimerIndex;
    end;
  end;

  function bpProcessDLE(P : PProtocolData; IsData : Bool;
                        var Ready, Start, Upload : Bool) : Integer;
    {-Collects packets from terminal mode, return Ready True when complete}
  var
    Finished : Bool;
    Complete : Bool;
    C : Char;

  {$IFDEF VER90}
    {$DEFINE VER93}
  {$ENDIF}                                                  
  {$IFDEF VER93}
  procedure CheckTermState;
  begin
    case P^.bTermState of
    tpsError : Finished := False;
    else       if not Finished then
                 Finished := not P^.aHC.CharReady;
    end;
  end;
  {$ENDIF}

  begin
    with P^ do begin
      if aCurProtocol <> BPlus then begin
        bpProcessDLE := ecBadProtocolFunction;
        Exit;
      end;

      bpProcessDLE := ecOK;
      Start := False;
      Ready := False;

      {If data not ready this must be a timeout, set error state}
      if not IsData then
        bTermState := tpsError;

      {Process characters and timeouts}
      Finished := False;
      Complete := False;
      repeat
        case bTermState of
          tpsWaitB :
            begin
              aHC.ValidDispatcher.GetChar(C);
              case C of
                cDLE : {ignore} ;
                'B' : begin
                        aHC.SetTimerTrigger(bTimerIndex, aHandshakeWait, True);
                        bTermState := tpsWaitSeq;
                      end;
                else  bTermState := tpsError;
              end;
            end;

          tpsWaitSeq :
            begin
              {Get sequence byte...}
              aHC.ValidDispatcher.GetChar(C);
              if aCheckType = bcCrc16 then
                bChecksum := $FFFF
              else
                bChecksum := 0;
              UpdateBlockCheck(P, Byte(C));
              bTermState := tpsWaitType;
              bPacketNum := Ord(C)-Ord('0');
            end;

          tpsWaitType :
            begin
              aHC.ValidDispatcher.GetChar(C);
              case C of
                '+' :
                  begin
                    {Prepare to collect + packet}
                    bTermState := tpsCollectPlus;
                    bPacketState := psGetData;
                    bpInitVars(P);
                    bNextSeq := IncSequence(bSeqNum);
                    bIdx := 1;
                    UpdateBlockCheck(P, Byte('+'));
                  end;
                'T' :
                  begin
                    {Prepare to collect T packet}
                    bTermState := tpsCollectT;
                    bPacketState := psGetData;
                    bNextSeq := IncSequence(bSeqNum);
                    bIdx := 1;
                    UpdateBlockCheck(P, Byte('T'));
                  end;
                else
                  bTermState := tpsError;
              end;
            end;

          tpsCollectPlus :
            {Collect and process + packet, send our options}
            if bpCollectPacket(P) then begin
              {Got host options, send ours, prepare to wait for ACK}
              bpSendTransportParams(P);
              bTermState := tpsCollectAckPlus;
              bAckState := acGetDLE;
            end;

          tpsCollectAckPlus :
            if bpCollectAck(P) then begin
              {Got the ack from our params, now compare host's and ours}
              bpProcessTransportParams(P);
              Complete := True;
            end;

          tpsCollectT :
            if bpCollectPacket(P) then begin
              bpProcessFileTransferParams(P);
              if aProtocolError = ecOK then begin
                Complete := True;
                Start := True;
                Upload := bDirection = dUpload;
              end else begin
                Complete := True;
                bAckState := acGetDLE;
                bTermState := tpsCollectAckT;
              end;
            end;

          tpsCollectAckT :
            if bpCollectAck(P) then begin
              {Finished collecting failure ack, we're done}
              Complete := True;
              if aProtocolStatus = psHostResume then begin
                Start := True;
                Upload := bDirection = dUpload;
              end else
                bpProcessDLE := aProtocolError;
            end;

          tpsError :
            begin
              {Timeout getting char or unknown packet type}
              aHC.RemoveTrigger(bTimerIndex);
              Complete := True;
            end;
        end;

        {$IFDEF Ver93}
        CheckTermState;
        {$ELSE}
        {Stay in state machine if more data available}
        case bTermState of
          tpsError : Finished := False;
          else       if not Finished then
                       Finished := not aHC.CharReady;
        end;
        {$ENDIF}
      until Finished or Complete;

      if Complete then begin
        bTimerIndex := aTimeoutTrigger;
        Ready := True;
      end;
    end;
  end;

  {$IFDEF VER90}
    {$UNDEF VER93}
  {$ENDIF}            

  procedure bpHandleResumeFail(P : PProtocolData);
    {-Resume bFailed, rewrite the file}
  var
    Result : Cardinal;
    S      : string[fsPathname];
    Dir    : string[fsDirectory];
    Name   : string[fsName];
  begin
    with P^ do begin
      Close(aWorkFile);

      {If we default to Rename, rename the file}
      if aWriteFailOpt = wfcWriteRename then begin
        S := StrPas(aPathName);
        Dir := ExtractFilePath(S);
        Name := ExtractFileName(S);
        Name[1] := '$';
        S := Dir + Name;
        StrPCopy(aPathName, S);
        Assign(aWorkFile, aPathName);
        aProtocolStatus := psFileRenamed;
      end;

      {Otherwise just overwrite}
      Rewrite(aWorkFile, 1);
      Result := IoResult;
      if Result <> 0 then begin
        aFileOpen := False;
        apProtocolError(P, Result);
        apShowStatus(P, 0);
        bpSendFailure(P, 'CCannot create file');
        Exit;
      end;

      {Set status vars}
      aBytesTransferred := 0;
      aProtocolStatus := psResumeBad;
      apShowStatus(P, 0);
      bResumeFlag := False;
      bpSendAck(P);
      NewTimer(aTimer, 1);
      aFileOfs := 0;
      aInitFilePos := 0;
    end;
  end;

  procedure bpPrepareTransmit(P : PProtocolData);
    {-Prepare for a B+ transmit}
  begin
    with P^ do begin
      {Inits}
      bBPlusState := tbInitial;
      aProtocolError := ecOK;
      aSaveStatus := psOK;
      aSaveError := ecOK;

      {Reset status but make sure filesize doesn't get changed}
      Inc(aInProgress);
      apResetStatus(P);
      Dec(aInProgress);

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

  procedure bpTransmit(Msg, wParam : Cardinal;
                      lParam : LongInt);
    {-Perform one increment of a protocol transmit}
  var
    TriggerID   : Cardinal absolute wParam;
    P           : PProtocolData;
    Finished    : Bool;
    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 = tbDone then begin
        LeaveCriticalSection(aProtSection);
        Exit;
      end;
      {$ENDIF}

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

      repeat

        {Restore last status}
        aProtocolStatus := aSaveStatus;

        case aSaveStatus of
          psCancelRequested,
          psFileRejected : ;
          else begin
            if Msg = apw_ProtocolCancel then begin
              if bBPlusState = tbWaitErrorAck then
                bBPlusState := tbCleanup
              else begin
                {Send failure packet}
                bpSendFailure(P, 'AAborted by user');
                aProtocolStatus := psCancelRequested;
                aForceStatus := True;
                bBPlusState := tbError;
              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;
          aElapsedTicks := ElapsedTime(aTimer);
          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(P^.aProtSection);
            {$ENDIF}
            Exit;
          end;
        end;

        {Main state processor}
        case bBPlusState of
          tbInitial :
            begin
              apShowFirstStatus(P);
              Dispatcher.SetTimerTrigger(aTimeoutTrigger, aHandshakeWait, True);
              bBPlusState := tbGetBlock;
              aLastBlock := False;
            end;

          tbGetBlock :
            if aLastBlock then
              bBPlusState := tbEndOfFile
            else with bSBuffer[bNext2Fill] do begin
              if FlagIsSet(aFlags, apBP2KTransmit) then
                Num := aBlockLen
              else
                Num := 1024;
              aLastBlock := apReadProtocolBlock(P, PDataBlock(Buf)^, Num);
              if aProtocolError = ecOK then begin
                Inc(aFileOfs, Num);
                bBPlusState := tbWaitFreeSpace;
                Dispatcher.SetTimerTrigger(aTimeoutTrigger, aTransTimeout, True);
                Dispatcher.SetStatusTrigger(aOutBuffFreeTrigger, (Num*2)+10, True);
              end else begin
                bpSendFailure(P, 'EFile read failure');
                bBPlusState := tbError;
              end;
            end;

          tbWaitFreeSpace :
            if Integer(TriggerID) = aOutBuffFreeTrigger then
              bBPlusState := tbSendData
            else if Integer(TriggerID) = aTimeoutTrigger then begin 
              bpSendFailure(P, 'ETimeout waiting for output buffer space');
              bBPlusState := tbError;
            end else if TriggerID = aDataTrigger then begin
              if bpCollectAck(P) then begin
                if aProtocolError <> ecOK then begin
                  aForceStatus := True;
                  bpSendFailure(P, 'EToo many errors');
                  bBPlusState := tbError;
                end;
              end;
            end;

          tbSendData :
            with bSBuffer[bNext2Fill] do begin
              bpSendPacket(P, 'N', Num);
              aForceStatus := True;

              {if bSAWaiting = 1 then begin}
              Dispatcher.SetTimerTrigger(aTimeoutTrigger,
                               aHandshakeWait, True);
              bAckState := acGetDLE;
              {end;}
              bBPlusState := tbCheckAck;
            end;

          tbCheckAck :
            if (bSAWaiting < bSAMax) and not Dispatcher.CharReady then
              bBPlusState := tbGetBlock
            else if bpCollectAck(P) then begin
              if aProtocolError = ecOK then begin
                bBPlusState := tbGetBlock;
                Inc(aBytesTransferred, aLastBlockSize);
                Dec(aBytesRemaining, aLastBlockSize);
              end else begin
                aForceStatus := True;