awymodem.pas

Async Professional 4.04

{*********************************************************}
{*                   AWYMODEM.PAS 4.04                   *}
{*      Copyright (C) TurboPower Software 1996-2002      *}
{*                 All rights reserved.                  *}
{*********************************************************}

{Global defines potentially affecting this unit}
{$I AWDEFINE.INC}

{Options required for this unit}
{$I-,B-,F+,A-,X+}

unit AwYmodem;
  {-Provides Ymodem/YmodemG recieve and transmit functions}

interface

uses
  WinTypes,
  WinProcs,
  Messages,
  SysUtils,
  OoMisc,
  AwUser,
  AwTPcl,
  AwAbsPcl,
  AwXmodem,
  AdPort;    

{constructors/destructors}
function ypInit(var P : PProtocolData; H : TApdCustomComPort;         
                Use1K, UseGMode : Boolean;
                Options : Cardinal) : Integer;
procedure ypDone(var P : PProtocolData);

function ypReinit(P : PProtocolData; Use1K, UseGMode : Boolean) : Integer;
procedure ypDonePart(P : PProtocolData);

{Control}
procedure ypPrepareTransmit(P : PProtocolData);
procedure ypPrepareReceive(P : PProtocolData);
procedure ypTransmit(Msg, wParam : Cardinal; lParam : LongInt);
procedure ypReceive(Msg, wParam : Cardinal; lParam : LongInt);

implementation

{$IFDEF TRIALRUN}
  {$I TRIAL07.INC}
  {$I TRIAL03.INC}
  {$I TRIAL01.INC}
{$ENDIF}

const
  aDataTrigger = 0;
  LogYModemState : array[TYmodemState] of TDispatchSubType = (        
     dsttyInitial, dsttyHandshake, dsttyGetFileName, dsttySendFileName,
     dsttyDraining, dsttyReplyPending, dsttyPrepXmodem, dsttySendXmodem,
     dsttyFinished, dsttyFinishDrain, dsttyDone, dstryInitial,
     dstryDelay, dstryWaitForHSReply, dstryWaitForBlockStart,
     dstryCollectBlock, dstryProcessBlock, dstryOpenFile,
     dstryPrepXmodem, dstryReceiveXmodem, dstryFinished, dstryDone);

  procedure ypInitData(P : PProtocolData; Use1K, UseGMode : Boolean);
    {-Allocates and initializes a protocol control block with options}
  begin
    with P^ do begin
      {Set modes}
      aCurProtocol := Ymodem;
      xpSetCRCMode(P, True);
      xpSet1KMode(P, Use1K);
      xpSetGMode(P, UseGMode);

      {Other inits}
      aBatchProtocol := True;

      {Don't ask for any EOT retries}
      xEotCheckCount := 0;
    end;
  end;

  function ypInit(var P : PProtocolData; H : TApdCustomComPort;       
                  Use1K, UseGMode : Boolean;
                  Options : Cardinal) : Integer;
    {-Allocates and initializes a protocol control block with options}
  var
    InSize, OutSize : Cardinal;
  begin
    {Check for adequate output buffer size}
    H.ValidDispatcher.BufferSizes(InSize, OutSize);
    if OutSize < (1024+XmodemOverhead) then begin
      ypInit := ecOutputBufferTooSmall;
      Exit;
    end;

    {Init standard data}
    if apInitProtocolData(P, H, Options) <> ecOk then begin
      ypInit := ecOutOfMemory;
      Exit;
    end;

    with P^ do begin
      {Allocate the name block buffer}
      yFileHeader := AllocMem(SizeOf(TDataBlock)+XmodemOverhead);

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

      {Init the protocol data}
      ypInitData(P, Use1K, UseGMode);
    end;
  end;

  function ypReinit(P : PProtocolData; Use1K, UseGMode : Boolean) : Integer;
    {-Allocates and initializes a protocol control block with options}
  begin
    with P^ do begin
      {Allocate the name block buffer}
      yFileHeader := AllocMem(SizeOf(TDataBlock)+XmodemOverhead);

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

      {Init the data}
      ypInitData(P, Use1K, UseGMode);

      {Reset the read/write hooks}
      apResetReadWriteHooks(P);
    end;
  end;

  procedure ypDone(var P : PProtocolData);
    {-Destroy Ymodem object}
{$IFDEF TRIALRUN}
  {$I TRIAL04.INC}
{$ENDIF}
  begin
    if P <> nil then begin
      FreeMem(P^.yFileHeader, SizeOf(TDataBlock)+XmodemOverhead);
      apDoneProtocol(P);
    end;
{$IFDEF TRIALRUN}
  TC;
{$ENDIF}
  end;

  procedure ypDonePart(P : PProtocolData);
    {-Destroy Ymodem object}
  begin
    if P <> nil then
      FreeMem(P^.yFileHeader, SizeOf(TDataBlock)+XmodemOverhead);
  end;

  procedure ypPrepareTransmit(P : PProtocolData);
    {-Prepare to transmit a Ymodem batch}
  begin
    with P^ do begin
      {Reset status vars}
      apResetStatus(P);
      aProtocolStatus := psProtocolHandshake;
      apShowFirstStatus(P);
      aForceStatus := False;
      aTimerStarted := False;

      {Set first state}
      yYmodemState := tyInitial;

      {Flush trigger buffer}
      aHC.FlushInBuffer;
    end;
  end;

  procedure ypTransmit(Msg, wParam : Cardinal;
                      lParam : LongInt);
    {-Perform one increment of Ymodem batch transmit}
  label
    ExitPoint;
  var
    TriggerID   : Cardinal absolute wParam;
    XState      : Cardinal;
    Finished    : Boolean;
    StatusTicks : Longint;                                         
    ExitStateMachine : Boolean;
    I           : Integer;
    P           : PProtocolData;
    Len         : Byte;
    S2          : string[13];
    S1          : TPathCharArray;
    S           : string[fsPathname];
    Name        : string[fsName];
    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}
    try                                                                {!!.01}
      {Get the protocol pointer from data pointer 1}
      Dispatcher := TApdBaseDispatcher(PortList[LH(lParam).H]);
      with Dispatcher do
        GetDataPointer(Pointer(P), ProtocolDataPtr);
    except                                                             {!!.01}
      on EAccessViolation do                                           {!!.01}
        { No access to P^, just 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}

        {Set TriggerID directly 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 or remote 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;
              yYmodemState := tyFinished;
              aForceStatus := False;
              apLogFile(P, lfTransmitFail);
            end;

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

            ExitStateMachine := True;

            {Process current state}
            case yYmodemState of
              tyInitial :
                begin
                  {Check for handshake character}
                  yYmodemState := tyHandshake;
                  aHandshakeAttempt := 0;
                  if not xpPrepHandshake(P) then
                    yYmodemState := tyFinished;
                end;

              tyHandshake :
                if TriggerID = aDataTrigger  then begin
                  if xpProcessHandshake(P) then begin
                    {Start protocol timer now}
                    aTimerStarted := True;
                    NewTimer(aTimer, 1);
                    aBlockErrors := 0;
                    yYmodemState := tyGetFileName;
                    {If GMode don't allow any more errors}
                    if xGMode then
                      xMaxBlockErrors := 0;
                  end else begin
                    {Not a valid handshake character, note error}
                    if not xpPrepHandshake(P) then
                      yYmodemState := tyFinished;
                  end;
                end else if Integer(TriggerID) = aTimeoutTrigger then      
                  {Timeout waiting for handshake character, note error}
                  if not xpPrepHandshake(P) then
                    yYmodemState := tyFinished;

              tyGetFileName :
                if apNextFile(P, aPathName) then begin
                  {Open file now to get size and date stamp}
                  apPrepareReading(P);

                  {Quit if we couldn't open the file}
                  if aProtocolError <> ecOk then begin
                    yYmodemState := tyFinished;
                    goto ExitPoint;
                  end;

                  {Save the file name and length}
                  StrLCopy(ySaveName, aPathName, SizeOf(ySaveName));
                  ySaveLen := aSrcFileLen;

                  {Make a Ymodem file header record}
                  FillChar(yFileHeader^, SizeOf(yFileHeader^)+XmodemOverhead, 0);

                  {Fill in the file name}
                  S := StrPas(aPathName);
                  Name := ExtractFileName(S);
                  if FlagIsSet(aFlags, apIncludeDirectory) then
                    StrPCopy(S1, S)
                  else
                    StrPCopy(S1, Name);