awbplus.pas

测试用例

        Close(aWorkFile);
        if IOResult = 0 then ;

        {Change the file name if needed}
        if (Res = 0) and not bResumeFlag and not OvrW then begin
          S := StrPas(aPathName);
          Dir := ExtractFilePath(S);
          Name := ExtractFileName(S);
          Name[1] := '$';
          S := Dir + Name;
          StrPCopy(aPathName, S);
        end;

        {Give status a chance to show that the file was renamed}
        apShowStatus(P, 0);

        {Ok to rewrite file now}
        Assign(aWorkFile, aPathname);
        Rewrite(aWorkFile, 1);
        Res := IOResult;
        if Res <> 0 then begin
          apProtocolError(P, Res);
          goto ExitPoint;
        end;

        {Acknowledge the T packet}
        bpSendAck(P);

        {Initialized the buffer management vars}
        aInitFilePos := 0;
        aBytesTransferred := 0;
        aBytesRemaining := 0;
        aFileOfs := 0;
        aStartOfs := 0;
        aLastOfs := 0;
        aEndOfs := aStartOfs + FileBufferSize;
        aFileOpen := True;
        Exit;
      end;

ExitPoint:
      Close(aWorkFile);
      if IOResult <> 0 then ;
    end;
  end;

  procedure bpInitData(P : PProtocolData);
    {-Allocates and initializes a protocol control block with options}
  begin
    with P^ do begin
      aCurProtocol := BPlus;
      aCheckType := bcChecksum1;
      if aActCPS = 0 then
        DefBS := 8
      else case aActCPS of
        0..30   : DefBS := 1;
        31..120 : DefBS := 4;
        else      DefBS := 16;
      end;

      aFinishWait := BPDefFinishWait;
      aHandshakeWait := BPTimeoutMax;
      bQuotePending := False;
      bSentENQ := False;
      aTurnDelay := BPlusTurnDelay;
      aOverhead := BPlusOverHead;
      apResetReadWriteHooks(P);
      apPrepareWriting := bpPrepareWriting;
    end;
  end;

  function bpInit(var P : PProtocolData; H : TApdCustomComPort;
                  Options : Cardinal) : Integer;
    {-Allocates and initializes a protocol control block with options}
  var
    I : Cardinal;
  begin
    {Check for adequate output buffer size}
    if H.OutBuffUsed + H.OutBuffFree < 1024 then begin
      bpInit := ecOutputBufferTooSmall;
      Exit;
    end;

    {Allocate the protocol data record}
    if apInitProtocolData(P, H, Options) <> ecOK then begin
      bpInit := ecOutOfMemory;
      Exit;
    end;

    with P^ do begin
      aCurProtocol := BPlus;
      aCheckType := bcChecksum1;
      case aActCPS of
        0..30   : DefBS := 1;
        31..120 : DefBS := 4;
        else      DefBS := 16;
      end;

      bpInitData(P);

      {Allocate buffers}
      bRBuffer := AllocMem(BPBufferMax);
      I := 1;
      while (I <= BPSendAheadMax) do begin
        bSBuffer[I].Buf := Allocmem(BPBufferMax);
        Inc(I);
      end;
      bpInit := ecOK;
    end;
  end;

  function bpReinit(P : PProtocolData) : Integer;
    {-Allocates and initializes a protocol control block with options}
  var
    I : Cardinal;
  begin
    with P^ do begin
      aCurProtocol := BPlus;
      aCheckType := bcChecksum1;
      case aActCPS of
        0..30   : DefBS := 1;
        31..120 : DefBS := 4;
        else      DefBS := 16;
      end;

      bpInitData(P);

      {Allocate buffers}
      bRBuffer := AllocMem(BPBufferMax);
      I := 1;
      while (I <= BPSendAheadMax) do begin
        bSBuffer[I].Buf := AllocMem(BPBufferMax);
        Inc(I);
      end;
      bpReinit := ecOK;
    end;
  end;

  procedure bpDonePart(P : PProtocolData);
    {-Destroy the protocol object}
  var
    I : Cardinal;
  begin
    with P^ do begin
      for I := 1 to BPSendAheadMax do
        FreeMem(bSBuffer[I].Buf, BPBufferMax);
      FreeMem(bRBuffer, BPBufferMax);
    end;
  end;

  procedure bpDone(var P : PProtocolData);
    {-Destroy the protocol object}
  begin
    bpDonePart(P);
    apDoneProtocol(P);
  end;

  procedure bpUpdateQuoteTable(P : PProtocolData; QS : TQuoteArray);
    {-Update our bQuoteTable to match the QS quotearray}
  var
    I,J,K : Integer;
    B,C : Byte;
  begin
    with P^ do begin

      K := 0;
      C := $40;

      for I := 0 to 7 do begin
        if I = 4 then begin
          K := 128;
          C := $60;
        end;
        B := QS[I];

        for J := 0 to 7 do begin
          if (B and $80) <> 0 then
            bQuoteTable[K] := Char(C);
          B := B shl 1;
          Inc(C);
          Inc(K);
        end;
      end;
    end;
  end;

  procedure bpInitVars(P : PProtocolData);
    {-Init vars that need resetting each time a DLE is seen}
  begin
    with P^ do begin
      bNext2ACK  := 1;
      bNext2Fill := 1;
      bSAWaiting := 0;
      bSAMax     := 1;
      bAbortCount:= 0;
      aTotalErrors := 0;
      bResumeFlag := False;
    end;
  end;

  procedure bpResetProtocol(P : PProtocolData);
    {-Init important session-dependant protocol vars}
  begin
    with P^ do begin
      bSeqNum := 0;
      bSAMax := 1;
      bSAErrors := 0;
      aBlockLen := 512;
      bAbortCount := 0;
      bBPlusMode := False;
      aCheckType := bcChecksum1;
      FillChar(bQuoteTable, SizeOf(bQuoteTable), 0);
      FillChar(bOurParams, SizeOf(bOurParams), 0);
      bOurParams.BlkSize := 4;
      bOurParams.QuoteSet := DQDefault;
      bpUpdateQuoteTable(P, DQDefault);
    end;
  end;

  procedure bpSendTransportParams(P : PProtocolData);
    {-Send our params, collect ack}
  begin
    with P^ do begin
      {Some inits}
      bOurParams.QuoteSet := DQDefault;
      FillChar(bRBuffer^[bRSize+1], SizeOf(bRBuffer^)-bRSize, 0);

      {Save the host's params}
      Move(bRBuffer^[1], bHostParams.WinSend, 4);
      Move(bRBuffer^[7], bHostParams.QuoteSet, 11);

      {Send '+' packet under FULL quoting}
      bQSP := (bRSize >= 14);
      bpUpdateQuoteTable(P, DQFull);

      {Fill outgoing buffer}
      with bSBuffer[bNext2Fill] do begin
        Buf^[1] := Char(DefWS);
        Buf^[2] := Char(DefWR);
        Buf^[3] := Char(DefBS);
        Buf^[4] := Char(DefCM);
        Buf^[5] := Char(DefDQ);
        Buf^[6] := Char(DefXP);
        Move(bOurParams.QuoteSet, Buf^[7], 8);
        Buf^[15] := Char(DefDR);
        Buf^[16] := Char(DefUR);
        Buf^[17] := Char(DefFI);
      end;

      {Send the transport packet}
      bpSendPacket(P, '+', 17);
    end;
  end;

  procedure bpProcessTransportParams(P : PProtocolData);
    {-Process received "+" packet, send our params}
  begin
    with P^ do begin
      {Make a minimal set of parameters to work from}
      if bHostParams.WinSend < DefWR then
        bOurParams.WinSend := bHostParams.WinSend
      else
        bOurParams.WinSend := DefWR;

      {If > 0, we can use all windows}
      if bOurParams.WinSend <> 0 then
        bSAMax := BPSendAheadMax;

      if bHostParams.WinRecv < DefWS then
        bOurParams.WinRecv := bHostParams.WinRecv
      else
        bOurParams.WinRecv := DefWS;

      if bHostParams.BlkSize < DefBS then
        bOurParams.BlkSize := bHostParams.BlkSize
      else
        bOurParams.BlkSize := DefBS;

      if bOurParams.BlkSize = 0 then
        bOurParams.BlkSize := 4;
      aBlockLen := (bOurParams.BlkSize * 128);

      if bHostParams.ChkType < DefCM then
        bOurParams.ChkType := bHostParams.ChkType
      else
        bOurParams.ChkType := DefCM;

      {If = 1, we need CRC blockchecking}
      if bOurParams.ChkType > 0 then
        aCheckType := bcCrc16;

      if bHostParams.DROpt < DefDR then
        bOurParams.DROpt := bHostParams.DROpt
      else
        bOurParams.DROpt := DefDR;

      bOurParams.UROpt := DefUR;

      if bHostParams.FIOpt < DefFI then
        bOurParams.FIOpt := bHostParams.FIOpt
      else
        bOurParams.FIOpt := DefFI;

      FillChar(bQuoteTable, SizeOf(bQuoteTable), 0);
      bpUpdateQuoteTable(P, bOurParams.QuoteSet);
      if bQSP then
        bpUpdateQuoteTable(P, bHostParams.QuoteSet);
      bBPlusMode := True;
    end;
  end;

  procedure bpProcessFileTransferParams(P : PProtocolData);
    {-Extract Tranfer parameters}
  var
    I : Integer;                                                    
  begin
    with P^ do begin
      {Note bDirection}
      case bRBuffer^[1] of
        'D' : bDirection := dDownload;
        'U' : bDirection := dUpload;
        else begin
          bpSendFailure(P, 'NUnimplemented Transfer Function');
          apProtocolError(P, ecProtocolError);
        end;
      end;

      {Start timer now...}
      NewTimer(aTimer, 1);

      {Verify file type}
      if (bRBuffer^[2] <> 'A') and (bRBuffer^[2] <> 'B') then begin
        bpSendFailure(P, 'NUnimplemented File Type');
        apProtocolError(P, ecProtocolError);
      end;

      {Retrieve pathname}
      I := 2;
      while (bRBuffer^[I] <> #0) and
            (I < bRSize-1) and
            (I < SizeOf(TPathCharArray)) do begin
        Inc(I);
        if aUpcaseFileNames then
          aPathName[I-3] := Upcase(bRBuffer^[I]);
      end;
      aPathname[I-2] := #0;

      case bDirection of
        dUpload :
          begin
            apLogFile(P, lfTransmitStart);

            {Prepare to read file}
            apPrepareReading(P);
            if aProtocolError <> ecOK then begin
              {Send failure, ProcessDLE will collect ACK}
              bpSendFailure(P, 'AFile Error');
              apLogFile(P, lfTransmitFail);
              Exit;
            end;
            aFileOfs := 0;
          end;

        dDownLoad :
          begin
            apLogFile(P, lfReceiveStart);
            if not apAcceptFile(P, aPathname) then begin
              aProtocolStatus := psFileRejected;
              aForceStatus := True;

              {Send failure packet, ProcessDLE will collect ACK}
              bpSendFailure(P, 'AFile rejected');
              Exit;
            end;

            {Prepare to write file}
            apPrepareWriting(P);
            if (aProtocolStatus = psCantWriteFile) or
               (aProtocolError <> ecOK) then begin
              {Send failure packet, ProcessDLE will collect ACK}
              bpSendFailure(P, 'AAborted by user');
              apLogFile(P, lfReceiveFail);
              Exit;
            end;
          end;
      end;
    end;
  end;

  function bpProcessENQ(P : PProtocolData) : Integer;
    {-Called when the terminal handler receives an <ENQ>}
  begin
    with P^ do begin
      if aCurProtocol <> BPlus then
        bpProcessENQ := ecBadProtocolFunction
      else begin
        bAborting := False;
        bpResetProtocol(P);
        bpProcessENQ := aHC.ValidDispatcher.PutString(cDLE+'++'+cDLE+'0');
      end;
    end;
  end;

  function bpProcessESCI(P : PProtocolData; X, Y : Byte) : Integer;
    {-Called by terminal handler when <ESC><'I'> seen at port}
  var
    S : String;
    T : String[5];
    I : Integer;
  begin
    with P^ do begin
      if aCurProtocol <> BPlus then begin
        bpProcessESCI := ecBadProtocolFunction;
        Exit;
      end;

      S := ESCIResponse;

      {Make sure tailer is in place for later}
      if Pos(',+',S) = 0 then
        S := S + ',+';

      {If 'SSxx' part of string, insert screen size values}