awxmodem.pas

Async Professional 4.04

      end;
      if R1 <> Lo(aBlockNum) then begin
        {Its a sequence error}
        xpCancel(P);
        aProtocolStatus := psSequenceError;
        apProtocolError(P, ecSequenceError);
        Exit;
      end;

      {Block is ok}
      Handshake := cAck;

      {Update status fields for the next call to the user status routine}
      Inc(aBlockNum);
      Inc(aBytesTransferred, aBlockLen);
      Dec(aBytesRemaining, aBlockLen);
      if aBytesRemaining < 0 then
        aBytesRemaining := 0;
      aBlockErrors := 0;
      aProtocolError := ecOK;
      aProtocolStatus := psOK;
      aForceStatus := True;
      BlockSize := aBlockLen;
    end;
  end;

  procedure xpPrepareTransmit(P : PProtocolData);
    {-Prepare for transmitting Xmodem}
  begin
    with P^ do begin
      {Inits}
      apResetStatus(P);
      apShowFirstStatus(P);

      {Get the file to transmit}
      if not apNextFile(P, aPathname) then begin
        {aProtocolError already set}
        apShowLastStatus(P);
        Exit;
      end;

      {Other inits}
      aTimerStarted := False;
      aForceStatus := True;
      xXmodemState := txInitial;
      aDataBlock := nil;

      {Discard any unread data}
      aHC.FlushInBuffer;
    end;
  end;

  function xpTransmitPrim(Msg, wParam : Cardinal;
                      lParam : LongInt) : LongInt;
    {-Perform one increment of an Xmodem transmit}
  var
    TriggerID   : Cardinal absolute wParam;
    P           : PProtocolData;
    Wait        : Cardinal;
    BufSize     : Cardinal;
    Finished    : Bool;
    C           : Char;
    StatusTicks : LongInt;
    ValidDispatcher      : TApdBaseDispatcher;

    procedure PrepSendBlock;
      {-Prepare to (re)send the current block}
    begin
      with P^ do begin
        aProtocolError := ecOK;
        {Don't waste time if the buffer space is available}
        if (aHC.OutBuffFree >= (aBlockLen+XmodemOverhead)) then
          xXmodemState := txSendBlock
        else begin
          xXmodemState := txWaitFreespace;
          aHC.SetTimerTrigger(aTimeoutTrigger, aTransTimeout, True);
          aHC.SetStatusTrigger(aOutBuffFreeTrigger,
                            aBlockLen+XmodemOverhead, True);
        end;                                                          
      end;
    end;

  begin
    Result := 0;                                                       {!!.01}  
    Finished := False;                                                 {!!.01}  
    {Get the protocol pointer from data pointer 1}
    ValidDispatcher := TApdBaseDispatcher(PortList[LH(lParam).H]);
    {with TApdBaseDispatcher(PortList[LH(lParam).H]) do{    ComPorts[LH(lParam).H] do}
    with ValidDispatcher do begin
      try                                                              {!!.01}
        ValidDispatcher.GetDataPointer(Pointer(P), ProtocolDataPtr);
      except                                                           {!!.01}
        on EAccessViolation do begin                                   {!!.01}
        { No access to P^ so just exit }                               {!!.01}
        Exit;                                                          {!!.01}
      end;                                                             {!!.01}
    end;                                                               {!!.01}

    with P^ do begin
      {Function result is always zero unless the protocol is over}
      Result := 0;

      {$IFDEF Win32}
      EnterCriticalSection(aProtSection);

      {Exit if protocol was cancelled while waiting for crit section}
      if xXmodemState = txDone then begin
        LeaveCriticalSection(aProtSection);
        Result := 1;
        Exit;
      end;
      {$ENDIF}

        {If it's a TriggerAvail message then force the TriggerID}
        if Msg = apw_TriggerAvail then
          TriggerID := aDataTrigger;

        repeat
          try                                                          {!!.01}
            if ValidDispatcher.Logging then
              ValidDispatcher.AddDispatchEntry(
                dtXModem,LogXModemState[xXmodemState],0,nil,0);

            {Check for user or remote abort}
            if ((Integer(TriggerID) = aNoCarrierTrigger) and
              not aHC.ValidDispatcher.CheckDCD) or
              (Msg = apw_ProtocolCancel) then begin
              if Msg = apw_ProtocolCancel then begin
                xpCancel(P);
                aProtocolStatus := psCancelRequested;
              end else
                aProtocolStatus := psAbortNoCarrier;
              xXmodemState := txFinished;
              aForceStatus := True;
            end;

            {Show status periodically}
            if (Integer(TriggerID) = aStatusTrigger) or aForceStatus then begin
              if aTimerStarted then
                aElapsedTicks := ElapsedTime(aTimer);
              if ValidDispatcher.TimerTicksRemaining(aStatusTrigger,
                                      StatusTicks) <> 0 then
                StatusTicks := 0;
              if StatusTicks <= 0 then begin
                apShowStatus(P, 0);
                aHC.SetTimerTrigger(aStatusTrigger, aStatusInterval, True);
                aForceStatus := False;
              end;
            end;

            {Process current state}
            case xXmodemState of
              txInitial :
                begin
                  {Get a protocol DataBlock}
                  aDataBlock := AllocMem(SizeOf(TDataBlock));

                  {Upcase the pathname}
                  if aUpcaseFileNames then
                    AnsiUpper(aPathname);

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

                  {Show handshaking in progress}
                  aProtocolStatus := psProtocolHandshake;
                  aForceStatus := True;

                  {Prepare to read protocol blocks}
                  apPrepareReading(P);
                  if aProtocolError = ecOK then begin
                    {Set the first block number}
                    aBlockNum := 1;

                    {Check for handshake character}
                    xXmodemState := txHandshake;
                    aHandshakeAttempt := 0;
                    if not xpPrepHandshake(P) then
                      xXmodemState := txFinished;
                  end else
                    xXmodemState := txFinished;
                end;

              txHandshake :
                if TriggerID = aDataTrigger then begin
                  if xpProcessHandshake(P) then begin
                    {Start protocol timer now}
                    NewTimer(aTimer, 1);
                    aTimerStarted := True;
                    xXmodemState := txGetBlock;
                    aFileOfs := 0;
                    aBlockErrors := 0;
                    aTotalErrors := 0;
                    if xGMode then
                      xMaxBlockErrors := 0;
                    aProtocolStatus := psOK;
                  end else begin
                    if aProtocolStatus = psCancelRequested then
                      xXmodemState := txFinished
                    else if not xpPrepHandshake(P) then
                      xXmodemState := txFinished
                  end;
                end else if Integer(TriggerID) = aTimeoutTrigger then
                  if not xpPrepHandshake(P) then
                    xXmodemState := txFinished;

              txGetBlock :
                begin
                  aLastBlockSize := aBlockLen;
                  aBlockErrors := 0;
                  aNoMoreData := apReadProtocolBlock(P, aDataBlock^, aLastBlockSize);
                  PrepSendBlock;
                end;

              txWaitFreeSpace :
                if Integer(TriggerID) = aOutBuffFreeTrigger then
                  {Got enough free space, go send the block}
                  xXmodemState := txSendBlock
                else if Integer(TriggerID) = aTimeoutTrigger then begin   
                  {Never got adequate free space, can't continue}
                  apProtocolError(P, ecTimeout);
                  xXmodemState := txFinished;
                end else if (TriggerID = aDataTrigger) and xGMode then
                  {In G mode, cancels could show up here}
                  while aHC.CharReady do begin
                    aHC.ValidDispatcher.GetChar(C);
                    if (C = cCan) then begin
                      aProtocolStatus := psCancelRequested;
                      aForceStatus := True;
                      xXmodemState := txFinished;
                      break;
                    end;
                  end;

              txSendBlock :
                if aLastBlockSize <= 0 then
                  {Don't send empty blocks}
                  xXmodemState := txFirstEndOfTransmit
                else begin
                  {If no errors, then send this block to the remote}
                  if aProtocolError = ecOK then begin
                    xpTransmitBlock(P, aDataBlock^, aBlockLen, ' ');

                    {If TransmitBlock failed, go clean up}
                    if aProtocolError <> ecOK then begin
                      FlushOutBuffer;
                      xXmodemState := txFinished;
                    end else                                            

                      {Prepare to handle reply}
                      if xGMode then begin
                        {Process possible reply}
                        if xpProcessBlockReply(P) then begin
                          {No reply, continue as though ack was received}
                          if aNoMoreData then begin
                            {Finished, wait for buffer to drain}
                            xXmodemState := txEndDrain;
                            if aFinishWait = 0 then begin
                              {Calculate finish drain time}
                              BufSize := InBuffUsed + InBuffFree;
                              Wait := 2 *
                                      (xBlockWait+((BufSize div aActCPS)*182) div 10);
                            end else
                              {Use user-specified finish drain time}
                              Wait := aFinishWait;
                            SetTimerTrigger(aTimeoutTrigger, Wait, True);
                            SetStatusTrigger(aOutBuffUsedTrigger, 0, True);
                          end else
                            xXmodemState := txGetBlock;
                        end else begin
                          {Got CAN or NAK, cancel the protocol}
                          FlushOutBuffer;
                          xXmodemState := txFinished;
                        end;
                      end else begin
                        {Wait for output buffer to drain}
                        xXmodemState := txDraining;
                        SetTimerTrigger(aTimeoutTrigger, DrainWait, True);
                        SetStatusTrigger( aOutBuffUsedTrigger, 0, True);
                      end;

                    {Force a status update}
                    aForceStatus := True;
                  end else begin
                    {Disk read error, have to give up}
                    xpCancel(P);
                    xXmodemState := txFinished;
                  end;
                end;

              txDraining :
                if (Integer(TriggerID) = aOutBuffUsedTrigger) or
                   (TriggerID = aDataTrigger) or
                   (Integer(TriggerID) = aTimeoutTrigger) then begin      
                  xXmodemState := txReplyPending;
                  SetTimerTrigger(aTimeoutTrigger, xBlockWait, True);
                end;

              txReplyPending :
                if TriggerID = aDataTrigger then begin
                  if xpProcessBlockReply(P) then begin
                    {Got reply, go send next block}
                    if aNoMoreData then
                      xXmodemState := txFirstEndofTransmit
                    else
                      xXmodemState := txGetBlock;
                  end else
                    if aProtocolStatus = psCancelRequested then begin
                      {Got two cancels, we're finished}
                      FlushOutBuffer;
                      xXmodemState := txFinished;
                    end else
                      {Got junk or Nak for a response, go send block again}
                      PrepSendBlock;
                end else if Integer(TriggerID) = aTimeoutTrigger then
                  {Got timeout, try to send block again}
                  PrepSendBlock;

              txEndDrain:
                if (Integer(TriggerID) = aOutBuffUsedTrigger) or
                   (Integer(TriggerID) = aTimeoutTrigger) then            
                  xXmodemState := txFirstEndOfTransmit;

              txFirstEndOfTransmit :
                begin
                  TransmitEot(P, True);
                  SetTimerTrigger(aTimeoutTrigger, aTransTimeout, True);
                  xXmodemState := txEotReply;
                end;

              txRestEndOfTransmit :
                begin
                  TransmitEot(P, False);
                  SetTimerTrigger(aTimeoutTrigger, xBlockWait, True);
                  if aBlockErrors <= xMaxBlockErrors then begin
                    xXmodemState := txEotReply;
                  end else begin
                    apProtocolError(P, ecTooManyErrors);
                    xXmodemState := txFinished;
                  end;
                end;

              txEotReply :
                if TriggerID = aDataTrigger then
                  if ProcessEotReply(P) then
                    xXmodemState := txFinished
                  else
                    xXmodemState := txRestEndOfTransmit
                else if Integer(TriggerID) = aTimeoutTrigger then         
                  xXmodemState := txRestEndOfTransmit;

              txFinished :
                begin
                  if (aProtocolStatus <> psEndFile) or
                     (aProtocolError <> ecOK) then
                    FlushInBuffer;

                  {Close the file}
                  apFinishReading(P);

                  {Show status, user logging}
                  if (aProtocolStatus = psEndFile) then
                    apLogFile(P, lfTransmitOk)
                  else
                    apLogFile(P, lfTransmitFail);
                  {apShowLastStatus(P);} 

                  {Clean up}
                  FreeMem(aDataBlock, SizeOf(TDataBlock));
                  xXmodemState := txDone;

                  if Msg <> apw_FromYmodem then begin
                    {Say we're finished}
                    apShowLastStatus(P);
                    apSignalFinish(P);
                  end else
                    apShowStatus(P, 0);

                  {Tell caller we're finished}
                  Result := 1;
                end;
            end;

            {Should we exit or not}
            case xXmodemState of
              {Stay in state machine}
              txGetBlock,
              txSendBlock,
              txFirstEndOfTransmit,
              txRestEndOfTransmit,
              txFinished            : Finished := False;