{$I-,S-}
{$IFNDEF OS2}
{$R-,V-,B-,F+,O+,A-}
{$ENDIF}

{Conditional defines that may affect this unit}
{$I APDEFINE.INC}

{*********************************************************}
{*                    APABSPCL.PAS 2.03                  *}
{*     Copyright (c) TurboPower Software 1991.           *}
{* Portions copyright (c) Information Technology 1989,   *}
{*    and used under license to TurboPower Software      *}
{*                 All rights reserved.                  *}
{*********************************************************}

{$IFDEF UseOOP}
  !! STOP COMPILE - this Unit requires UseOOP To be undefined
{$ENDIF}

Unit ApAbsPcl;
  {-Provides "abstract" protocol data definitions and general procedures}

Interface

Uses
{$IFNDEF OS2}
  ApMisc,
  ApPort,
{$ELSE}
  ApOS2,
{$ENDIF}

{$IFNDEF WIN32}
  DOS,
  ApTimer,
{$ENDIF}
  ApCom,
  ApSame,
  OpInline,
  Crc32,
  tMisc;

Const
  AvgCPS : LongInt = 0;

{$I APABSPCL.PA0}

Implementation

Const
  {Set to 1/1/1970 00:00 GMT}
  StartDate : DateTimeRec = (D: 135140; T: 0);

Procedure InitProtocolData (Var P : ProtocolDataPtr;
                             PortPtr : PortRecPtr;
                             Options : Word);
    {-Allocates and initializes a protocol data block}
  Begin
    SetAsyncStatus (ecOk);

    {Allocate a protocol data block}
    If Not GetMemCheck (P, SizeOf (ProtocolData) ) Then Begin
      GotError (PortPtr, ecOutOfMemory);
      Exit;
    End;

    With P^ Do Begin

      {!!.01 moved from prepareread/write}
      If Not GetMemCheck (FileBuffer, FileBufferSize) Then Begin
        FreeMemCheck (P, SizeOf (ProtocolData) );
        GotError (PR, epFatal + ecOutOfMemory);
        Exit;
      End;

      {Save the port record}
      PR := PortPtr;

      {Initialize the protocol fields}
      UserStatus := NoStatus;
      HandshakeWait := DefHandshakeWait;
      HandshakeRetry := DefHandshakeRetry;
      BlockLen := 128;
      PathName := '';
      SrcFileLen := 0;
      SrcFileDate := 0;
      ElapsedTics := 0;
      BytesRemaining := 0;
      BytesTransferred := 0;
      InProgress := 0;
      EotCheckCount := 1;
      BatchProtocol := False;
      WriteFailOpt := WriteFail;
      FileOpen := False;
      NextFile := NextFileMask;
      SearchMask := '';
      apFlags := Options;
      LogFile := NoLogFile;
      AcceptFile := NoAcceptFile;
      UserBack := NoUserBack;
      DestDir := '';
      CheckType := bcNone;
      ActCPS := PR^. CurBaud Div 10;
      StatusInterval := DefStatusInterval;
      OverHead := 0;
      TurnDelay := 0;
      InitFilePos := 0;
      TransTimeout := DefTransTimeout;
      PrepareReading := apPrepareReading;
      ReadProtocolBlock := apReadProtocolBlock;
      FinishReading := apFinishReading;
      PrepareWriting := apPrepareWriting;
      WriteProtocolBlock := apWriteProtocolBlock;
      FinishWriting := apFinishWriting;
    End;
  End;

  Procedure DoneProtocolData (Var P : ProtocolDataPtr);
    {-Disposes of a protocol data block}
  Begin
    FreeMemCheck (P^. FileBuffer, FileBufferSize);                       {!!.01}
    FreeMemCheck (P, SizeOf (ProtocolData) );
  End;

  Procedure SetShowStatusProc (P : ProtocolRecPtr; SProc : ShowStatusProc);
    {-Sets a user status function}
  Begin
    P^. PData^. UserStatus := SProc;
  End;

  Procedure SetNextFileFunc (P : ProtocolRecPtr; NFFunc : NextFileFunc);
    {-Sets function for batch protocols to call to get file to transmit}
  Begin
    P^. PData^. NextFile := NFFunc;
  End;

  Procedure SetFileMask (P : ProtocolRecPtr; NewMask : PathStr);
    {-Sets dir/file mask for built-in NextFileMask function}
  Begin
    P^. PData^. SearchMask := NewMask;
  End;

  Procedure SetFileList (P : ProtocolRecPtr; FLP : FileListPtr);
    {-Sets the file list to use for the built-in NextFileList function}
  Begin
    P^. PData^. FileList := FLP;
  End;

  Procedure MakeFileList (P : ProtocolRecPtr;
                         Var FLP : FileListPtr;
                         Size : Word);
    {-Allocates a new file list of Size bytes}
  Begin
    SetAsyncStatus (ecOk);
    If GetMemCheck (FLP, Size) Then Begin
      FillChar (FLP^, Size, 0);
      P^. PData^. FileListMax := Size;
    End Else
      GotError (P^. PData^. PR, epFatal + ecOutOfMemory);
  End;

  Procedure DisposeFileList (P : ProtocolRecPtr;
                            Var FLP : FileListPtr;                     {!!.01}
                            Size : Word);
    {-Disposes of file list FLP}
  Begin
    FreeMemCheck (FLP, Size);
  End;

  Procedure AddFileToList (P : ProtocolRecPtr;
                          FLP : FileListPtr;
                          PName : PathStr);
    {-Adds pathname PName to file list FLP}
  Const
    {MaxList = 65535;}
    Separator = ';';
    EndOfListMark = #0;
  Var
    I : Word;
  Begin
    SetAsyncStatus (ecOk);

    With P^. PData^ Do Begin
      {Search for the current end of the list}
      For I := 0 To FileListMax - 1 Do
        If FLP^ [I] = EndOfListMark Then Begin
          {Found the end of the list -- try to add the new file}
          If (LongInt (I) + Length (PName) + 1) >= FileListMax Then Begin
            {Not enough room to add file}
            GotError (PR, epNonFatal + ecOutOfMemory);
            Exit;
          End Else Begin
            {There's room -- add the file}
            If I <> 0 Then Begin
              FLP^ [I] := Separator;
              Inc (I);
            End;
            Move (PName [1], FLP^ [I], Length (PName) );
            FLP^ [I + Length (PName) ] := EndOfListMark;
            Exit;
          End;
        End;
    End;

    {Never found endoflist marker}
    GotError (P^. PData^. PR, epFatal + ecBadFileList);
  End;

  Procedure SetDestinationDirectory (P : ProtocolRecPtr; Dir : DirStr);
    {-Set the destination directory for received files}
  Begin
    P^. PData^. DestDir := UpString (Dir);
  End;

  Procedure SetReceiveFilename (P : ProtocolRecPtr; Fname : PathStr);
    {-Give a name to the file to be received}
  Begin
    With P^, PData^ Do
      If (DestDir <> '') And (JustPathName (Fname) = '') Then
        Pathname := AddBackSlash (DestDir) + Fname
      Else
        Pathname := Fname;
  End;

  Procedure SetLogFileProc (P : ProtocolRecPtr; LFP : LogFileProc);
    {-Sets a procedure to be called when a file is received}
  Begin
    P^. PData^. LogFile := LFP;
  End;

  Procedure SetAcceptFileFunc (P : ProtocolRecPtr; AFP : AcceptFileFunc);
    {-Sets a procedure to be called when a file is received}
  Begin
    P^. PData^. AcceptFile := AFP;
  End;

  Procedure SetBackgroundProc (P : ProtocolRecPtr; BP : UserBackProc);
    {-Sets a background procedure to be called while a file is transferred}
  Begin
    P^. PData^. UserBack := BP;
  End;

  Procedure SetHandshakeWait (P : ProtocolRecPtr;
                             NewHandshake, NewRetry : Word);
    {-Set the wait time for the initial handshake}
  Begin
    With P^. PData^ Do Begin
      If NewHandshake <> 0 Then
        HandshakeWait := NewHandshake;
      If NewRetry <> 0 Then
        HandshakeRetry := NewRetry;
    End;
  End;

  Procedure SetOverwriteOption (P : ProtocolRecPtr; Opt : WriteFailOptions);
    {-Set option for what to do when the destination file already exists}
  Begin
    P^. PData^. WriteFailOpt := Opt;
  End;

  Procedure SetActualBPS (P : ProtocolRecPtr; BPS : LongInt);
    {-Sets actual CPS rate (only needed if modem differs from port)}
  Begin
    P^. PData^. ActCPS := BPS Div 10;
  End;

  Procedure SetEfficiencyParms (P : ProtocolRecPtr;
                               BlockOverhead, TurnAroundDelay : Word);
    {-Sets efficiency parameters for EstimateTransferSecs}
  Begin
    With P^. PData^ Do Begin
      Overhead := BlockOverhead;
      TurnDelay := TurnAroundDelay;
    End;
  End;

  Procedure SetProtocolPort (P : ProtocolRecPtr; PortPtr : PortRecPtr);
    {-Sets PortPtr as the port for this protocol}
  Begin
    With P^. PData^ Do
      PR := PortPtr;
  End;

  Procedure apOptionsOn (P : ProtocolRecPtr; OptionFlags : Word);
    {-Activate multiple options}
  Begin
    With P^. PData^ Do
      apFlags := apFlags Or (OptionFlags And Not BadProtocolOptions);
  End;

  Procedure apOptionsOff (P : ProtocolRecPtr; OptionFlags : Word);
    {-Deactivate multiple options}
  Begin
    With P^. PData^ Do
      apFlags := apFlags And Not (OptionFlags And Not BadProtocolOptions);
  End;

  Function apOptionsAreOn (P : ProtocolRecPtr; OptionFlags : Word) : Boolean;
    {-Return True if all specified options are on}
  Begin
    With P^. PData^ Do
      apOptionsAreOn := (apFlags And OptionFlags = OptionFlags);
  End;

  Function GetFilename (P : ProtocolRecPtr) : PathStr;
    {-Returns the name of the current file}
  Begin
    With P^. PData^ Do
      GetFileName := JustFilename (Pathname);
  End;

  Function GetPathname (P : ProtocolRecPtr) : PathStr;
    {-Returns the complete pathname of the current file (if known)}
  Begin
    With P^. PData^ Do
      GetPathname := Pathname;
  End;

  Function GetFileSize (P : ProtocolRecPtr) : LongInt;
    {-Returns current file size (0 if no file active)}
  Begin
    With P^. PData^ Do
      GetFileSize := SrcFileLen;
  End;

  Function GetBytesRemaining (P : ProtocolRecPtr) : LongInt;
    {-Return bytes not yet transferred}
  Var
    BR : LongInt;
  Begin
    With P^. PData^ Do Begin
      BR := SrcFileLen - GetBytesTransferred (P);
      If BR < 0 Then
        BR := 0;
      GetBytesRemaining := BR;
    End;
  End;

  Function GetBytesTransferred (P : ProtocolRecPtr) : LongInt;
    {-Returns bytes already transferred}
  Var
    TotalOverhead : Word;
    OutBuff : Word;
    BT : LongInt;
  Begin
    With P^. PData^ Do Begin
    {$IFNDEF OS2}
      OutBuff := OutBuffUsed (P^. PData^. PR);
      If OutBuff >= BlockLen Then Begin
        If BlockLen <> 0 Then                                          {!!.01}
          TotalOverhead := Overhead * (OutBuff Div BlockLen)
        Else                                                           {!!.01}
          TotalOverhead := Overhead;                                   {!!.01}
        BT := BytesTransferred - (OutBuff - TotalOverhead);
        If BT > 0 Then
          GetBytesTransferred := BT
        Else
          GetBytesTransferred := 0;
      End Else
    {$ENDIF}
        GetBytesTransferred := BytesTransferred;
    End;
  End;

  Function GetElapsedTics (P : ProtocolRecPtr) : LongInt;
    {-Returns tics since first block was sent (or received)}
  Begin
    With P^. PData^ Do
      GetElapsedTics := ElapsedTics;
  End;

  Function GetBlockErrors (P : ProtocolRecPtr) : Word;
    {-Returns the number of errors received this block}
  Begin
    With P^. PData^ Do
      GetBlockErrors := BlockErrors;
  End;

  Function GetTotalErrors (P : ProtocolRecPtr) : Word;
    {-Returns the number of errors recieved this transfer}
  Begin
    With P^. PData^ Do
      GetTotalErrors := TotalErrors;
  End;

  Function GetProtocol (P : ProtocolRecPtr) : Byte;
    {-Returns the current protocol type}
  Begin
    With P^. PData^ Do
      GetProtocol := ProtType;
  End;

  Function GetBlockSize (P : ProtocolRecPtr) : Word;
    {-Returns the current block size}
  Begin
    With P^. PData^ Do
      GetBlockSize := BlockLen;
  End;

  Function GetBlockNum (P : ProtocolRecPtr) : Word;
    {-Returns the current block number}
  Begin
    With P^. PData^ Do
      GetBlockNum := GetBytesTransferred (P) Div BlockLen;
  End;

  Function GetCurrentBlockNum (P : ProtocolRecPtr) : Word;
    {-Returns the block number of the block being transferred}
  Var
    BT : LongInt;
    Block : Word;
  Begin
    With P^. PData^ Do Begin
      BT := GetBytesTransferred (P);
      Block := BT Div BlockLen;
      If BT Mod BlockLen <> 0 Then
        Inc (Block);
      GetCurrentBlockNum := Block;
    End;
  End;

  Function SupportsBatch (P : ProtocolRecPtr) : Boolean;
    {-Returns True if this protocol supports batch file transfers}
  Begin
    With P^. PData^ Do
      SupportsBatch := BatchProtocol;
  End;

  Function GetCheckType (P : ProtocolRecPtr) : Byte;
    {-Returns the bcXxx code for the block check type}
  Begin
    With P^. PData^ Do
      GetCheckType := CheckType;
  End;

  Function GetInitialFilePos (P : ProtocolRecPtr) : LongInt;
    {-Returns the file position at the start of resumed file transfer}
  Begin
    With P^. PData^ Do
      GetInitialFilePos := InitFilePos;
  End;

  Function EstimateTransferSecs (P : ProtocolRecPtr;
                                Size : LongInt) : LongInt;
    {-Return estimated seconds to transfer Size bytes}
  Var
    Efficiency : LongInt;
    EffectiveCPS : LongInt;
  Begin
    With P^. PData^ Do Begin
      If Size = 0 Then
        EstimateTransferSecs := 0
      Else Begin
        {Calcuate efficiency of this protocol}
        Efficiency := (BlockLen * LongInt (100) ) Div
        (BlockLen + OverHead +
        ( (LongInt (TurnDelay) * ActCPS) Div 1000) );       {!!.02}

        If AvgCPS = 0
        Then
          EffectiveCPS := (ActCPS * Efficiency) Div 100
        Else
          EffectiveCPS := AvgCPS;

        {Calculate remaining seconds}
        If EffectiveCPS > 0 Then
          EstimateTransferSecs := Size Div EffectiveCPS
        Else
          EstimateTransferSecs := 0;
      End;
    End;
  End;

  Procedure ShowFirstStatus (P : ProtocolRecPtr);
    {-Show (possible) first status}
  Begin
    With P^. PData^ Do Begin
      apUserStatus (P, (InProgress = 0), False);
      Inc (InProgress);
    End;
  End;

  Procedure ShowLastStatus (P : ProtocolRecPtr);
    {-Reset field and show last status}
  Begin
    With P^. PData^ Do Begin
      If InProgress <> 0 Then Begin
        Dec (InProgress);
        apUserStatus (P, False, (InProgress = 0) );
      End;
    End;
  End;

  Procedure ResetStatus (P : ProtocolRecPtr);
    {-Conditionally reset all status vars}
  Begin
    With P^. PData^ Do Begin
      If InProgress = 0 Then Begin
        {New protocol, reset status vars}
        SrcFileLen := 0;
        BytesRemaining := 0;
      End;
      BytesTransferred := 0;
      ElapsedTics := 0;
      BlockErrors := 0;
      TotalErrors := 0;
      BlockNum := 0;
    End;
  End;

  Function WaitForFreeSpace (P : ProtocolRecPtr; W, T : Word) :  Boolean;
    {Wait until buffer has W free bytes}
  Var
    ET : EventTimer;
  Begin
    With P^, PData^ Do Begin
      WaitForFreeSpace := True;
      {$IFNDEF OS2}
      NewTimer (ET, T);
      While (OutBuffFree (PR) < W) And
            Not WaitComplete (PR, ET)
      Do ;

      {Check for user abort during WaitComplete}
      If GetAsyncStatus <> ecOk Then
        WaitForFreeSpace := False;
      {$ENDIF}
    End;
  End;

  Function Crc32ofFile (P : ProtocolRecPtr;
                       FName : PathStr; Len : LongInt) : LongInt;
    {-Returns Crc32 of FName}
  Const
    BufSize = 8192;
  Type
    BufArray = Array [1..BufSize] Of Byte;
  Var
    BytesRead, I : {$IFNDEF OS2} Word; {$ELSE} LongInt; {$ENDIF}
    Result : Word;
    F : File;
    Buffer : ^BufArray;
    FileLoc : LongInt;
    Crc : LongInt;
    SaveMode : Byte;                                                   {!!.02}
  Label
    ExitPoint;
  Begin
    SetAsyncStatus (ecOk);

    {If Len is zero then check the entire file}
    If Len = 0 Then
      Len := MaxLongInt;

    {Get a buffer}
    If Not GetMemCheck (Buffer, BufSize) Then Begin
      GotError (P^. PData^. PR, epNonFatal + ecOutOfMemory);
      Exit;
    End;

    {Open the file}
    SaveMode := FileMode;                                              {!!.02}
    FileMode := GetAproFileMode;                                {!!.02} {!!.03}
    Assign (F, FName);
    Reset (F, 1);
    FileMode := SaveMode;                                              {!!.02}
    Result := IOResult;
    If Result <> 0 Then Begin
      GotError (P^. PData^. PR, epNonFatal + Result);
      Goto ExitPoint;
    End;

    {Initialize Crc}
    Crc := $FFFFFFFF;

    {Start at beginning, loop thru file calculating Crc32}
    FileLoc := 0;
    Repeat
      BlockRead (F , Buffer^, BufSize, BytesRead);
      Result := IOResult;
      If Result = 0 Then Begin
        If Len <> MaxLongInt Then Begin
          Inc (FileLoc, BytesRead);
          If FileLoc > Len Then
            BytesRead := BytesRead - (FileLoc - Len);
        End;
        For I := 1 To BytesRead Do
          Crc := UpdateCrc32 (Buffer^ [I], Crc);
      End;
    Until (BytesRead = 0) Or (Result <> 0) Or (FileLoc >= Len);

    Close (F);
    If IOResult = 0 Then ;

    ExitPoint:
    Crc32ofFile := Crc;
    FreeMemCheck (Buffer, BufSize);
  End;

  {$F+}
  Procedure NoStatus (P : ProtocolRecPtr; Starting, Ending : Boolean);
    {-Empty show status procedure}
  Begin
  End;

  Function NoNextFile (P : ProtocolRecPtr) : Boolean;
    {-Empty next file function -- always returns False}
  Begin
    NoNextFile := False;
  End;

  Procedure NoLogFile (P : ProtocolRecPtr; LogFileStatus : LogFileType);
    {-Empty LogFile procedure}
  Begin
  End;

  Function NoAcceptFile (P : ProtocolRecPtr) : Boolean;
    {-Empty AcceptFile function}
  Begin
    NoAcceptFile := True;
  End;

  Procedure NoUserBack (P : ProtocolRecPtr);
    {-Empty UserBackProc procedure }
  Begin
  End;

  Function AcceptOneFile (P : ProtocolRecPtr) : Boolean;
    {-Built-in function that accepts one file only}
  Begin
    With P^. PData^ Do Begin
      AcceptOneFile := Not GotOneFile;
      GotOneFile := True;
    End;
  End;

  Function NextFileMask (P : ProtocolRecPtr;
                        Var FName : PathStr) : Boolean;
    {-Built-in function that works with file mask fields}
  Const
    AnyFileButDir = AnyFile And Not (Directory Or VolumeID);
  Begin
    SetAsyncStatus (ecOk);
    With P^. PData^ Do Begin
      {Check for uninitialized search mask}
      If SearchMask = '' Then Begin
        GotError (PR, epFatal + ecNoSearchMask);
        SetAsyncStatus (ecNoSearchMask);
        NextFileMask := False;
        Exit;
      End;

      {Search for a matching file}
      If FindingFirst Then
      Begin
        FindFirst (SearchMask, AnyFileButDir, CurRec);
        If DosError = 18 Then Begin
          GotError (PR, epFatal + ecNoMatchingFiles);
          FName := '';
          NextFileMask := False;
          {$IFDEF OS2}
          FindClose (CurRec);
          {$ENDIF}
          Exit;
        End Else
          FindingFirst := False;
      End Else
        FindNext (CurRec);

      {Check for errors}
      If DosError <> 0 Then Begin
        {Failed to find file, return error status}
        Case DosError Of
          3  : GotError (PR, epFatal + ecDirNotFound);
          {18 : GotError(PR, epFatal+ecNoMatchingFiles);}
        End;
        FName := '';
        NextFileMask := False;
        {$IFDEF OS2}
        FindClose (CurRec);
        {$ENDIF}
      End Else Begin
        {Found a file, return fully qualified file name}
        FName := AddBackSlash (JustPathName (SearchMask) ) + CurRec. Name;
        NextFileMask := True;
      End;
    End;
  End;

  Function NextFileList (P : ProtocolRecPtr; Var FName : PathStr) : Boolean;
    {-Built-in function that works with a list of files}
  Const
    Separator = ';';
    EndOfListMark = #0;
    MaxLen = SizeOf (PathStr);
  Var
    MaxNext : Word;
    I : Word;
    Len : Word;
  Begin
    SetAsyncStatus (ecOk);

    With P^. PData^ Do Begin
      {Return immediately if no more files}
      If FileList^ [FileListIndex] = EndOfListMark Then Begin
        NextFileList := False;
        FName := '';
        Exit;
      End;

      {Increment past the last separator}
      If FileListIndex <> 0 Then
        Inc (FileListIndex);

      {Define how far to look for the next marker}
      If LongInt (FileListIndex) + MaxLen > 65535 Then
        MaxNext := 65535
      Else
        MaxNext := FileListIndex + MaxLen;

      {Look for the next marker}
      For I := FileListIndex To MaxNext Do Begin
        If (FileList^ [I] = Separator) Or
           (FileList^ [I] = EndOfListMark)
        Then Begin
          {Extract the pathname}
          Len := I - FileListIndex;
          Move (FileList^ [FileListIndex], FName [1], Len);
          FName [0] := Char (Len);
          NextFileList := True;
          Inc (FileListIndex, Len);
          Exit;
        End;
      End;

      {Bad format list (no separator) -- show error}
      GotError (PR, epFatal + ecBadFileList);
      NextFileList := False;
      FName := '';
    End;
  End;

  Procedure apPrepareReading (P : ProtocolRecPtr);
    {-Prepare to send protocol blocks (usually opens a file)}
  Var
    Result : Word;
  Begin
    With P^, PData^ Do Begin
      SetAsyncStatus (ecOk);

      {If file is already open then leave without doing anything}
      If FileOpen Then
        Exit;

      {Report notfound error for empty filename}
      If PathName = '' Then Begin
        GotError (PR, epFatal + ecFileNotFound);
        Exit;
      End;

      {!!.01 moved to init}
      {Allocate a file buffer}
      {if not GetMemCheck(FileBuffer, FileBufferSize) then begin
      GotError(PR, epFatal+ecOutOfMemory);
      Exit;
      end;}

      {Open up the previously specified file}
      SaveMode := FileMode;                                            {!!.02}
      FileMode := GetAproFileMode;                              {!!.02} {!!.03}
      Assign (WorkFile, PathName);
      Reset (WorkFile, 1);
      FileMode := SaveMode;                                            {!!.02}
      Result := IOResult;
      If Result <> 0 Then Begin
        GotError (PR, epFatal + Result);
        {FreeMemCheck(FileBuffer, FileBufferSize);}                    {!!.01}
        Exit;
      End;

      {Show file name and size}
      SrcFileLen := FileSize (WorkFile);
      BytesRemaining := SrcFileLen;
      apUserStatus (P, False, False);

      {Note file date/time stamp (for those protocols that care)}
      GetFTime (WorkFile, SrcFileDate);

      {Initialize the buffering variables}
      StartOfs := 0;
      EndOfs := 0;
      LastOfs := 0;
      EndPending := False;
      FileOpen := True;
    End;
  End;

  Procedure apFinishReading (P : ProtocolRecPtr);
    {-Clean up after reading protocol blocks (usually closes a file)}
  Begin
    With P^. PData^ Do
      If FileOpen Then Begin
        {Error or end-of-protocol, clean up}
        Close (WorkFile);
        If IOResult <> 0 Then ;
        {FreeMemCheck(FileBuffer, FileBufferSize);}                    {!!.01}
        FileOpen := False;
      End;
  End;

  Function apReadProtocolBlock (P : ProtocolRecPtr;
                               Var Block : DataBlockType;
                               Var BlockSize : Word) : Boolean;
    {-Return with a block to transmit (True to quit)}
  Var
    BytesRead : {$IFNDEF OS2} Word; {$ELSE} LongInt; {$ENDIF}
    BytesToMove : Word;
    BytesToRead : Word;
    Result : Word;
  Begin
    SetAsyncStatus (ecOk);

    With P^. PData^ Do Begin
      {Check for a request to start further along in the file (recovering)}
      {if (LastOfs = 0) and (FileOfs > BlockSize) then}
      If FileOfs > EndOfs Then
        {First call to read is asking to skip blocks -- force a reread}
        EndOfs := FileOfs;

      {Check for a request to retransmit an old block}
      If FileOfs < LastOfs Then
        {Retransmit - reset end-of-buffer to force a reread}
        EndOfs := FileOfs;

      If (FileOfs + BlockSize) > EndOfs Then Begin
        {Buffer needs to be updated, First shift end section to beginning}
        BytesToMove := EndOfs - FileOfs;
        If BytesToMove > 0 Then
          Move (FileBuffer^ [FileOfs - StartOfs], FileBuffer^, BytesToMove);

        {Fill end section from file}
        BytesToRead := FileBufferSize - BytesToMove;
        Seek (WorkFile, EndOfs);
        BlockRead (WorkFile, FileBuffer^ [BytesToMove], BytesToRead, BytesRead);
        Result := IOResult;
        If (Result <> 0) Then Begin
          {Exit on error}
          GotError (PR, epFatal + Result);
          apReadProtocolBlock := True;
          BlockSize := 0;
          Exit;
        End Else Begin
          {Set buffering variables}
          StartOfs := FileOfs;
          EndOfs := FileOfs + FileBufferSize;
        End;

        {Prepare for the end of the file}
        If BytesRead < BytesToRead Then Begin
          EndOfDataOfs := BytesToMove + BytesRead;
          FillChar (FileBuffer^ [EndofDataOfs], FileBufferSize - EndOfDataOfs,
          BlockFillChar);
          Inc (EndOfDataOfs, StartOfs);
          EndPending := True;
        End Else
          EndPending := False;
      End;

      {Return the requested block}
      Move (FileBuffer^ [ (FileOfs - StartOfs) ], Block, BlockSize);
      apReadProtocolBlock := False;
      LastOfs := FileOfs;

      {If it's the last block then say so}
      If EndPending And ( (FileOfs + BlockSize) >= EndOfDataOfs) Then Begin
        apReadProtocolBlock := True;
        BlockSize := EndOfDataOfs - FileOfs;
      End;
    End;
  End;

  Procedure apPrepareWriting (P : ProtocolRecPtr);
    {-Prepare to save protocol blocks (usually opens a file)}
  Var
    Dir : DirStr;
    Name : NameStr;
    Ext : ExtStr;
    Result : Word;
  Label
    ExitPoint;
  Begin
    With P^. PData^ Do Begin

      {!!.01 moved to init}
      {Allocate a file buffer}
      {if not GetMemCheck(FileBuffer, FileBufferSize) then begin
      GotError(PR, epFatal+ecOutOfMemory);
      ShowLastStatus(P);
      Exit;
      end;}

      {Does the file exist already?}
      SaveMode := FileMode;                                            {!!.02}
      FileMode := GetAproFileMode;                              {!!.02} {!!.03}
      Assign (WorkFile, PathName);
      Reset (WorkFile, 1);
      FileMode := SaveMode;                                            {!!.02}
      Result := IOResult;

      {Exit on errors other than FileNotFound}
      If (Result <> 0) And (Result <> 2) Then Begin
        GotError (PR, epFatal + Result);
        Goto ExitPoint;
      End;

      {Exit if file exists and option is WriteFail}
      If (Result = 0) And (WriteFailOpt = WriteFail) Then Begin
        GotError (PR, epNonFatal + ecFileAlreadyExists);
        Goto ExitPoint;
      End;

      Close (WorkFile);
      If IOResult = 0 Then ;

      {Change the file name if it already exists the option is WriteRename}
      If (Result = 0) And (WriteFailOpt = WriteRename) Then Begin
        FSplit (Pathname, Dir, Name, Ext);
        Name [1] := '$';
        Pathname := Dir + Name + Ext;
        GotError (PR, epNonFatal + ecFileRenamed);
      End;

      {Give status a chance to show that the file was renamed}
      apUserStatus (P, False, False);
      SetAsyncStatus (ecOk);

      {Ok to rewrite file now}
      Assign (WorkFile, Pathname);
      Rewrite (WorkFile, 1);
      Result := IOResult;
      If Result <> 0 Then Begin
        GotError (PR, epFatal + Result);
        Goto ExitPoint;
      End;

      {Initialized the buffer management vars}
      StartOfs := 0;
      LastOfs := 0;
      EndOfs := StartOfs + FileBufferSize;
      FileOpen := True;
      SetAsyncStatus (ecOk);
      Exit;

      ExitPoint:
      Close (WorkFile);
      If IOResult <> 0 Then ;
      {FreeMemCheck(FileBuffer, FileBufferSize);}                      {!!.01}
    End;
  End;

  Procedure apFinishWriting (P : ProtocolRecPtr);
    {-Cleans up after saving all protocol blocks}
  Var
    BytesToWrite : Word;
    BytesWritten : {$IFNDEF OS2} Word; {$ELSE} LongInt; {$ENDIF}
    Result : Word;
  Begin
    With P^. PData^ Do
      If FileOpen Then Begin
        {Error or end-of-protocol, commit buffer and cleanup}
        BytesToWrite := FileOfs - StartOfs;
        BlockWrite (WorkFile, FileBuffer^, BytesToWrite, BytesWritten);
        Result := IOResult;
        If (Result <> 0) Then
          GotError (PR, epFatal + Result);
        If (BytesToWrite <> BytesWritten) Then
          GotError (PR, epFatal + ecDiskFull);

        Close (WorkFile);
        If IOResult <> 0 Then ;
        {FreeMemCheck(FileBuffer, FileBufferSize);}                    {!!.01}
        FileOpen := False;
      End;
  End;

  Function apWriteProtocolBlock (P : ProtocolRecPtr;
                                Var Block : DataBlockType;
                                BlockSize : Word) : Boolean;
    {-Write a protocol block (return True to quit)}
  Var
    Result : Word;
    BytesToWrite : Word;
    BytesWritten : {$IFNDEF OS2} Word; {$ELSE} LongInt; {$ENDIF}

  Procedure BlockWriteRTS;
      {-Set RTS before BlockWrite (assumes all BlockWrite params filled in)}
    Var
      OffState : Boolean;
      DTR, RTS    : Boolean;                                           {!!.01}
      CurrentlyOn : Boolean;                                           {!!.01}
    Begin
      With P^, PData^ Do Begin
        {$IFNDEF OS2}
        If FlagIsSet (apFlags, apRTSLowForWrite) Then Begin
          IntOff;                                                      {!!.01}
          GetModem (PR, DTR, RTS);                                      {!!.01}
          If FlagIsSet (PR^. HWFRecHonor, hfUseRTS) And
             FlagIsSet (PR^. HWFRecMask, hfRTSActiveLow)
          Then Begin
            OffState := True;
            CurrentlyOn := Not RTS;                                    {!!.01}
          End Else Begin                                               {!!.01}
            OffState := False;                                         {!!.01}
            CurrentlyOn := RTS;                                        {!!.01}
          End;                                                         {!!.01}
          If CurrentlyOn Then                                          {!!.01}
            SetRTS (PR, OffState);
          IntOn;                                                       {!!.01}
        End Else                                                       {!!.02}
        {$ENDIF}
          CurrentlyOn := False;                                        {!!.02}

        BlockWrite (WorkFile, FileBuffer^, BytesToWrite, BytesWritten);

        {$IFNDEF OS2}
        If FlagIsSet (apFlags, apRTSLowForWrite) And CurrentlyOn Then   {!!.01}
          SetRTS (PR, Not OffState);
        {$ENDIF}

        SetAsyncStatus (ecOk);                                          {!!.02}
      End;
    End;

  Begin
    SetAsyncStatus (ecOk);
    apWriteProtocolBlock := True;

    With P^. PData^ Do Begin
      If Not FileOpen Then Begin
        GotError (PR, epFatal + ecNotOpen);
        Exit;
      End;

      If FileOfs < LastOfs Then
        {This is a retransmitted block}
        If FileOfs > StartOfs Then Begin
          {FileBuffer has some good data, commit that data now}
          Seek (WorkFile, StartOfs);
          BytesToWrite := FileOfs - StartOfs;
          BlockWriteRTS;
          Result := IOResult;
          If (Result <> 0) Then Begin
            GotError (PR, epFatal + Result);
            Exit;
          End;
          If (BytesToWrite <> BytesWritten) Then Begin
            GotError (PR, epFatal + ecDiskFull);
            Exit;
          End;
        End
      Else Begin
        {Block is before data in buffer, discard data in buffer}
        StartOfs := FileOfs;
        EndOfs := StartOfs + FileBufferSize;
        {Position file just past last good data}
        Seek (WorkFile, FileOfs);
        Result := IOResult;
        If Result <> 0 Then Begin
          GotError (PR, epFatal + Result);
          Exit;
        End;
      End;

      {Will this block fit in the buffer?}
      If (FileOfs + BlockSize) > EndOfs Then Begin
        {Block won't fit, commit current buffer to disk}
        BytesToWrite := FileOfs - StartOfs;
        BlockWriteRTS;
        Result := IOResult;
        If (Result <> 0) Then Begin
          GotError (PR, epFatal + Result);
          Exit;
        End;
        If (BytesToWrite <> BytesWritten) Then Begin
          GotError (PR, epFatal + ecDiskFull);
          Exit;
        End;

        {Reset the buffer management vars}
        StartOfs := FileOfs;
        EndOfs := StartOfs + FileBufferSize;
        LastOfs := FileOfs;
      End;

      {Add this block to the buffer}
      Move (Block, FileBuffer^ [FileOfs - StartOfs], BlockSize);
      Inc (LastOfs, BlockSize);
      apWriteProtocolBlock := False;
    End;
  End;
  {$F-}

  Procedure apUserStatus (P : ProtocolRecPtr; Starting, Ending : Boolean);
    {-Calls user status routine while preserving AsyncStatus}
  Var
    SaveStatus : Word;
  Begin
    With P^. PData^ Do Begin
      SaveStatus := GetAsyncStatus;
      If (GetAsyncStatus = ecNoHeader) Or (GetAsyncStatus = ecGotHeader) Then
        SetAsyncStatus (ecOk);
      UserStatus (P, Starting, Ending);
      SetAsyncStatus (SaveStatus);
    End;
  End;

  Function TrimZeros (S : String) : String;
    {-Return a string with leading and trailing white space removed}
  Var
    I : Word;
    SLen : Byte Absolute S;
  Begin
    While (SLen > 0) And (S [SLen] <= ' ') Do
      Dec (SLen);

    I := 1;
    While (I <= SLen) And ( (S [I] <= ' ') Or (S [I] = '0') ) Do
      Inc (I);
    Dec (I);
    If I > 0 Then
      Delete (S, 1, I);

    TrimZeros := S;
  End;

  Function OctalStr (L : LongInt) : String;
    {-Convert L to octal base string}
  Const
    Digits : Array [0..7] Of Char = '01234567';
  Var
    I : Word;
  Begin
    OctalStr [0] := #12;
    For I := 0 To 11 Do Begin
      OctalStr [12 - I] := Digits [L And 7];
      L := L ShR 3;
    End;
  End;

  Function OctalStr2Long (S : String) : LongInt;
    {-Convert S from an octal string to a longint}
  Const
    HiMag = 10;
    Magnitude : Array [1..HiMag] Of LongInt =
    (1, 8, 64, 512, 4096, 32768, 262144, 2097152, 16777216, 134217728);
    ValidDigits : Set Of '0'..'7' = ['0', '1', '2', '3', '4', '5', '6', '7'];
  Var
    I, J : Integer;
    Len : Byte Absolute S;
    Part, Result : LongInt;
    Code : {$IFNDEF OS2} Word; {$ELSE} LongInt; {$ENDIF}
  Begin
    {Assume failure}
    OctalStr2Long := 0;

    {Remove leading blanks and zeros}
    S := TrimZeros (S);

    {Return 0 for invalid strings}
    If Len > HiMag Then
      Exit;

    {Convert it}
    Result := 0;
    J := 1;
    For I := Len Downto 1 Do Begin
      If Not (S [I] In ValidDigits) Then
        Exit;
      Val (S [I], Part, Code);
      Result := Result + Part * Magnitude [J];
      Inc (J);
    End;
    OctalStr2Long := Result
  End;

  Function PackToYMTimeStamp (RawTime : LongInt) : LongInt;
    {-Return date/time stamp as octal seconds since 1/1/1970 00:00 GMT}
  Var
    DT : DateTime;
    DTR : DateTimeRec;
    DiffDays : System. Word;
    DiffSecs : LongInt;
  Begin
    {Convert to julian date}
    UnpackTime (RawTime, DT);
    With DT Do Begin
      DTR. D := DMYtoDate (Day, Month, Year);
      DTR. T := HMStoTime (Hour, Min, Sec);
    End;

    {Subtract GMT hour offset}
    IncDateTime (DTR, DTR, 0, - (3600 * GmtHourOffset) );

    {Diff between date/time stamp and 1/1/1970 (in seconds)}
    DateTimeDiff (DTR, StartDate, DiffDays, DiffSecs);
    PackToYMTimeStamp := DiffSecs + (DiffDays * SecondsInDay);
  End;

  Function YMTimeStampToPack (YMTime : LongInt) : LongInt;
    {-Return a file time stamp in packed format from a Ymodem time stamp}
  Var
    DT : DateTime;
    DTR  : DateTimeRec;
    Ptime : LongInt;
    H, M, S : Byte;
  Begin
    {Add the time stamp to StartDate}
    IncDateTime (StartDate, DTR, 0, YMTime);

    {Add the GMT hour offset}
    IncDateTime (DTR, DTR, 0, 3600 * GmtHourOffset);

    {Convert to DT format}
    With DT Do
    Begin
      DateToDMY (DTR. D, Integer (Day), Integer (Month), Integer (Year) );
      TimeToHMS (DTR. T, H, M, S);
      Hour := H;
      Min := M;
      Sec := S;
    End;

    {Convert to packed format}
    PackTime (DT, Ptime);
    YMTimeStampToPack := Ptime;
  End;

  Function CurrentTimeStamp : LongInt;
    {-Return a Ymodem format file time stamp of the current date/time}
  Var
    Ptime : LongInt;
    DT : DateTime;
    Sec100, DOW : {$IFNDEF OS2} Word; {$ELSE} LongInt; {$ENDIF}
  Begin
    With DT Do Begin
      GetTime (Hour, Min, Sec, Sec100);
      GetDate (Year, Month, Day, DOW);
    End;
    PackTime (DT, Ptime);
    CurrentTimeStamp := PackToYMTimeStamp (Ptime);
  End;

End.