awzmodem.pas

Async Professional 4.04

    with P^ do begin
      FreeMem(aDataBlock, ZMaxBlock[zUse8KBlocks]);
      FreeMem(zWorkBlock, ZMaxWork[zUse8KBlocks]);
    end;
  end;

  function zpAllocBuffers(P : PProtocolData) : Bool;
  begin
    with P^ do begin
      aDataBlock := nil;
      zWorkBlock := nil;
      aDataBlock := AllocMem(ZMaxBlock[zUse8KBlocks]);
      zWorkBlock := AllocMem(ZMaxWork[zUse8KBlocks]);
      zpAllocBuffers := True;
    end;
  end;

  procedure zpInitData(P : PProtocolData);
    {-Init the protocol data}
{$IFDEF TRIALRUN}
  {$I TRIAL04.INC}
{$ENDIF}
  begin
{$IFDEF TRIALRUN}
  TC;
{$ENDIF}
    with P^ do begin
      {Init this object's fields}
      aCurProtocol := Zmodem;
      aBatchProtocol := True;
      aFileOpen := False;
      aFileOfs := 0;
      aRcvTimeout := DefReceiveTimeout;
      aCheckType := bcCrc32;
      aSrcFileDate := 0;
      aBlockLen := ZMaxBlock[zUse8KBlocks];
      aOverhead := ZmodemOverhead;
      aTurnDelay := ZmodemTurnDelay;
      aFinishWait := DefFinishWaitZM;
      aHandshakeWait := MaxHandshakeWait;
      apResetReadWriteHooks(P);
      apPrepareWriting := zpPrepareWriting;
      apFinishWriting := zpFinishWriting;
      FillChar(zAttentionStr, MaxAttentionLen, 0);
      zLastFileOfs := 0;
      zUseCrc32 := True;
      zCanCrc32 := True;
      zReceiverRecover := False;
      zFileMgmtOpts := zfWriteNewer;
      zFileMgmtOverride := False;
      zTookHit := False;
      zGoodAfterBad := 0;
      zEscapePending := False;
      zHexPending := False;
      zFinishRetry := DefFinishRetry;
      zEscapeAll := False;
    end;
  end;

  function zpInit(var P : PProtocolData;
                  H : TApdCustomComPort;
                  Options : Cardinal) : Integer;
    {-Allocates and initializes a protocol control block with options}
  const
    MinSize : array[Boolean] of Cardinal = (2048+30, 16384+30);     
  var
    InSize, OutSize : Cardinal;
  begin
    {Check for adequate output buffer size}
    H.ValidDispatcher.BufferSizes(InSize, OutSize);
    if OutSize < MinSize[FlagIsSet(Options, apZmodem8K)] then begin
      zpInit := ecOutputBufferTooSmall;
      Exit;
    end;

    {Allocate protocol record, init base data}
    if apInitProtocolData(P, H, Options) <> ecOk then begin
      zpInit := ecOutOfMemory;
      Exit;
    end;

    with P^ do begin
      {Allocate data blocks}
      zUse8KBlocks := FlagIsSet(Options, apZmodem8K);
      if not zpAllocBuffers(P) then begin
        zpInit := ecOutOfMemory;
        zpDone(P);
        Exit;
      end;

      {Can't fail after this}
      zpInit := ecOK;

      {Init the data}
      zpInitData(P);
    end;
  end;

  function zpReinit(P : PProtocolData) : Integer;
    {-Allocates and init just the Zmodem stuff}
  begin
    with P^ do begin
      {Allocate data blocks}
      zUse8KBlocks := False;
      if not zpAllocBuffers(P) then begin
        zpReinit := ecOutOfMemory;
        zpDone(P);
        Exit;
      end;

      {Can't fail after this}
      zpReinit := ecOK;

      {Init the data}
      zpInitData(P);
    end;
  end;

  procedure zpDone(var P : PProtocolData);
    {-Dispose of Zmodem}
  begin
    zpDeallocBuffers(P);
    apDoneProtocol(P);
  end;

  procedure zpDonePart(P : PProtocolData);
    {-Dispose of just the Zmodem stuff}
  begin
    zpDeallocBuffers(P);
  end;

  function zpSetFileMgmtOptions(P : PProtocolData;
                                 Override, SkipNoFile : Bool;
                                 FOpt : Byte) : Integer;
    {-Set file mgmt options to use when sender doesn't specify}
  const
    SkipMask : array[Boolean] of Byte = ($00, $80);                
  begin
    with P^ do begin
      if aCurProtocol <> Zmodem then begin
        zpSetFileMgmtOptions := ecBadProtocolFunction;
        Exit;
      end;

      zpSetFileMgmtOptions := ecOK;
      zFileMgmtOverride := Override;
      zFileMgmtOpts := (FOpt and FileMgmtMask) or SkipMask[SkipNoFile];
    end;
  end;

  function zpSetRecoverOption(P : PProtocolData; OnOff : Bool) : Integer;
    {-Turn file recovery on (will be ignored if dest file doesn't exist)}
  begin
    with P^ do begin
      if aCurProtocol <> Zmodem then
        zpSetRecoverOption := ecBadProtocolFunction
      else begin
        zpSetRecoverOption := ecOK;
        zReceiverRecover := OnOff;
      end;
    end;
  end;

  function zpSetBigSubpacketOption(P : PProtocolData;
                                   UseBig : Bool) : Integer;
    {-Turn on/off 8K subpacket support}
  begin
    zpSetBigSubpacketOption := ecOk;
    with P^ do begin
      if aCurProtocol <> Zmodem then
        zpSetBigSubpacketOption := ecBadProtocolFunction
      else if UseBig <> zUse8KBlocks then begin
        {Changing block sizes, get rid of old buffers}
        zpDeallocBuffers(P);

        {Set new size and allocate buffers}
        if UseBig then
          aFlags := aFlags or apZmodem8K
        else
          aFlags := aFlags and not apZmodem8K;
        zUse8KBlocks := UseBig;
        if not zpAllocBuffers(P) then begin
          zpSetBigSubpacketOption := ecOutOfMemory;
          Exit;
        end;
        aBlockLen := ZMaxBlock[zUse8KBlocks];
      end;
    end;
  end;

  function zpSetZmodemFinishWait(P : PProtocolData;
                                 NewWait : Cardinal;
                                 NewRetry : Byte) : Integer;
    {-Set new finish wait and retry values}
  begin
    with P^ do begin
      if aCurProtocol <> Zmodem then
        zpSetZmodemFinishWait := ecBadProtocolFunction
      else begin
        zpSetZmodemFinishWait := ecOK;
        if aFinishWait <> 0 then
          aFinishWait := NewWait;
        zFinishRetry := NewRetry;
      end;
    end;
  end;

  procedure zpPutCharEscaped(P : PProtocolData; C : Char);
    {-Transmit with C with escaping as required}
  var
    C1 : Char;
    C2 : Char;
  begin
    with P^ do begin
      {Check for chars to escape}
      if zEscapeAll and ((Byte(C) and $60) = 0) then begin
        {Definitely needs escaping}
        aHC.PutChar(ZDle);
        zLastChar := Char(Byte(C) xor $40);
      end else if (Byte(C) and $11) = 0 then
        {No escaping, just send it}
        zLastChar := C
      else begin
        {Might need escaping}
        C1 := Char(Byte(C) and $7F);
        C2 := Char(Byte(zLastChar) and $7F);
        case C of
          cXon, cXoff, cDle,        {Escaped control chars}
          cXonHi, cXoffHi, cDleHi,  {Escaped hibit control chars}
          ZDle :                    {Escape the escape char}
            begin
              aHC.PutChar(ZDle);
              zLastChar := Char(Byte(C) xor $40);
            end;
          else
            if ((C1 = cCR) and (C2 = #$40)) then begin
              aHC.PutChar(ZDle);
              zLastChar := Char(Byte(C) xor $40);
            end else
              zLastChar := C;
        end;
      end;
      aHC.PutChar(zLastChar);
    end;
  end;

  procedure zpUpdateBlockCheck(P : PProtocolData; CurByte: Byte);
    {-Updates the block check character (whatever it is)}
  begin
    with P^ do
      if zUseCrc32 then
        aBlockCheck := apUpdateCrc32(CurByte, aBlockCheck)
      else
        aBlockCheck := apUpdateCrc(CurByte, aBlockCheck);
  end;

  procedure zpSendBlockCheck(P : PProtocolData);
    {-Makes final adjustment and sends the aBlockCheck character}
  type
    QB = array[1..4] of char;
  var
    I : Byte;
  begin
    with P^ do
      if zUseCrc32 then begin
        {Complete and send a 32 bit CRC}
        aBlockCheck := not aBlockCheck;
        for I := 1 to 4 do
          zpPutCharEscaped(P, QB(aBlockCheck)[I]);
      end else begin
        {Complete and send a 16 bit CRC}
        zpUpdateBlockCheck(P, 0);
        zpUpdateBlockCheck(P, 0);
        zpPutCharEscaped(P, Char(Hi(aBlockCheck)));
        zpPutCharEscaped(P, Char(Lo(aBlockCheck)));
      end;
  end;

  function zpVerifyBlockCheck(P : PProtocolData) : Bool;
    {-checks the block check value}
  begin
    with P^ do begin
      {Assume a block check error}
      zpVerifyBlockCheck := False;

      if zUseCrc32 then begin
        if aBlockCheck <> $DEBB20E3 then
          Exit
      end else begin
        zpUpdateBlockCheck(P, 0);
        zpUpdateBlockCheck(P, 0);
        if aBlockCheck <> 0 then
          Exit;
      end;

      {If we get here, the block check value is ok}
      zpVerifyBlockCheck := True;
    end;
  end;

  procedure zpCancel(P : PProtocolData);
    {-Sends the cancel string}
  const
    {Cancel string is 8 CANs followed by 8 Backspaces}
    CancelStr : array[0..16] of Char =
      #24#24#24#24#24#24#24#24#8#8#8#8#8#8#8#8#0;
  var
    TotalOverhead : Cardinal;
    OutBuff : Cardinal;
  begin
    with P^ do begin
      if aHC.Open then begin                                           
        {Flush anything that might be left in the output buffer}
        OutBuff := aHC.OutBuffUsed;
        if OutBuff > aBlockLen then begin
          TotalOverhead := aOverhead * (OutBuff div aBlockLen);
          Dec(aBytesTransferred, Outbuff - TotalOverhead);
        end;
        aHC.FlushOutBuffer;

        {Send the cancel string}
        aHC.PutBlock(CancelStr, StrLen(CancelStr));
      end;                                                             
      aProtocolStatus := psCancelRequested;
      aForceStatus := True;
    end;
  end;

  function zpGotCancel(P : PProtocolData) : Bool;
    {-Return True if CanCount >= 5}
  begin
    with P^ do begin
      Inc(zCanCount);
      if zCanCount >= 5 then begin
        aProtocolStatus := psCancelRequested;
        aForceStatus := True;
        zpGotCancel := True;
      end else
        zpGotCancel := False;
    end;
  end;

  function zpGetCharStripped(P : PProtocolData; var C : Char) : Bool;
    {-Get next char, strip hibit, discard Xon/Xoff, return False for no char}
  begin
    with P^ do begin
      {Get a character, discard Xon and Xoff}
      repeat
        if aHC.CharReady then
          aHC.ValidDispatcher.GetChar(C)
        else begin
          zpGetCharStripped := False;
          Exit;
        end;
      until (C <> cXon) and (C <> cXoff);

      {Strip the high-order bit}
      C := Char(Ord(C) and Ord(#$7F));

      {Handle cancels}
      if (C = cCan) then begin
        if zpGotCancel(P) then begin
          zpGetCharStripped := False;
          Exit
        end;
      end else
        zCanCount := 0;
    end;
    zpGetCharStripped := True;
  end;

  procedure zpPutAttentionString(P : PProtocolData);
    {-Puts a string (#221 = Break, #222 = Delay)}
  var
    I  : Cardinal;
  begin
    with P^ do begin
      I := 1;
      while zAttentionStr[I] <> 0 do begin
        case zAttentionStr[I] of
          $DD : {Remote wants Break as his attention signal}