awymodem.pas

Async Professional 4.04

                  {Change name to lower case, change '\' to '/'}
                  Len := StrLen(S1);
                  AnsiLowerBuff(S1, Len);
                  for I := 0 to Len-1 do begin
                    {S1[I] := LoCaseMac(S1[I]);}
                    if S1[I] = '\' then
                      S1[I] := '/';
                  end;
                  Move(S1[0], yFileHeader^, Len);

                  {Fill in file size}
                  Str(aSrcFileLen, S2);
                  Move(S2[1], yFileHeader^[Len+2], Length(S2));
                  Inc(Len, Length(S2));

                  {Convert time stamp to Ymodem format and stuff in yFileHeader}
                  if aSrcFileDate <> 0 then begin
                    S2 := ' ' + apOctalStr(apPackToYMTimeStamp(aSrcFileDate));
                    Move(S2[1], yFileHeader^[Len+2], Length(S2));
                    Inc(Len, Length(S2)+2);
                  end;

                  {Determine block size from the used part of the yFileHeader}
                  if Len <= 128 then begin
                    aBlockLen := 128;
                    x1KMode := False;
                    xStartChar := cSoh;
                  end else begin
                    aBlockLen := 1024;
                    x1KMode := True;
                    xStartChar := cStx;
                  end;

                  {Init status vars for the header transfer}
                  aSrcFileLen := aBlockLen;
                  aBytesRemaining := aBlockLen;
                  aBytesTransferred := 0;
                  aElapsedTicks := 0;
                  aPathname[0] := #0;

                  {Go send the file header}
                  yYmodemState := tySendFileName;
                end else
                  yYModemState := tyFinished;

              tySendFileName :
                begin
                  {Send the file header}
                  aBlockNum := 0;
                  xpTransmitBlock(P, yFileHeader^, aBlockLen, ' ');
                  if aProtocolError <> ecOK then begin
                    yYmodemState := tyFinished;
                    goto ExitPoint;
                  end;

                  {If we get this far we will eventually need a cleanup block}
                  aFilesSent := True;

                  {Wait for the buffer to drain}
                  yYmodemState := tyDraining;
                  Dispatcher.SetTimerTrigger(aTimeoutTrigger, DrainWait, True);
                  Dispatcher.SetStatusTrigger(aOutBuffUsedTrigger, 0, True);
                end;

              tyDraining :
                if (Integer(TriggerID) = aOutBuffUsedTrigger) or
                   (Integer(TriggerID) = aTimeoutTrigger) then begin      
                  Dispatcher.SetTimerTrigger(aTimeoutTrigger, xBlockWait, True);
                  yYmodemState := tyReplyPending;
                end;

              tyReplyPending :
                if TriggerID = aDataTrigger then begin
                  {Process the header reply}
                  if xGMode then
                    yYModemState := tyPrepXmodem
                  else if xpProcessBlockReply(P) then
                    yYmodemState := tyPrepXmodem
                  else if CheckErrors then
                    yYmodemState := tyFinished
                  else
                    yYmodemState := tySendFilename
                end else if Integer(TriggerID) = aTimeoutTrigger then     
                  {Timeout waiting for header reply}
                  if CheckErrors then
                    yYmodemState := tyFinished
                  else
                    yYmodemState := tySendFilename;

              tyPrepXmodem :
                begin
                  {Reset some status vars}
                  aBytesTransferred := 0;
                  aElapsedTicks := 0;

                  {Restore the pathname and file size}
                  if aUpcaseFileNames then
                    AnsiUpper(ySaveName);
                  StrLCopy(aPathname, ySaveName, SizeOf(aPathname));
                  aSrcFileLen := ySaveLen;
                  aBytesRemaining := ySaveLen;

                  {Start transmitting the file with 1K blocks}
                  x1KMode := True;
                  xStartChar := cStx;
                  aBlockLen := 1024;
                  aCheckType := bcCrc16;
                  aForceStatus := True;
                  xXmodemState := txInitial;
                  yYmodemState := tySendXmodem;
                  aDataBlock := nil;
                  ExitStateMachine := False;
                  if Dispatcher.CharReady then
                    TriggerID := aDataTrigger;
                end;

              tySendXmodem :
                begin
                  {Let the Xmodem state machine handle it}
                  XState := xpTransmitPrim(apw_FromYmodem,
                                       TriggerID, lParam);
                  if XState = 1 then begin
                    if aProtocolError = ecOK then
                      yYmodemState := tyInitial
                     else
                      yYmodemState := tyFinished;
                  end;
                  ExitStateMachine := True;
                end;

              tyFinished :
                begin
                  apFinishReading(P);
                  if aFilesSent and (aProtocolStatus <> psCancelRequested)
                   and (aProtocolStatus <> psAbort) then begin              
                    {Send an empty header block to indicate end of Batch}
                    FillChar(yFileHeader^, 128, 0);
                    aBlockNum := 0;
                    x1KMode := False;
                    aBlockLen := 128;
                    xStartChar := cSoh;
                    xpTransmitBlock(P, yFileHeader^, aBlockLen, ' ');
                    Dispatcher.SetTimerTrigger(aTimeoutTrigger, aFinishWait, True);
                    Dispatcher.SetStatusTrigger(aOutBuffUsedTrigger, 0, True);
                    yYmodemState := tyFinishDrain;
                  end else begin
                    {Never sent any files, quit without sending empty block}
                    apShowLastStatus(P);
                    apSignalFinish(P);
                    yYmodemState := tyDone;
                  end;
                end;

              tyFinishDrain :
                if (Integer(TriggerID) = aTimeoutTrigger) or
                   (Integer(TriggerID) = aOutBuffUsedTrigger) then begin  
                  {We're finished}
                  apShowLastStatus(P);
                  yYmodemState := tyDone;
                  apSignalFinish(P);
                end;
            end;

    ExitPoint:
            {Set function result}
            case yYmodemState of
              {Leave protocol state machine}
              tyDone,
              tyReplyPending,
              tyDraining,
              tyFinishDrain       : Finished := True;

              {Stay in protocol state machine}
              tyGetFileName,
              tySendFileName,
              tyFinished          : Finished := False;

              {Stay in protocol machine if data available}
              tyPrepXmodem,
              tyHandshake         : Finished := not Dispatcher.CharReady;

              {Leave or stay as required}
              tySendXmodem        : Finished := ExitStateMachine;
              else                  Finished := True;
            end;

            {If staying in state machine simulate data received}
            if not Finished then
              TriggerID := aDataTrigger;
          except                                                       {!!.01}
            on EAccessViolation do begin                               {!!.01}
              Finished := True;                                        {!!.01}
              aProtocolError := ecAbortNoCarrier;                      {!!.01}
              apSignalFinish(P);                                       {!!.01}
            end;                                                       {!!.01}
          end;                                                         {!!.01}
        until Finished;
      {$IFDEF Win32}                                                 {!!.01}
      LeaveCriticalSection(P^.aProtSection);                         {!!.01}
      {$ENDIF}                                                       {!!.01}
    end;
  end;

  procedure ypPrepareReceive(P : PProtocolData);
    {-Prepare for Ymodem receive}
  begin
    with P^ do begin
      {Reset status vars}
      apResetStatus(P);
      aProtocolError := ecOK;
      apShowFirstStatus(P);
      aForceStatus := False;
      aTimerStarted := False;
      yYmodemState := ryInitial;
    end;
  end;

  procedure ypReceive(Msg, wParam : Cardinal; lParam : LongInt);
    {-Ymodem receive state machine}
  label
    ExitPoint;
  var
    TriggerID   : Cardinal absolute wParam;
    P           : PProtocolData;
    Code        : Integer;
    Res         : Cardinal;
    XState      : Cardinal;
    BlockSize   : Cardinal;
    BlockPos    : Integer;
    I           : Integer;
    CurSize     : LongInt;
    Finished    : Boolean;
    StatusTicks : LongInt;                                        
    ExitStateMachine : Boolean;
    C           : Char;
    F           : File;
    S           : String;
    {$IFDEF HugeStr}
    SLen        : Byte;
    {$ELSE}
    SLen        : Byte absolute S;
    {$ENDIF}
    S1          : ShortString;
    S1Len       : Byte absolute S1;
    Name        : String[fsName];
    NameExt     : array[0..fsName] of Char;
    Dispatcher      : TApdBaseDispatcher;

    function CheckErrors : Boolean;
      {-Increment block errors, return True if too many}
    begin
      with P^ do begin
        Inc(aBlockErrors);
        Inc(aTotalErrors);
        if aBlockErrors > xMaxBlockErrors then begin
          CheckErrors := True;
          apProtocolError(P, ecTooManyErrors);
          aProtocolStatus := psProtocolError;
        end else
          CheckErrors := False;
      end;
    end;

  begin
    Finished := False;                                                 {!!.01}
    ExitStateMachine := True;

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

    with P^ do begin
      {$IFDEF Win32}
      EnterCriticalSection(aProtSection);

      {Exit if protocol was cancelled while waiting for crit section}
      if yYmodemState = ryDone 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(
                dtYModem,LogYModemState[yYmodemState],0,nil,0);

            {Check for user abort}
            if (Integer(TriggerID) = aNoCarrierTrigger) or
                (Msg = apw_ProtocolAbort) or
                (Msg = apw_ProtocolCancel) then begin
              if Msg = apw_ProtocolCancel then begin
                xpCancel(P);
                aProtocolStatus := psCancelRequested;
              end else if (Msg = apw_ProtocolAbort) then                    
                aProtocolStatus := psAbort                                  
              else                                                          
                aProtocolStatus := psAbortNoCarrier;
              apLogFile(P, lfReceiveFail);
              yYmodemState := ryFinished;
              aForceStatus := False;
            end;

            {Show status periodically}
            if yYmodemState <> ryReceiveXmodem then begin
              if (Integer(TriggerID) = aStatusTrigger) or aForceStatus then begin
                if TimerTicksRemaining(aStatusTrigger,
                                        StatusTicks) <> 0 then
                  StatusTicks := 0;
                if StatusTicks <= 0 then begin
                  apShowStatus(P, 0);
                  SetTimerTrigger(aStatusTrigger, aStatusInterval, True);
                  aForceStatus := False;
                end;                                                          
              end;
            end;

            {Process current state}
            case yYmodemState of
              ryInitial :
                begin