Topspeed_JPI/TS-V3/SRC/YMODEM.MOD

(* Release 3.10 *)
(*-------------------------------------------------------------------------*
*                                                                          *
*  YMODEM.MOD - COMMS Toolkit YMODEM file protocol                         *
*                                                                          *
*  COPYRIGHT (C) 1988..1992 Clarion Software Corporation.                  *
*  All Rights Reserved                                                     *
*                                                                          *
*--------------------------------------------------------------------------*)

IMPLEMENTATION MODULE YModem;
  IMPORT CommUtil,Filenames,FIO,FTSupport,Lib,RS232,SPRINTF,Str;
  FROM FTSupport        IMPORT ACK,CAN,CRCREQ,EOT,NAK,SOH,STX;
  (* This module is basically just a modified XModem module - simple     *)
  (* Ymodem especially is just Xmodem with 1k blocks. The Seperate       *)
  (* Xmodem is just for clarity..                                        *)

  VAR
    f                   : FIO.File;
    Response            : CHAR;
    CRCCheck,
    ResponseWaiting,
    NoACKS              : BOOLEAN;
    LastBlockNo,BlockNo,
    BlockSize           : CARDINAL;

(*..................................................*)

  PROCEDURE InitVars(VAR Filename:ARRAY OF CHAR);
    BEGIN
      FTSupport.Errors:=0;
      FTSupport.LastMessage:='';
      FTSupport.XferMode := 'CRC';
      FTSupport.Transferred:=0;
      FTSupport.Aborted := FALSE;
      FTSupport.SizeInBytes:=0;
      Str.Copy(FTSupport.FileSpec,Filename);
      BlockNo:=1;
      LastBlockNo:=0FFFFH;
      BlockSize:=128;
      CRCCheck:=TRUE;
    END InitVars;

(*...............................................*)

  PROCEDURE ReceiveData():CARDINAL;
    VAR
      c                 : CHAR;
      RxBlk,CRC,RxCRC,
      CheckSum,Result,
      Cnt,CRCIndex      : CARDINAL;
      RxState           : (Blk,Compl,Data,Chk,CRCH,CRCL,Flushing);
    BEGIN
      (* Already had the first character SOH or STX *)
      RxState:=Blk;
      CRC:=0;
      CheckSum:=0;
      Cnt:=0;
      Result:=0;
      LOOP
        IF FTSupport.Aborted THEN
          RETURN(128+6);
        END;
        IF NOT RS232.SerialRead(c,50) THEN
          IF RxState=Flushing THEN
            RETURN(Result);
          ELSE
            FTSupport.LastMessage := 'Timeout';
            RETURN(3);
          END;
        END;
        CASE RxState OF
          Blk           : RxBlk := ORD(c);
                          RxState := Compl;                               |
          Compl         : IF 255-ORD(c)<>RxBlk THEN
                            Result:=11;
                            FTSupport.LastMessage:='Bad Block No';
                            RxState:=Flushing;
                          ELSIF RxBlk=LastBlockNo THEN
                            Result := 15;
                            RxState := Data;
                          ELSIF RxBlk<>BlockNo THEN
                            Result := 128+10;
                            FTSupport.LastMessage := 'Sequence Error';
                            RxState := Flushing;
                          ELSE
                            RxState := Data;
                          END;                                            |
          Data          : FTSupport.FBuff[Cnt] := c;
                          IF CRCCheck THEN
                            CRCIndex := CARDINAL(BITSET(CRC>>8)/BITSET(ORD(c)));
                            CRC := CARDINAL(BITSET(FTSupport.CRCTable[CRCIndex])/BITSET(CRC<<8))
                          ELSE
                            CheckSum := (CheckSum+ORD(c)) MOD 100H;
                          END;
                          INC(Cnt);
                          IF Cnt=BlockSize THEN
                            IF CRCCheck THEN
                              RxState:=CRCH;
                            ELSE
                              RxState:=Chk;
                            END;
                          END;                                            |
          Chk           : IF ORD(c)=CheckSum THEN
                            RETURN Result;
                          ELSE
                            Result := 8;
                            FTSupport.LastMessage := 'Bad Checksum';
                            RxState := Flushing;
                          END;                                            |
          CRCH          : RxCRC := ORD(c)<<8;
                          RxState := CRCL;                                |
          CRCL          : RxCRC := RxCRC+ORD(c);
                          IF CRC=RxCRC THEN
                            RETURN Result;
                          ELSE
                            Result := 9;
                            FTSupport.LastMessage := 'Bad CRC';
                            RxState := Flushing;
                          END;                                            |
          Flushing      : (* do nothing *)                                |
        END; (* case *)
      END; (* loop *)
    END ReceiveData;

(*...............................................*)

  PROCEDURE YMReceive(OneBlockOnly:BOOLEAN):CARDINAL;
    VAR
      c                 : CHAR;
      EOTCount,Result   : CARDINAL;
      IncomingData,
      Negotiating,
      EndOfFile,Skippit : BOOLEAN;
    BEGIN
      Negotiating:=TRUE;
      EOTCount:=0;
      Skippit:=FALSE;
      EndOfFile:=FALSE;
      REPEAT
        IncomingData := FALSE;
        REPEAT
          FTSupport.UpdateStatus;
          IF FTSupport.Aborted THEN
            RETURN(6);
          END;
          IF (NOT Skippit) AND ((Response<>ACK) OR (NOT NoACKS)) THEN
            RS232.SerialWrite(Response,1);
          END;
          Skippit := FALSE;
          LOOP
            IF RS232.SerialRead(c,100) THEN
              IF (c=SOH) OR (c=EOT) OR (c=STX) THEN
                FTSupport.LastMessage:='';
                Negotiating:=FALSE;
                IncomingData := TRUE;
                EXIT;
              END;
            ELSE
              Response := NAK;
              IF NOT NoACKS THEN
                RS232.SerialWrite(Response,1);
              END;
              FTSupport.LastMessage := 'Timeout';
              INC(FTSupport.Errors);
              IF (NoACKS) OR (FTSupport.Errors>1) THEN
                IF Negotiating THEN
                  RETURN(1);
                ELSE
                  RETURN(2);
                END;
              END;
              EXIT;
            END;
          END;
        UNTIL IncomingData;
        IF c=EOT THEN
          FTSupport.LastMessage := 'End of File';
          INC(EOTCount);
          IF (EOTCount=2) OR (NoACKS) THEN
            EndOfFile := TRUE;
            Response:=ACK;
            RS232.SerialWrite(Response,1);
          ELSE
            Response:=NAK
          END;
        ELSE
          EOTCount:=0;
          IF (c=SOH) THEN
            BlockSize:=128;
          ELSE
            BlockSize:=1024;
          END;
          Result := ReceiveData();
          IF Result=0 THEN
            (* ACK good blocks immediately so that the background receiver can*)
            (* be getting the next packet while we write this one to disk.    *)
            Response := ACK;
            IF NOT NoACKS THEN
              RS232.SerialWrite(Response,1);
            END;
            Skippit := TRUE;
            LastBlockNo := BlockNo;
            BlockNo := (BlockNo+1) MOD 100H;
            IF OneBlockOnly THEN
              RETURN(0);
            END;
            IF FTSupport.SizeInBytes>0 THEN
              IF FTSupport.Transferred+LONGCARD(BlockSize)>FTSupport.SizeInBytes THEN
                BlockSize := CARDINAL(FTSupport.SizeInBytes-FTSupport.Transferred);
              END;
            END;
            FIO.WrBin(f,FTSupport.FBuff,BlockSize);
            IF FIO.IOresult()<>0 THEN
              FTSupport.LastMessage := 'Disk Write Error';
              FTSupport.UpdateStatus;
              RETURN(4);
            END;
            FTSupport.Transferred := FTSupport.Transferred+LONGCARD(BlockSize);
            FTSupport.Errors:=0;
            FTSupport.LastMessage:='';
            FTSupport.UpdateStatus;
          ELSIF Result=15 THEN
            (* Sender resent previous block - ACK and ignore *)
            Response := ACK;
            FTSupport.Errors := 0;
            FTSupport.LastMessage := '';
            FTSupport.UpdateStatus;
          ELSE
            INC(FTSupport.Errors);
            FTSupport.UpdateStatus;
            IF (Result>127) OR NoACKS (*fatal*) THEN
              FTSupport.Aborted := TRUE;
              RETURN(Result MOD 100H);
            END;
            Response := NAK;
            IF FTSupport.Errors>5 (* too many *) THEN
              RETURN(Result);
            END;
          END;
        END;
      UNTIL EndOfFile OR FTSupport.Aborted;
      IF FTSupport.Aborted THEN
        RETURN(6);
      ELSE
        RETURN(0);
      END;
    END YMReceive;

(*...............................................*)

  PROCEDURE YModemReceive(VAR Filename:ARRAY OF CHAR):CARDINAL;
    VAR
      Result            : CARDINAL;
      HookSave          : BOOLEAN;
    BEGIN
      InitVars(Filename);
      FTSupport.CompleteFilename;
      f := FIO.Create(FTSupport.FileSpec);
      IF FIO.IOresult()=0 THEN
        HookSave := RS232.Hooked;
        RS232.Hooked := FTSupport.HookOnFT;
        FTSupport.OpenStatusWindow('YModem Download');
        FTSupport.NewFilename;
        Response := CRCREQ;
        Result := YMReceive(FALSE);
        IF Result=1 THEN
          CRCCheck:=FALSE;
          FTSupport.XferMode:='CHK';
          Response := NAK;
          Result := YMReceive(FALSE);
        END;
        FIO.Close(f);
        IF FTSupport.Aborted THEN
          FTSupport.Cancel;
        END;
        FTSupport.CloseStatusWindow;
        RS232.Hooked := HookSave;
        RETURN Result;
      ELSE
        CommUtil.ErrorMessage('Could not open file!');
        RETURN 12;
      END;
    END YModemReceive;

(*..................................................*)

  PROCEDURE GetFileDetails(VAR Filename:ARRAY OF CHAR; VAR Size:LONGCARD);
    VAR
      i                 : CARDINAL;
      c                 : CHAR;
    BEGIN
      i := 0;
      REPEAT
        c := FTSupport.FBuff[i];
        Filename[i] := c;
        INC(i);
      UNTIL c = 0C;
      Size := 0;
      c := FTSupport.FBuff[i];
      WHILE (c>='0') AND (c<='9') DO
        Size := Size*10 + LONGCARD(ORD(c)-48);
        INC(i);
        c := FTSupport.FBuff[i];
      END;
    END GetFileDetails;

(*...............................................*)

  PROCEDURE YModemBatchReceive():CARDINAL;
    VAR
      c                 : CHAR;
      Result            : CARDINAL;
      HookSave          : BOOLEAN;
    BEGIN
      HookSave := RS232.Hooked;
      RS232.Hooked := FTSupport.HookOnFT;
      FTSupport.OpenStatusWindow('YModem Batch Download');
      REPEAT
        FTSupport.FileSpec:='';
        InitVars(FTSupport.FileSpec);
        BlockNo := 0;
        IF NoACKS THEN
          Response:='G';
          Result := YMReceive(TRUE);
        END;
        IF (NOT NoACKS) OR (Result=1) THEN
          NoACKS := FALSE;
          Response := CRCREQ;
          Result := YMReceive(TRUE);
          IF Result=1 THEN
            CRCCheck:=FALSE;
            FTSupport.XferMode:='CHK';
            Response := NAK;
            Result := YMReceive(TRUE);
          END;
        END;
        IF Result=0 THEN
          IF NOT NoACKS THEN
            RS232.SerialWrite(ACK,1);
          END;
          GetFileDetails(FTSupport.FileSpec,FTSupport.SizeInBytes);
          IF FTSupport.FileSpec[0]<>0C THEN
            FTSupport.CompleteFilename;
            f := FIO.Create(FTSupport.FileSpec);
            IF FIO.IOresult()<>0 THEN
              RS232.Hooked := HookSave;
              RETURN(12);
            END;
            FTSupport.NewFilename;
            Response := CRCREQ;
            BlockNo := 1;
            Result := YMReceive(FALSE);
            IF Result=1 THEN
              CRCCheck:=FALSE;
              FTSupport.XferMode:='CHK';
              Response := NAK;
              Result := YMReceive(FALSE);
            END;
            FIO.Close(f);
          END;
        END;
      UNTIL (Result<>0) OR FTSupport.Aborted OR (FTSupport.FileSpec[0]=0C);
      IF FTSupport.Aborted THEN
        FTSupport.Cancel;
      END;
      FTSupport.CloseStatusWindow;
      RS232.Hooked := HookSave;
      RETURN Result;
    END YModemBatchReceive;

(*..................................................*)

  PROCEDURE YModemGReceive():CARDINAL;
    VAR
      Result            : CARDINAL;
    BEGIN
      NoACKS := TRUE;
      FTSupport.OpenStatusWindow('YModem-g Batch Download');
      Result := YModemBatchReceive();
      NoACKS := FALSE;
      RETURN Result;
    END YModemGReceive;

(*..................................................*)

  PROCEDURE GetResponse(VAR c:CHAR):CARDINAL;
    VAR
      CANCount          : CARDINAL;
      GotResponse       : BOOLEAN;
    BEGIN
      CANCount := 0;
      REPEAT
        IF FTSupport.AbortRequested() THEN
          RETURN(6);
        END;
        IF ResponseWaiting THEN
          c:=Response;
          GotResponse:=TRUE;
          ResponseWaiting:=FALSE;
        ELSE
          GotResponse := RS232.SerialRead(c,100);
        END;
        IF GotResponse THEN
          IF c=CAN THEN
            INC(CANCount);
            IF CANCount=3 THEN
              RETURN(13);
            END;
          END;
        ELSE
          FTSupport.LastMessage := 'Timeout';
          INC(FTSupport.Errors);
          FTSupport.UpdateStatus;
          IF FTSupport.Errors=5 THEN
            RETURN(2);
          END;
        END;
      UNTIL GotResponse AND ((c=NAK) OR (c=ACK) OR (c=CRCREQ));
      FTSupport.LastMessage := '';
      FTSupport.UpdateStatus;
      RETURN 0;
    END GetResponse;

(*..................................................*)

  PROCEDURE SendBlock(VAR c:CHAR):CARDINAL;
    VAR
      Result,i,Lnth,
      CRC,CheckSum,
      CRCIndex          : CARDINAL;
      Header            : ARRAY[0..2] OF CHAR;
    BEGIN
      CRC:=0;
      CheckSum:=0;
      Lnth:=BlockSize;
      IF Lnth=128 THEN
        Header[0]:=SOH;
      ELSE
        Header[0]:=STX;
      END;
      Header[1]:=CHR(BlockNo);
      Header[2]:=CHR(255-BlockNo);
      RS232.SerialWrite(Header,3);
      IF CRCCheck THEN
        FOR i:=0 TO Lnth-1 DO
          RS232.SerialWrite(FTSupport.FBuff[i],1);
          CRCIndex := CARDINAL(BITSET(CRC>>8)/BITSET(ORD(FTSupport.FBuff[i])));
          CRC := CARDINAL(BITSET(FTSupport.CRCTable[CRCIndex])/BITSET(CRC<<8))
        END;
        FTSupport.FBuff[Lnth] := CHR(CRC DIV 100H);
        FTSupport.FBuff[Lnth+1] := CHR(CRC MOD 100H);
        RS232.SerialWrite(FTSupport.FBuff[Lnth],2);
        INC(Lnth,2);
      ELSE
        FOR i:=0 TO Lnth-1 DO
          RS232.SerialWrite(FTSupport.FBuff[i],1);
          CheckSum := (CheckSum + ORD(FTSupport.FBuff[i])) MOD 100H;
        END;
        FTSupport.FBuff[Lnth] := CHR(CheckSum);
        RS232.SerialWrite(CHR(CheckSum),1);
        INC(Lnth);
      END;
      REPEAT
        IF NOT NoACKS THEN
          Result := GetResponse(c);
          IF Result # 0 THEN
            RETURN(Result);
          END;
          IF c # ACK THEN
            FTSupport.LastMessage := 'Received NAK';
            INC(FTSupport.Errors);
            FTSupport.UpdateStatus;
            IF FTSupport.Errors=5 THEN
              RETURN(14);
            END;
            RS232.SerialWrite(Header,3);
            RS232.SerialWrite(FTSupport.FBuff,Lnth);
          END;
        ELSE
          c:=ACK;
          IF FTSupport.AbortRequested() THEN
            RETURN(6);
          END;
        END;
      UNTIL c = ACK;
      RETURN 0;
    END SendBlock;

(*..................................................*)

  PROCEDURE GetStartChar(VAR c:CHAR):CARDINAL;
    VAR
      Result            : CARDINAL;
    BEGIN
      REPEAT
        Result := GetResponse(c);
        IF Result<>0 THEN
          RETURN(Result);
        END;
      UNTIL (c=NAK) OR (c=CRCREQ) OR (c='G');
      IF c=NAK THEN
        CRCCheck:=FALSE;
        FTSupport.XferMode:='CHK'
      END;
      RS232.FlushInBuf;
      RETURN 0;
    END GetStartChar;

(*..................................................*)

  PROCEDURE YMSend():CARDINAL;
    VAR
      c                 : CHAR;
      Result,BytesRead,
      CANCount          : CARDINAL;
    BEGIN
      Result := GetStartChar(c);
      IF Result<>0 THEN
        RETURN(Result);
      END;
      FTSupport.UpdateStatus;
      WHILE NOT FIO.EOF DO
        BytesRead := FIO.RdBin(f,FTSupport.FBuff,BlockSize);
        IF FIO.IOresult()<>0 THEN
          RETURN(5);
        END;
        IF BytesRead<BlockSize THEN
          Lib.Fill(ADR(FTSupport.FBuff[BytesRead]),BlockSize-BytesRead,CHR(26));
        END;
        FTSupport.Errors := 0;
        Result := SendBlock(c);
        IF Result<>0 THEN
          RETURN(Result);
        END;
        FTSupport.LastMessage := '';
        FTSupport.Transferred := FTSupport.Transferred+LONGCARD(BlockSize);
        BlockNo := (BlockNo+1) MOD 100H;
        FTSupport.Errors := 0;
        FTSupport.UpdateStatus;
      END;
      FTSupport.LastMessage := 'End of File';
      FTSupport.UpdateStatus;
      REPEAT
        REPEAT
          RS232.SerialWrite(EOT,1);
          Result := GetResponse(c);
          IF Result<>0 THEN
            RETURN(Result);
          END;
        UNTIL (c=NAK) OR (c=ACK);
      UNTIL c=ACK;
      RETURN 0;
    END YMSend;

(*..................................................*)

  PROCEDURE YModemSend(VAR Filename:ARRAY OF CHAR):CARDINAL;
    VAR
      Result            : CARDINAL;
      HookSave          : BOOLEAN;
    BEGIN
      IF FIO.Exists(Filename) THEN
        HookSave := RS232.Hooked;
        RS232.Hooked := FTSupport.HookOnFT;
        InitVars(Filename);
        BlockSize := 1024;
        f := FIO.Open(Filename);
        FIO.EOF := FALSE;
        FTSupport.SizeInBytes := FIO.Size(f);
        FTSupport.OpenStatusWindow('YModem Upload');
        FTSupport.NewFilename;
        Result := YMSend();
        FTSupport.CloseStatusWindow;
        RS232.Hooked := HookSave;
        FIO.Close(f);
        RETURN Result;
      ELSE
        CommUtil.ErrorMessage('Could not open file!');
        RETURN 7;
      END;
    END YModemSend;

(*..................................................*)

  PROCEDURE GetPath(Wild:ARRAY OF CHAR; VAR Path:ARRAY OF CHAR):BOOLEAN;
    VAR
      Drive,Ext         : ARRAY[0..4] OF CHAR;
      Name              : ARRAY[0..12] OF CHAR;
    BEGIN
      IF NOT Filenames.ParseFilename(Wild,Drive,Path,Name,Ext) THEN
        RETURN(FALSE);
      END;
      Name := '';
      Ext:='';
      Filenames.MakeFilename(Drive,Path,Name,Ext,Path);
      RETURN TRUE;
    END GetPath;

(*...............................................*)

  PROCEDURE YModemBatchSend(VAR Wild:ARRAY OF CHAR):CARDINAL;
    VAR
      c                 : CHAR;
      GotFile           : BOOLEAN;
      Result            : CARDINAL;
      Path              : ARRAY[0..70] OF CHAR;
      entry             : FIO.DirEntry;
      HookSave          : BOOLEAN;
    BEGIN
      IF GetPath(Wild,Path) THEN
        HookSave := RS232.Hooked;
        RS232.Hooked := FTSupport.HookOnFT;
        FTSupport.OpenStatusWindow('YModem Batch Upload');
        GotFile := FIO.ReadFirstEntry(Wild,FIO.FileAttr{},entry);
        WHILE GotFile DO
          FTSupport.FileSpec:='';
          InitVars(FTSupport.FileSpec);
          Str.Concat(FTSupport.FileSpec,Path,entry.Name);
          FTSupport.NewFilename;
          f := FIO.Open(FTSupport.FileSpec);
          FIO.EOF := FALSE;
          FTSupport.SizeInBytes := FIO.Size(f);
          Lib.Fill(ADR(FTSupport.FBuff),128,0C);
          SPRINTF.SPrintF2('%s\000%u',entry.Name,FTSupport.SizeInBytes,FTSupport.FBuff);
          BlockNo := 0;
          Result := GetStartChar(c);
          IF Result<>0 THEN
            FIO.Close(f);
            FTSupport.CloseStatusWindow;
            RETURN(Result);
          END;
          IF c='G' THEN
            NoACKS:=TRUE;
          END;
          REPEAT
            Result := SendBlock(c);
            IF Result<>0 THEN
              FIO.Close(f);
              NoACKS:=FALSE;
              FTSupport.CloseStatusWindow;
              RETURN Result;
            END;
          UNTIL c<>NAK;
          Response := c;
          ResponseWaiting := TRUE;
          BlockNo:=1;
          BlockSize:=1024;
          Result := YMSend();
          FIO.Close(f);
          IF Result<>0 THEN
            FTSupport.CloseStatusWindow;
            NoACKS:=FALSE;
            RETURN(Result);
          END;
          GotFile := FIO.ReadNextEntry(entry);
        END;
        BlockNo:=0;
        BlockSize:=128;
        Lib.Fill(ADR(FTSupport.FBuff),128,0C);
        Result := GetStartChar(c);
        IF Result=0 THEN
          Result := SendBlock(c);
        END;
        FTSupport.CloseStatusWindow;
        RS232.Hooked := HookSave;
      ELSE
        CommUtil.ErrorMessage('Bad filename');
        RETURN 7;
      END;
      RETURN 0;
    END YModemBatchSend;

(*..................................................*)

  BEGIN
    ResponseWaiting := FALSE;
    NoACKS := FALSE;
  END YModem.