awkermit.pas

测试用例

        aCheckType := CheckVal[Byte(Check)-$30];
      end;

      {Allocate data and work blocks}
      aDataBlock := AllocMem(SizeOf(TDataBlock));
      kWorkBlock := AllocMem(SizeOf(TDataBlock));

      {Allocate table for data blocks}
      kpAllocateWindowTable(P);

    end;

    {All okay}
    kpInit := ecOK;
  end;

  function kpReinit(P : PProtocolData) : Integer;
    {-Allocates and initializes a protocol control block with options}
  begin
    with P^ do begin
      aDataBlock := nil;
      kWorkBlock := nil;
      kDataTable := nil;

      kpRawInit(P);

      apFinishWriting := kpFinishWriting;
      kKermitOptions := DefKermitOptions;
      with kKermitOptions do begin
        if MaxLongPacketLen = 0 then
          aBlockLen := MaxPacketLen
        else
          aBlockLen := MaxLongPacketLen;
        if WindowSize = 0 then
          kTableSize := 1
        else
          kTableSize := WindowSize;
        aCheckType := CheckVal[Byte(Check)-$30];
      end;

      {Allocate data and work blocks}
      aDataBlock := AllocMem(SizeOf(TDataBlock));
      kWorkBlock := AllocMem(SizeOf(TDataBlock));

      {Allocate table for data blocks}
      kpAllocateWindowTable(P);

      {Allocate internal buffer }
      kInBuff := AllocMem(SizeOf(TInBuffer));
      kInBuffHead := 1;
      kInBuffTail := 1;                                             
    end;

    {All okay}
    kpReinit := ecOK;
  end;

  procedure kpDonePart(P : PProtocolData);
    {-Disposes of Kermit protocol record}
  begin
    with P^ do begin
      kpDeallocateWindowTable(P);
      FreeMem(aDataBlock, SizeOf(TDataBlock));
      FreeMem(kWorkBlock, SizeOf(TDataBlock));
      if kInBuff <> nil then begin
        FreeMem(kInBuff, SizeOf(TInBuffer));
        kInBuff := nil;
      end;                                                        
    end;
  end;

  procedure kpDone(var P : PProtocolData);
    {-Disposes of Kermit protocol record}
  begin
    with P^ do begin
      kpDonePart(P);
      apDoneProtocol(P);
    end;
  end;

  function kpSetKermitOptions(P : PProtocolData;
                              KOptions : TKermitOptions) : Integer;
    {-Update the KermitProtocol object to use KOptions}
  begin
    with P^ do begin
      if aCurProtocol <> Kermit then begin
        kpSetKermitOptions := ecBadProtocolFunction;
        Exit;
      end;

      kKermitOptions := KOptions;
      aCheckType := CheckVal[Byte(kKermitOptions.Check)-$30];
      kpSetKermitOptions := ecOk;
      {Check for errors}
    end;
  end;

  function kpSetMaxPacketLen(P : PProtocolData; MaxLen : Byte) : Integer;
    {-Set the maximum packet length}
  begin
    with P^ do begin
      if aCurProtocol <> Kermit then begin
        kpSetMaxPacketLen := ecBadProtocolFunction;
        Exit;
      end;

      if MaxLen > 94 then
        kpSetMaxPacketLen := ecBadArgument
      else begin
        kpSetMaxPacketLen := ecOk;
        kKermitOptions.MaxPacketLen := MaxLen;
      end;
    end;
  end;

  function kpSetMaxLongPacketLen(P : PProtocolData; MaxLen : Cardinal) : Integer;
    {-Set the maximum packet length}
  begin
    with P^ do begin
      if aCurProtocol <> Kermit then begin
        kpSetMaxLongPacketLen := ecBadProtocolFunction;
        Exit;
      end;

      if MaxLen > 1024 then begin
        kpSetMaxLongPacketLen := ecBadArgument;
        Exit;
      end;

      {Assume success}
      kpSetMaxLongPacketLen := ecOK;

      {Deallocate current table}
      kpDeallocateWindowTable(P);

      if MaxLen > 0 then begin
        SetFlag(aFlags, apKermitLongPackets);
        with kKermitOptions do begin
          CapabilitiesMask := CapabilitiesMask or LongPackets;
          MaxLongPacketLen := MaxLen;
          aBlockLen := MaxLen;
          if kKermitOptions.Check = '1' then
            kKermitOptions.Check := '2';
        end;
      end else begin
        ClearFlag(aFlags, apKermitLongPackets);
        with kKermitOptions do begin
          CapabilitiesMask := CapabilitiesMask and not LongPackets;
          MaxLongPacketLen := 0;
        end;
        aBlockLen := 80;
      end;

      {Reallocate table}
      kpAllocateWindowTable(P);
    end;
  end;

  function kpSetMaxWindows(P : PProtocolData; MaxNum : Byte) : Integer;
    {-Set the number of windows for SWC}
  begin
    with P^ do begin
      if aCurProtocol <> Kermit then begin
        kpSetMaxWindows := ecBadProtocolFunction;
        Exit;
      end;

      if MaxNum > MaxWindowSlots then begin
        kpSetMaxWindows := ecBadArgument;
        Exit;
      end;

      {Assume success}
      kpSetMaxWindows := ecOK;

      {Deallocate current table}
      kpDeallocateWindowTable(P);

      if MaxNum > 0 then begin
        SetFlag(aFlags, apKermitSWC);
        with kKermitOptions do begin
          CapabilitiesMask := CapabilitiesMask or SlidingWindows;
          WindowSize := MaxNum and $1F;
          kTableSize := WindowSize;
        end;
      end else begin
        ClearFlag(aFlags, apKermitSWC);
        with kKermitOptions do begin
          CapabilitiesMask := CapabilitiesMask and not SlidingWindows;
          WindowSize := 0;
        end;
        kTableSize := 1;
      end;

      {Reallocate current table}
      kpAllocateWindowTable(P);
    end;
  end;

  function kpSetSWCTurnDelay(P : PProtocolData; TrnDelay : Cardinal) : Integer;
  begin
    with P^ do
      if aCurProtocol <> Kermit then
        kpSetSWCTurnDelay := ecBadProtocolFunction
      else begin
        kpSetSWCTurnDelay := ecOK;
        kSWCTurnDelay := TrnDelay;
      end;
  end;

  function kpGetSWCSize(P : PProtocolData) : Byte;
    {-Return size of current window (0 if not in use)}
  begin
    with P^ do
      if aCurProtocol <> Kermit then
        kpGetSWCSize := 0
      else
        kpGetSWCSize := kKermitOptions.WindowSize;
  end;

  function kpGetLPStatus(P : PProtocolData;
                         var InUse : Bool;
                         var PacketSize : Cardinal) : Integer;
    {-Return status of long packet feature}
  begin
    with P^ do begin
      if aCurProtocol <> Kermit then
        kpGetLPStatus := ecBadProtocolFunction
      else begin
        kpGetLPStatus := ecOK;
        InUse := kLPInUse;
        if InUse then
          PacketSize := kKermitOptions.MaxLongPacketLen
        else
          PacketSize := 0;
      end;
    end;
  end;

  function kpSetMaxTimeoutSecs(P : PProtocolData; MaxTimeout : Byte) : Integer;
    {-Set the maximum time to wait for a packet}
  begin
    with P^ do
      if aCurProtocol <> Kermit then
        kpSetMaxTimeoutSecs := ecBadProtocolFunction
      else begin
        kpSetMaxTimeoutSecs := ecOK;
        kKermitOptions.MaxTimeout := MaxTimeout;
      end;
  end;

  function kpSetPacketPadding(P : PProtocolData;
                              C : Char;
                              Count : Byte) : Integer;
    {-Set the pad character and count}
  begin
    with P^, kKermitOptions do begin
      if aCurProtocol <> Kermit then
        kpSetPacketPadding := ecBadProtocolFunction
      else begin
        kpSetPacketPadding := ecOK;
        PadChar := C;
        PadCount := Count;
      end;
    end;
  end;

  function kpSetTerminator(P : PProtocolData; C : Char) : Integer;
    {-Set the packet terminator}
  begin
    with P^ do
      if aCurProtocol <> Kermit then
        kpSetTerminator := ecBadProtocolFunction
      else begin
        kpSetTerminator := ecOK;
        kKermitOptions.Terminator := C;
      end;
  end;

  function kpSetCtlPrefix(P : PProtocolData; C : Char) : Integer;
    {-Set the control character quote prefix}
  begin
    with P^ do
      if aCurProtocol <> Kermit then
        kpSetCtlPrefix := ecBadProtocolFunction
      else begin
        kpSetCtlPrefix := ecOK;
        kKermitOptions.CtlPrefix := C;
      end;
  end;

  function kpSetHibitPrefix(P : PProtocolData; C : Char) : Integer;
    {-Set the hibit quote prefix}
  begin
    with P^ do
      if aCurProtocol <> Kermit then
        kpSetHibitPrefix := ecBadProtocolFunction
      else begin
        kpSetHibitPrefix := ecOK;
        kKermitOptions.HibitPrefix := C;
      end;
  end;

  function kpSetRepeatPrefix(P : PProtocolData; C : Char) : Integer;
    {-Set the repeat quote prefix}
  begin
    with P^ do
      if aCurProtocol <> Kermit then
        kpSetRepeatPrefix := ecBadProtocolFunction
      else begin
        kpSetRepeatPrefix := ecOK;
        kKermitOptions.RepeatPrefix := C;
      end;
  end;

  function kpSetKermitCheck(P : PProtocolData; CType : Byte) : Integer;
    {-Set the block check type (bcCheckSum1 (default), bcCheckSum2, bcCrcK)}
  begin
    with P^ do begin
      if aCurProtocol <> Kermit then begin
        kpSetKermitCheck := ecBadProtocolFunction;
        Exit;
      end;

      kpSetKermitCheck := ecOk;
      with kKermitOptions do begin
        case CType of
          bcCheckSum1 : Check := '1';
          bcCheckSum2 : Check := '2';
          bcCrcK      : Check := '3';
          else
            begin
              kpSetKermitCheck := ecBadArgument;
              Check := '1';
            end;
        end;
      end;
      aCheckType := CheckVal[Byte(kKermitOptions.Check)-$30];
    end;
  end;

  { Buffer management methods }
  function kpCharReady(P : PProtocolData) : Boolean;
  begin
    with P^ do
      Result := kInBuffHead < kInBuffTail;
  end;

  function kpGetChar(P : PProtocolData) : Char;
  begin
    with P^ do begin
      inc(kInBuffHead);
      Result := KInBuff^[kInBuffHead];
      if kInBuffHead >= kInBuffTail then begin
        kInBuffHead := 1;
        kInBuffTail := 1;
      end;                                                             
    end;                                                               
  end;                                                                 

  procedure kpCompactInBuff(P : PProtocolData);                        
  var                                                                  
    TempBuffer : PInBuffer;                                            
  begin                                                                
    with P^ do begin                                                   
      TempBuffer := AllocMem(SizeOf(TInBuffer));                       
      FillChar(TempBuffer^, SizeOf(TInBuffer), #0);                    
      Move(kInBuff^[kInBuffHead], TempBuffer^[1],                      
        kInBuffTail - kInBuffHead);                                    
      Move(TempBuffer^[1], kInBuff^[1], SizeOf(TInBuffer));            
      kInBuffTail := kInBuffTail - kInBuffHead + 1;                    
      kInBuffHead := 1;                                                
      FreeMem(TempBuffer, SizeOf(TInBuffer));                          
    end;                                                               
  end;                                                                 

  procedure kpFillInBuff(P : PProtocolData);                           
  begin                                                                
    with P^ do begin                                                   
      while aHC.ValidDispatcher.CharReady do begin                     
        inc(kInBuffTail);                                              
        kInBuff^[kInBuffTail] := aHC.GetChar;                          
        if kInBuffHead > (SizeOf(kInBuff^) div 2) then                 
          kpCompactInBuff(P);                                          
      end;                                                             
    end;                                                               
  end;                                                                 

  procedure kpFlushInBuffer(P : PProtocolData);                        
  begin                                                                
    with P^ do begin                                                   
      aHC.ValidDispatcher.FlushInBuffer;                               
      kInBuffHead := 1;                                                
      kInBuffTail := 1;                                                
    end;                                                               
  end;                                                                 

  procedure kpUpdateBlockCheck(P : PProtocolData; CurByte: Byte);
    {-Updates the block check character (whatever it is)}
  begin
    with P^ do begin
      {Do checksums if requested or check type not known}
      aBlockCheck := apUpdateCheckSum(CurByte, aBlockCheck);

      {Do crc if requested or check type not known}
      kBlockCheck2 := apUpdateCrcKermit(CurByte, kBlockCheck2);
    end;
  end;

  procedure kpSendBlockCheck(P : PProtocolData);
    {-Makes final adjustment and sends the aBlockCheck character}
  var