⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 awbplus.pas

📁 测试用例
💻 PAS
📖 第 1 页 / 共 5 页
字号:
                bNAKSent := True;
                bpSendNAK(P);
              end;
              bPacketState := psGetDLE;
            end;

          psSuccess :
            begin
              if not bAborting then
                bSeqNum := bPacketNum;
              bResumeFlag := False;
              bRSize := bIdx;
              bpCollectPacket := True;
              Exit;
            end;

          psSendAck :
            begin
              if not bAborting then
                bpSendAck(P);
              bPacketState := psGetDLE;
            end;
        end;

        {Stay or exit?}
        case bPacketState of
          psCheckCheck, psSuccess, psError, psSendAck :
            Finished := False;
          else
            Finished := True;
        end;
      until Finished;
    end;
  end;

  function bpCollectAck(P : PProtocolData) : Bool;
    {-Collect acknowledgement to last packet}
  var
    I : Cardinal;
    SAIdx : Integer;
    C : Char;
    Finished : Bool;
  begin
    with P^ do begin
      bpCollectAck := False;

      repeat
        {Restart the character timer with each character}
        if aHC.CharReady and not bAborting then
          NewTimer(aReplyTimer, aHandshakeWait);

        if TimerExpired(aReplyTimer) and (bAckState <> acSendENQ) then
          bAckState := acTimeout;

        case bAckState of
          acGetDLE :
            if aHC.CharReady then begin
              aHC.ValidDispatcher.GetChar(C);
              case C of
                cDLE : bAckState := acGetNum;           {Potential ACK}
                cNAK : bAckState := acSendENQ;          {Packet error}
                cETX : bAckState := acSendNAK;          {Sequence problem}
              end;
            end;

          acGetNum :
            if aHC.CharReady then begin
              aHC.ValidDispatcher.GetChar(C);
              bSaveC := C;
              case C of
                '0'..'9' : bAckState := acHaveAck;     {Have ACK, check it}
                'B'      : if bAborting then
                             bAckState := acSkipPacket1
                           else
                             bAckState := acGetPacket;
                cNak     : bAckState := acSendEnq;
                ';'      : begin
                             aProtocolStatus := psWaitAck;
                             aForceStatus := True;
                             bAckState := acGetDLE;
                           end;
                else       bAckState := acGetDLE;
              end;
            end;

          acGetPacket :
            begin
              {Prepare to collect packet}
              bBPlusState := rbCollectPacket;
              aBlockErrors := 0;
              bPacketState := psGetSeq;
              bAckState := acCollectPacket;
            end;

          acCollectPacket :
            if aHC.CharReady then begin
              if bpCollectPacket(P) then begin
                {Got a complete packet -- finished here}
                if aProtocolStatus = psOK then begin
                  aBlockErrors := 0;
                  bpCollectAck := True;
                end else
                  {Error getting packet, retry}
                  bAckState := acGetDLE;
              end;
            end else if TimerExpired(aReplyTimer) then
              bAckState := acGetDLE;

          acSkipPacket1 :
            if aHC.CharReady then begin
              aHC.ValidDispatcher.GetChar(C);
              if C = cETX then begin
                bpGetCharQuoted(P, C);
                if bQuotePending then
                  bAckState := acSkipPacket2
                else if aCheckType = bcCrc16 then
                  bAckState := acSkipPacket3
                else
                  bAckState := acGetDLE;
              end;
            end;

          acSkipPacket2 : {Collect 2nd byte of 1st check byte}
            if aHC.CharReady then begin
              bpGetCharQuoted(P, C);
              bAckState := acSkipPacket3;
            end;

          acSkipPacket3 : {Collect 2nd check byte}
            if aHC.CharReady then begin
              bpGetCharQuoted(P, C);
              if bQuotePending then
                bAckState := acSkipPacket4
              else
                bAckState := acGetDLE;
            end;

          acSkipPacket4 : {Collect 2nd byte of 2st check byte}
            if aHC.CharReady then begin
              bpGetCharQuoted(P, C);
              bAckState := acGetDLE;
            end;

          acHaveACK :
             begin
              bPacketNum := Byte(bSaveC) - Byte('0');
              if Integer(bSBuffer[bNext2ACK].Seq) = bPacketNum then begin 
                {Expected ACK}
                aLastBlockSize := bSBuffer[bNext2ACK].Num;
                bNext2ACK := IncSA(P, bNext2ACK);
                Dec(bSAWaiting);
                if bSAErrors > 0 then
                  Dec(bSAErrors);
                bpCollectACK := True;
                bAckState := acGetDLE;
                Exit;
              end else if (Integer(bSBuffer[IncSA(P, bNext2ACK)].Seq) = bPacketNum) and
                          (bSAWaiting = 2) then begin
                {Missed ACK}
                apProtocolError(P, ecSequenceError);
                Dec(bSAWaiting, 2);

                {Inc twice to skip the miss}
                bNext2ACK := IncSA(P, bNext2ACK);
                bNext2ACK := IncSA(P, bNext2ACK);
                if bSAErrors > 0 then
                  Dec(bSAErrors);
                bpCollectACK := True;
                bAckState := acGetDLE;
                Exit;
              end else if Integer(bSBuffer[bNext2ACK].Seq) = IncSequence(bPacketNum) then begin
                if bSentENQ then
                  {Remote missed first packet}
                  bAckState := acSendData
                else
                  {Duplicate ACK}
                  bAckState := acGetDLE;
              end else begin
                if bAborting then
                  bAckState := acGetDLE
                else
                  bAckState := acTimeout;
              end;
              bSentENQ := False;
            end;

          acTimeout :
            begin
              apProtocolError(P, ecTimeout);
              aForceStatus := True;
              bAckState := acSendENQ;
              NewTimer(aReplyTimer, aHandshakeWait);
            end;

          acSendNAK :
            begin
              Inc(aBlockErrors);
              Inc(aTotalErrors);
              if (aBlockErrors > BPErrorMax) or bAborting then begin
                bpCollectAck := True;
                Exit;
              end;
              bpSendNAK(P);
              bAckState := acGetDLE;
            end;

          acResync1 :
            if aHC.CharReady then begin
              aHC.ValidDispatcher.GetChar(C);
              if C = cDLE then
                bAckState := acResync2
            end;

          acResync2 :
            if aHC.CharReady then begin
              aHC.ValidDispatcher.GetChar(C);
              case C of
                'B' : if bAborting then
                        bAckState := acSkipPacket1
                      else
                        bAckState := acGetPacket;
                '0'..'9' : bAckState := acResync3;
              end;
            end;

          acResync3 :
            if aHC.CharReady then begin
              aHC.ValidDispatcher.GetChar(C);
              if C = cDLE then
                bAckState := acResync4
            end;

          acResync4 :
            if aHC.CharReady then begin
              aHC.ValidDispatcher.GetChar(C);
              case C of
                'B' : if bAborting then
                        bAckState := acSkipPacket1
                      else
                        bAckState := acGetPacket;
                '0'..'9' : bAckState := acHaveAck;
              end;
            end;

          acSendENQ :
            begin
              Inc(aBlockErrors);
              Inc(aTotalErrors);
              if (aBlockErrors > BPErrorMax) or bAborting then begin
                apProtocolError(P, ecTooManyErrors);
                bpCollectACK := True;
                Exit;
              end;

              SendByte(P, cENQ);
              SendByte(P, cENQ);
              bAckState := acResync1;
              bSentENQ := True;
            end;

          acSendData :
            begin
              Inc(bSAErrors, 3);
              if bSAErrors >= 12 then
                {If too many SA errors, cease SendAhead}
                bSAMax := 1;

              {Flush all pending packets to send}
              SAIdx := bNext2ACK;
              for I := 1 to bSAWaiting do begin
                bpSendData(P, SAIdx);
                SAIdx := IncSA(P, SAIdx);
              end;
              bSentENQ := False;
              bAckState := acGetDLE;
            end;

          acFailed :
            begin
              bpCollectAck := True;
              bAckState := acGetDLE;
            end;
        end;

        {Stay or exit}
        case bAckState of
          acGetPacket,
          acHaveAck,
          acTimeout,
          acSendNak,
          acSendEnq,
          acSendData,
          acFailed : Finished := False;
          else       Finished := True;
        end;
      until Finished;
    end;
  end;

  procedure bpPrepareWriting(P : PProtocolData);
    {-Opens a file to receive, handles resume/overwrite request}
  label
    ExitPoint;
  var
    {$IFDEF Win32}
    Res    : DWORD;
    {$ELSE}
    Res    : Integer;
    {$ENDIF}                                                       
    OvrW   : Bool;
    ET     : EventTimer;
    I      : Integer;
    F      : LongInt;
    S      : string[fsPathname];
    Dir    : string[fsDirectory];
    Name   : string[fsName];
  begin
    with P^ do begin
      {Allocate a file buffer}
      aFileBuffer := AllocMem(FileBufferSize);

      {Inits}
      bResumeFlag := False;
      aFileOpen := False;
      OvrW := False;

      {Does the file exist already?}
      Assign(aWorkFile, aPathName);
      Reset(aWorkFile, 1);
      Res := IOResult;

      {Exit on errors other than FileNotFound}
      if (Res <> 0) and (Res <> 2) then begin
        apProtocolError(P, Res);
        goto ExitPoint;
      end;

      {If file exists process potential resume}
      if Res = 0 then begin
        {$IFDEF Win32}
        aWriteFailOpt := Cardinal(SendMessageTimeout(
                              aHWindow, apw_ProtocolResume,
                              aWriteFailOpt, LongInt(P),
                              SMTO_ABORTIFHUNG + SMTO_BLOCK,
                              1000, Res));
        {$ELSE}
        aWriteFailOpt := Cardinal(SendMessage(aHWindow, apw_ProtocolResume,
                                         aWriteFailOpt, LongInt(P)));
        {$ENDIF}
        case aWriteFailOpt of
          wfcWriteFail :
            begin
              aProtocolStatus := psCantWriteFile;
              aProtocolError := psCantWriteFile;
              aForceStatus := True;
              goto ExitPoint;
            end;
          wfcWriteResume :
            bResumeFlag := True;
          wfcWriteNone,
          wfcWriteRename :
            aProtocolStatus := psFileRenamed;
          wfcWriteAnyway :
            OvrW := True;
        end;
      end;

      if bResumeFlag then begin
        {Calculate CRC on existing file's contents}
        aProtocolStatus := psTryResume;
        apShowStatus(P, 0);
        NewTimer(ET, 1);
        F := FileSize(aWorkFile);

        with bSBuffer[bNext2Fill] do begin
          Seek(aWorkFile, 0);
          bChecksum := $FFFF;
          repeat
            BlockRead(aWorkFile,Buf^[1], 512, Res);
            for I := 1 to (Res) do
              UpdateBlockCheck(P, Byte(Buf^[I]));
            if ElapsedTimeInSecs(ET) >= 10 then begin
              {Send WACK so host knows we're busy}
              NewTimer(ET, 1);
              SendByte(P, cDLE);
              SendByte(P, ';');
              aProtocolStatus := psTryResume;
              apShowStatus(P, 0);
            end;
          until (Res = 0) or (IOResult <> 0);

          {Send the host a "Tr" packet with our info}
          FillChar(Buf^, SizeOf(Buf^), 0);
          Buf^[1] := 'r';

          {Send filesize and CRC}
          S := IntToStr(F) + ' ' + IntToStr(bChecksum) + ' ';
          Move(S[1], Buf^[2], Length(S));
          bpSendPacket(P, 'T', Length(S)+1);

          {Ack will get collected by next state in ProcessDLE}

          {Assume resuming....}
          aProtocolStatus := psHostResume;
          apShowStatus(P, 0);
          aFileOfs := F;
          aBytesTransferred := F;
          aBytesRemaining := aSrcFileLen - aBytesTransferred;
          aInitFilePos := F;
          aStartOfs := F;
          aLastOfs := F;
          aEndOfs := aStartOfs + FileBufferSize;

          Seek(aWorkFile, F);
          aSaveError := IoResult;
          if aSaveError <> 0 then begin
            apProtocolError(P, aSaveError);
            goto ExitPoint;
          end;
          aFileOpen := True;
          Exit;
        end;
      end else begin

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -