awkermit.pas

测试用例

    Check : Cardinal;
    C : Char;
  begin
    with P^ do begin
      if kCheckKnown then
        kTempCheck := kKermitOptions.Check
      else
        kTempCheck := '1';

      case kTempCheck of
        '1' : {Standard 1 byte checksum}
          begin
            {Add bits 6,7 into 0-5}
            Check := Lo(aBlockCheck);
            C := ToChar(Char((Check + (Check shr 6)) and $3F));
            aHC.PutChar(C);
          end;
        '2' : {2 byte checksum}
          begin
            {1st byte has bits 11-6, second has bits 5-0}
            Check := aBlockCheck;
            C := ToChar(Char((Check shr 6) and $3F));
            aHC.PutChar(C);
            C := ToChar(Char(Check and $3F));
            aHC.PutChar(C);
          end;
        '3' : {2 byte CRC}
          begin
            Check := kBlockCheck2;
            C := ToChar(Char((Check shr 12) and $0F));
            aHC.PutChar(C);
            C := ToChar(Char((Check shr 6) and $3F));
            aHC.PutChar(C);;
            C := ToChar(Char(Check and $3F));
            aHC.PutChar(C);
          end;
      end;
    end;
  end;

  procedure kpPutToChar(P : PProtocolData; C : Char);
    {-Put a promoted character}
  begin
    with P^ do
      aHC.PutChar(ToChar(C));
  end;

  procedure kpPutHeader(P : PProtocolData; HType : Char; Len : Cardinal);
    {-Start a header}
  var
    I : Byte;
  begin
    with P^ do begin
      {Init the block check character}
      aBlockCheck := 0;
      kBlockCheck2 := 0;

      {Send the Mark, Len, Seq and Type fields}
      aHC.PutChar(cSoh);
      if Len <= 94 then begin
        kpPutToChar(P, Char(Len));
        kpPutToChar(P, Char(aBlockNum));
        aHC.PutChar(HType);
        kpUpdateBlockCheck(P, Byte(ToChar(Char(Len))));
        kpUpdateBlockCheck(P, Byte(ToChar(Char(aBlockNum))));
        kpUpdateBlockCheck(P, Byte(HType));
      end else begin
        {Adjust Len to long packet specification}
        Dec(Len, 2);

        {Send Len, Seq and Type fields}
        kpPutToChar(P, #0);
        kpPutToChar(P, Char(aBlockNum));
        aHC.PutChar(HType);

        {Update header check}
        I := 32;
        Inc(I, Ord(ToChar(Char(aBlockNum))));
        Inc(I, Ord(HType));

        {Send Lenx1 and Lenx2, update header checksum}
        kpPutToChar(P, Char(Len div 95));
        Inc(I, Ord(ToChar(Char(Len div 95))));
        kpPutToChar(P, Char(Len mod 95));
        Inc(I, Ord(ToChar(Char(Len mod 95))));
        I := (I + (I shr 6)) and $3F;

        {Send the header checksum}
        kpPutToChar(P, Char(I));

        {Update regular block check}
        kpUpdateBlockCheck(P, Byte(ToChar(#0)));
        kpUpdateBlockCheck(P, Byte(ToChar(Char(aBlockNum))));
        kpUpdateBlockCheck(P, Byte(HType));
        kpUpdateBlockCheck(P, Byte(ToChar(Char(Len div 95))));
        kpUpdateBlockCheck(P, Byte(ToChar(Char(Len mod 95))));
        kpUpdateBlockCheck(P, Byte(ToChar(Char(I))));
      end;

      {Note what block number needs an Ack}
      kExpectedAck := aBlockNum;
    end;
  end;

  procedure kpTransmitBlock(P : PProtocolData;
                          var Block : TDataBlock;
                          BLen : Cardinal;
                          BType : Char);
      {-Transmits one data subpacket from Block}
  var
    I : Cardinal;
  begin
    with P^ do begin
      if BLen = 0 then
        Exit;

      {Send the data field}
      aHC.PutBlock(Block, BLen);
      for I := 1 to BLen do
        kpUpdateBlockCheck(P, Byte(Block[I]));
    end;
  end;

  procedure kpSendTerminator(P : PProtocolData);
    {-Send the terminator and padding chars}
  begin
    with P^ do
      aHC.PutChar(kKermitOptions.Terminator);
  end;

  procedure kpSendPacket(P : PProtocolData; PT : Char);
    {-Send a packet of type PT}
  const
    CheckLen : array[1..3] of Byte = (3, 4, 5);
  var
    TotalLen : Cardinal;
    I : Byte;
  begin
    with P^ do begin
      {Put required padding}
      with kKermitOptions do
        for I := 1 to PadCount do
          aHC.PutChar(PadChar);

      {Calc total length}
      TotalLen := kDataLen + CheckLen[(Byte(kKermitOptions.Check)-$30)];

      {Send the header...}
      kpPutHeader(P, PT, TotalLen);

      {Send the data field}
      kpTransmitBlock(P, aDataBlock^, kDataLen, PT);

      {Finish up}
      kpSendBlockCheck(P);
      kpSendTerminator(P);
    end;
  end;

  procedure kpSendError(P : PProtocolData; Msg : String);
    {-Send error packet}
  begin
    with P^ do begin
      aBlockNum := Inc64(aBlockNum);
      kDataLen := Length(Msg);
      Move(Msg[1], aDataBlock^[1], kDataLen);
      kpSendPacket(P, KError);
    end;
  end;

  procedure kpCancel(P : PProtocolData);
    {-Sends the cancel string}
  const
    AckLen : array[1..3] of Byte = (3, 4, 5);
  var
    B : Byte;
  begin
    with P^ do begin
      if aHC.Open then begin                                           
        if FastAbort then
          {Abort by sending error packet (old method)}
          kpSendError(P, eCancel)

        else if kReceiveInProgress then begin
          {Abort by sending 'Z' in data field of Ack packet (new method)}
          B := AckLen[Byte(kKermitOptions.Check)-$30];
          aDataBlock^[1] := 'Z';
          kpPutHeader(P, KAck, B+1);
          kpTransmitBlock(P, aDataBlock^, 1, KAck);
          kpSendBlockCheck(P);
          kpSendTerminator(P);

        end else begin
          {Abort by sending EOF packet with 'D' in data field (new method)}
          kDataLen := 1;
          aDataBlock^[1] := DiscardChar;
          aBlockNum := Inc64(aBlockNum);
          kpSendPacket(P, KEndOfFile);
        end;
      end;                                                             
      
      {Show cancel to status}
      aProtocolStatus := psCancelRequested;
    end;
  end;

  procedure kpResetStatus(P : PProtocolData);
    {-Typical reset but aBlockNum must _not_ be reset during protocol}
  begin
    with P^ do begin
      if aInProgress = 0 then begin
        {New protocol, reset status vars}
        aBytesRemaining := 0;
        aBlockNum := 0;
      end;
      aProtocolError := ecOK;
      aProtocolStatus := psOK;
      aSrcFileLen := 0;
      aBytesTransferred := 0;
      aElapsedTicks := 0;
      aBlockErrors := 0;
      aTotalErrors := 0;
    end;
  end;

  procedure kpGetDataChar(P : PProtocolData;
                          var C : Char;
                          var TableIndex : Cardinal;
                          var RepeatCnt : Cardinal);
    {-Get C from kDataTable handling all prefixing}
  var
    Finished : Bool;
    CtlChar : Bool;
    HibitChar : Bool;
    Repeating : Bool;
  begin
    with P^ do begin
      Finished := False;
      CtlChar := False;
      HibitChar := False;
      Repeating := False;
      RepeatCnt := 1;

      with kKermitOptions do
        repeat
          C := kDataTable^[TableIndex];
          Inc(TableIndex);

          {Set flags according to the char received}
          if (C = HibitPrefix) and (kUsingHibit) and (not HibitChar) then begin
            if (CtlChar) then
              Exit;
            HibitChar := True;
          end else if C = CtlPrefix then begin
            if CtlChar then begin
              if HibitChar then
                C := Chr(Byte(C) or $80);
              Exit;
            end else
              {Note that the next char is Ctl escaped}
              CtlChar := True;
          end else if (C = RepeatPrefix) and (kUsingRepeat and not Repeating) then begin
            if CtlChar then begin
              {process as ctl char}
              if HibitChar then
                C := Chr(Byte(C) or $80);
              Exit;
            end else begin
              {Repeat flag set, get the count}
              C := kDataTable^[TableIndex];
              Inc(TableIndex);
              Repeating := True;
              RepeatCnt := Byte(UnChar(C));
            end;
          end else begin
            {Normal character}
            Finished := True;

            if (HibitChar and kUsingHibit) then
              C := Char(Byte(C) or $80);

            if CtlChar then
              {Don't escape normal or hibit Prefix characters}
              if (C = Char(Byte(CtlPrefix) or $80)) or
                 (kUsingRepeat and (C = Char(Byte(RepeatPrefix) or $80))) or
                 (kUsingHibit and (C = Char(Byte(HibitPrefix) or $80))) or
                 (C = RepeatPrefix) then
                {do nothing}
              else
                {Ok to Ctl it}
                C := Ctl(C);
          end;
        until Finished;
    end;
  end;

  procedure kpCheckForHeader(P : PProtocolData);
    {-Checks for a header}
  const
    CheckLen : array[1..3] of Byte = (3, 4, 5);
  var
    C : Char;
  begin
    with P^ do begin
      {Assume no header ready}
      aProtocolStatus := psNoHeader;

      {If continuing a previous header we need to restore aBlockCheck}
      if kKermitHeaderState <> hskNone then begin
        aBlockCheck := kSaveCheck;
        kBlockCheck2 := kSaveCheck2;
      end;

      {Process potential header characters}
      while kpCharReady(P) and (kKermitHeaderState <> hskDone) do begin
        C := kpGetChar(P);

        if C = cSoh then
          kKermitHeaderState := hskNone;

        case kKermitHeaderState of
          hskNone :
            if C = cSoh then begin
              kKermitHeaderState := hskGotMark;
              aBlockCheck := 0;
              kBlockCheck2 := 0;
              kLongCheck := 32;
            end;
          hskGotMark :
            begin
              kKermitHeaderState := hskGotLen;
              kpUpdateBlockCheck(P, Byte(C));
              C := UnChar(C);
              kGetLong := (C = #0);
              kRecDataLen := Ord(C); 
            end;
          hskGotLen :
            begin
              kKermitHeaderState := hskGotSeq;
              kpUpdateBlockCheck(P, Byte(C));
              Inc(kLongCheck, Byte(C));
              C := UnChar(C);
              kRecBlockNum := Ord(C);
            end;
          hskGotSeq :
            begin
              kPacketType := C;
              kpUpdateBlockCheck(P, Byte(C));
              Inc(kLongCheck, Byte(C));
              if kGetLong then
                kKermitHeaderState := hskGotType
              else
                kKermitHeaderState := hskDone;
            end;
          hskGotType :
            begin
              kKermitHeaderState := hskGotLong1;
              kpUpdateBlockCheck(P, Byte(C));
              Inc(kLongCheck, Byte(C));
              C := UnChar(C);
              kRecDataLen := Cardinal(C)*95;
            end;
          hskGotLong1 :
            begin
              kKermitHeaderState := hskGotLong2;
              kpUpdateBlockCheck(P, Byte(C));
              Inc(kLongCheck, Byte(C));
              C := UnChar(C);
              Inc(kRecDataLen, Byte(C));
            end;
          hskGotLong2 :
            begin
              kKermitHeaderState := hskDone;
              kLongCheck := (kLongCheck + (kLongCheck shr 6)) and $3F;
              kpUpdateBlockCheck(P, Byte(C));
              C := UnChar(C);
              if C = Char(kLongCheck) then
                aProtocolStatus := psBlockCheckError;
              Inc(kRecDataLen, 2);
            end;
        end;
      end;

      if kKermitHeaderState = hskDone then begin
        {Say we got a header}
        aProtocolStatus := psGotHeader;

        {Account for other extra bytes in length}
        if kCheckKnown then
          Dec(kRecDataLen, (CheckLen[Byte(kKermitOptions.Check)-$30]))
        else
          Dec(kRecDataLen, (CheckLen[1]));
        if Integer(kRecDataLen) < 0 then
          kRecDataLen := 0;
      end else begin
        {Say no header ready}
        aProtocolStatus := psNoHeader;
        kSaveCheck := aBlockCheck;
        kSaveCheck2 := kBlockCheck2;
      end;
    end;
  end;

  function kpNextSeq(P : PProtocolData; I : Integer) : Integer;
    {-Increment I to next slot, accounting for current table size}
  begin
    with P^ do begin
      Inc(I);
      if I > Integer(kTableSize) then                              
        I := 1;
      kpNextSeq := I;
    end;