awascii.pas

测试用例

                 {Exit;}
               {end;}

          ^M : if sCRTransMode = atAddLFAfter then begin
                 aHC.PutString(^M^J);
                 Inc(aBytesTransferred, 2);
                 Dec(aBytesRemaining, 2);
               end else if sCRTransMode <> atStrip then
                 SendChar(^M);

          ^J : if sLFTransMode = atAddCRBefore then begin
                 aHC.PutString(^M^J);
                 Inc(aBytesTransferred, 2);
                 Dec(aBytesRemaining, 2);
               end else if sLFTransMode <> atStrip then
                 SendChar(^J);

           else begin                                                  
                  if C = atEOFMarker then begin                        
                    if FlagIsSet(aFlags, apAsciiSuppressCtrlZ) then begin 
                      spSendBlockPart := True;                         
                      Exit;                                            
                    end;                                               
                  end else                                             
                    SendChar(C);
                end;                                                   
        end;

        {Check for interline delay}
        if (C = sEOLChar) and (sInterLineDelay > 0) then begin
          if sInterLineDelay + AccumDelay < sMaxAccumDelay then
            Inc(AccumDelay, DelayMS(sInterLineDelay))
          else begin
            aHC.SetTimerTrigger(aTimeoutTrigger, sInterLineTicks, True);
            sAsciiState := taSendDelay;
            Exit;
          end;
        end;

        {Check for interchar delay}
        if sInterCharDelay > 0 then begin
          if sInterCharDelay + AccumDelay < sMaxAccumDelay then
            Inc(AccumDelay, DelayMS(sInterCharDelay))
          else begin
            aHC.SetTimerTrigger(aTimeoutTrigger, sInterCharTicks, True);
            sAsciiState := taSendDelay;
            Exit;
          end;
        end;

        {Set Finished flag}
        Finished := (sSendIndex >= aLastBlockSize) or
                    (AccumDelay > sMaxAccumDelay);
      end;

      {End of block if we get here}
      spSendBlockPart := True;
    end;
  end;

  function apCollectBlock(P : PProtocolData; var Block : TDataBlock) : Boolean;
    {-Collect received data into aDataBlock, return True for full block}
    {-Note: may go one past BlockLen}
  var
    C : Char;
    GotEOFMarker : Boolean;                                            

    procedure AddChar(C : Char);
      {-Add C to buffer}
    begin
      with P^ do begin
        Inc(aBlkIndex);
        Block[aBlkIndex] := C;
      end;
    end;

  begin
    with P^ do begin
      apCollectBlock := False;
      GotEOFMarker := False;                                           
      while aHC.CharReady and (aBlkIndex < aBlockLen) do begin

        {Start the protocol timer if first time thru}
        if aTimerPending then begin
          aTimerPending := False;
          NewTimer(aTimer, 0);
        end;

        {Get the char}
        aHC.ValidDispatcher.GetChar(C);

        {Character translations}
        case C of
          ^M : if sCRTransMode = atAddLFAfter then begin
                 AddChar(^M);
                 AddChar(^J);
               end else if sCRTransMode <> atStrip then
                 AddChar(^M);

          ^J : if sLFTransMode = atAddCRBefore then begin
                 AddChar(^M);
                 AddChar(^J);
               end else if sCRTransMode <> atStrip then
                 AddChar(^J);

          {^Z : begin}                                                 
                 {GotEOFMarker := True;}                               
                 {if not FlagIsSet(aFlags, apAsciiSuppressCtrlZ) then} 
                   {AddChar(^Z);}                                      
               {end;}                                                  

          else begin                                                   
                 if C = atEOFMarker then begin                         
                   GotEOFMarker := True;                               
                   if not FlagIsSet(aFlags, apAsciiSuppressCtrlZ) then 
                     AddChar(atEOFMarker);                             
                 end else                                              
                   AddChar(C);
               end;                                                    
        end;
        apCollectBlock := (aBlkIndex >= aBlockLen) or (GotEOFMarker);  
      end;
    end;
  end;

  procedure apReceiveBlock(P : PProtocolData; var Block : TDataBlock;
                           var BlockSize : Cardinal; var HandShake : Char);
    {-Receive block into Buffer}
  var
    I : Cardinal;
  begin
    with P^ do begin
      {Check for ^Z}
      I := 1;
      while (I < BlockSize) and not sCtrlZEncountered do begin
        if Block[I] = atEOFMarker then begin                           
          BlockSize := I;
          sCtrlZEncountered := True;
        end else
          Inc(I);
      end;

      {Update data areas and show status}
      Inc(aBytesTransferred, BlockSize);
      aElapsedTicks := ElapsedTime(aTimer);
    end;
  end;

  procedure spPrepareTransmit(P : PProtocolData);
    {-Prepare for transmitting ASCII}
  begin
    with P^ do begin
      aFindingFirst := True;
      aFileListIndex := 0;
      apResetStatus(P);
      apShowFirstStatus(P);
      if not apNextFile(P, aPathname) then begin
        apShowLastStatus(P);
        Exit;
      end;

      sCtrlZEncountered := False;
      aBlockNum := 0;
      aForceStatus := True;
      sAsciiState := taInitial;
      aProtocolError := ecOK;
      aNoMoreData := False;
    end;
  end;

  procedure spTransmit(Msg, wParam : Cardinal;
                     lParam : LongInt);
    {-Performs one increment of an ASCII transmit}
  var
    TriggerID   : Cardinal absolute wParam;
    P           : PProtocolData;
    Finished    : Boolean;
    StatusTicks : LongInt;                                        
    Dispatcher      : TApdBaseDispatcher;
  begin
    Finished := False;                                                 {!!.01}
    {Get the protocol pointer from data pointer 1}
    try                                                                {!!.01}
      Dispatcher := TApdBaseDispatcher(PortList[LH(lParam).H]);
      with Dispatcher do
        GetDataPointer(Pointer(P), 1);
    except                                                             {!!.01}
      on EAccessViolation do begin                                     {!!.01}
        { There is no access to P^, and consequently to the port, }    {!!.01}
        { the TApdProtocol componenet handle, or anything else, so }   {!!.01}
        { the only thing to do here is exit }                          {!!.01}
        Exit;
      end;                                                             {!!.01}
    end;                                                               {!!.01}

    with P^ do begin
      {Function result is always zero unless the protocol is over}

      {$IFDEF Win32}
      EnterCriticalSection(aProtSection);

      {Exit if protocol was cancelled while waiting for crit section}
      if sAsciiState = taDone then begin
        LeaveCriticalSection(aProtSection);
        Exit;
      end;
      {$ENDIF}
        {Force TriggerID for TriggerAvail messages}
        if Msg = apw_TriggerAvail then
          TriggerID := aDataTrigger;

        repeat
          try                                                          {!!.01}
            if Dispatcher.Logging then
              Dispatcher.AddDispatchEntry(
                dtAscii,LogAsciiState[sAsciiState],0,nil,0);

            {Check for user or remote abort}
            if (Integer(TriggerID) = aNoCarrierTrigger) or
               (Msg = apw_ProtocolCancel) then begin
              if Integer(TriggerID) = aNoCarrierTrigger then
                aProtocolStatus := psAbortNoCarrier
              else
                aProtocolStatus := psCancelRequested;
              spCancel(P);
              sAsciiState := taFinished;
              aForceStatus := False;
            end;

            if (Integer(TriggerID) = aStatusTrigger) or aForceStatus then begin
              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;                                                         
            end;

            {Process current state}
            case sAsciiState of
              taInitial :
                begin
                  {Pathname must already be set before we get here}
                  if aUpcaseFileNames then
                    AnsiUpper(aPathname);

                  {Show file name to user logging routine}
                  apLogFile(P, lfTransmitStart);

                  {Go prepare for reading protocol blocks}
                  apPrepareReading(P);
                  if aProtocolError = ecOK then begin
                    sAsciiState := taGetBlock;
                    Dispatcher.SetTimerTrigger(aTimeoutTrigger, aTransTimeout, True);
                  end else
                    sAsciiState := taFinished;
                  NewTimer(aTimer, 1);
                end;

              taGetBlock :
                begin
                  aLastBlockSize := aBlockLen;
                  aNoMoreData := apReadProtocolBlock(P, aDataBlock^, aLastBlockSize);
                  if (aProtocolError = ecOK) and (aLastBlockSize <> 0) then begin
                    sAsciiState := taWaitFreespace;
                    sSendIndex := 0;
                    Dispatcher.SetTimerTrigger(aTimeoutTrigger, aTransTimeout, True);
                    Dispatcher.SetStatusTrigger(aOutBuffFreeTrigger, aBlockLen+1, True);
                  end else
                    sAsciiState := taFinished;
                end;

              taWaitFreeSpace :
                if Integer(TriggerID) = aOutBuffFreeTrigger then
                  sAsciiState := taSendBlock
                else if Integer(TriggerID) = aTimeoutTrigger then       
                  sAsciiState := taFinished;

              taSendBlock :
                if spSendBlockPart(P, aDataBlock^) then begin
                  {Adjust block number and file position}
                  Inc(aBlockNum);
                  Inc(aFileOfs, aBlockLen);

                  {Go get next block to send}
                  if aNoMoreData then begin