Topspeed_JPI/TS-V3/SRC/FTSUPPOR.MOD

(* Release 3.10 *)
(*-------------------------------------------------------------------------*
*                                                                          *
*  FTSUPPOR.MOD - COMMS Toolkit FTP support                                *
*                                                                          *
*  COPYRIGHT (C) 1988..1992 Clarion Software Corporation.                  *
*  All Rights Reserved                                                     *
*                                                                          *
*--------------------------------------------------------------------------*)

IMPLEMENTATION MODULE FTSupport;
  IMPORT CommUtil,ComSetup,Filenames,FIO,IO,Keyboard,Lib,MPRINTF,RS232,Str,
         Timer,Window;
  FROM Window           IMPORT Color;
  FROM CommUtil         IMPORT StatusFields;
  FROM ComSetup         IMPORT CrTypes;

  CONST
    FTStatWinDef        = Window.WinDef(35,5,69,14,LightCyan,Black,FALSE,FALSE,FALSE,TRUE,Window.SingleFrame,LightGray,Black);

  VAR
    SizeIncr,HalfIncr,
    BaudIncr,HalfBaud   : LONGCARD;
    StatusWindowOpen,
    CarrierLost         : BOOLEAN;
    BuffPtr,BuffCnt,
    TimeCount           : CARDINAL;
    Buffer              : ARRAY[0..260] OF CHAR;
    StatWin             : Window.WinType;

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

  PROCEDURE OpenStatusWindow(Title:ARRAY OF CHAR);
    VAR
      i                 : CARDINAL;
      Def               : Window.WinDef;
    BEGIN
      IF StatusWindowOpen THEN
        RETURN;
      END;
      Def := FTStatWinDef;
      WITH Def DO
        Foreground := CommUtil.Colors.FTStatFore;
        Background := CommUtil.Colors.FTStatBack;
        FrameFore  := CommUtil.Colors.FTStatFrFore;
        FrameBack  := CommUtil.Colors.FTStatFrBack;
      END;
      StatWin := Window.Open(Def);
      Window.SetTitle(StatWin,Title,Window.LeftUpperTitle);
      Window.GotoXY(2,1);
      IO.WrStr('File:');
      Window.GotoXY(2,2);
      IO.WrStr('Progress:');
      Window.GotoXY(2,3);
      IO.WrStr('Est Mins:');
      Window.GotoXY(2,4);
      IO.WrStr('Size:');
      Window.GotoXY(2,5);
      IO.WrStr('Mode:');
      Window.GotoXY(2,6);
      IO.WrStr('Bytes:');
      Window.GotoXY(2,7);
      IO.WrStr('Errors:');
      Window.GotoXY(2,8);
      IO.WrStr('Last Msg:');
      Window.GotoXY(12,2);
      IO.WrStr('ÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛ');
      BuffPtr := 0;
      BuffCnt := 0;
      StatusWindowOpen := TRUE;
      BaudIncr := LONGCARD(ComSetup.Setup.Serial.Baud)*6;
      HalfBaud := BaudIncr DIV 2;
      TimeCount := 0;
      Window.TextColor(CommUtil.Colors.FTStatHigh);
    END OpenStatusWindow;

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

  PROCEDURE NewFilename;
    VAR
      temps,Path        : ARRAY[0..80] OF CHAR;
      Name              : ARRAY[0..12] OF CHAR;
      Drive,Ext         : ARRAY[0..3] OF CHAR;
    BEGIN
      IF Filenames.ParseFilename(FileSpec,Drive,Path,Name,Ext) THEN
        Drive:='';
        Path:='';
        Filenames.MakeFilename(Drive,Path,Name,Ext,temps);
      END;
      Window.GotoXY(12,1);
      MPRINTF.PrintF1('%-12s',temps);
    END NewFilename;

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

  PROCEDURE CompleteFilename;
    VAR
      Path              : ARRAY[0..80] OF CHAR;
      Name              : ARRAY[0..12] OF CHAR;
      Drive,Ext         : ARRAY[0..3] OF CHAR;
    BEGIN
      IF Filenames.ParseFilename(FileSpec,Drive,Path,Name,Ext) & (Drive[0]=0C) & (Path[0]=0C) THEN
        Filenames.MakeFilename(Drive,ComSetup.Setup.General.DownloadDir,Name,Ext,FileSpec)
      END;
    END CompleteFilename;

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

(*# save,check(overflow=>off)*)
  PROCEDURE ShowProgress;
    VAR
      Mins              : LONGCARD;
      i,RealLnth,Lnth   : CARDINAL;
      Line              : ARRAY[0..20] OF CHAR;
    BEGIN
      IF SizeInBytes<>0 THEN
        Mins := (((SizeInBytes-Transferred)+HalfBaud) DIV BaudIncr)+1;
        Window.GotoXY(12,3);
        IO.WrLngCard(Mins,4);
        Window.GotoXY(12,2);
        Window.TextColor(CommUtil.Colors.FTStatFore);
        Window.TextBackground(CommUtil.Colors.FTStatBar);
        IF SizeIncr <> 0 THEN
          Lnth := CARDINAL((Transferred+HalfIncr) DIV SizeIncr);
          IF Lnth>40 THEN
            Lnth:=40;
          END;
          RealLnth := Lnth DIV 2;
          Lib.Fill(ADR(Line),RealLnth,' ');
          IF ODD(Lnth) THEN
            Line[RealLnth]:=CHR(222);
            INC(RealLnth);
          END;
          Line[RealLnth] := 0C;
          IO.WrStr(Line);
        END;
        Window.TextColor(CommUtil.Colors.FTStatHigh);
        Window.TextBackground(CommUtil.Colors.FTStatBack);
      END;
    END ShowProgress;
(*# restore *)

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

  PROCEDURE UpdateStatus;
    BEGIN
      IF AbortRequested() THEN
        RETURN;
      END;
      Window.GotoXY(12,4);
      MPRINTF.PrintF1('%-8u',SizeInBytes);
      Window.GotoXY(12,5);
      MPRINTF.PrintF1('%-8s',XferMode);
      Window.GotoXY(12,6);
      MPRINTF.PrintF1('%-8u',Transferred);
      Window.GotoXY(12,7);
      MPRINTF.PrintF1('%-8u',Errors);
      Window.GotoXY(12,8);
      MPRINTF.PrintF1('%-20s',LastMessage);
      SizeIncr := (SizeInBytes+20) DIV 40;
      HalfIncr := SizeIncr DIV 2;
      ShowProgress;
      CommUtil.StatusLine(time);
      Window.Use(StatWin);
    END UpdateStatus;

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

  PROCEDURE CloseStatusWindow;
    BEGIN
      IF NOT StatusWindowOpen THEN
        RETURN;
      END;
      IF Aborted THEN
        Window.SetTitle(StatWin,'Aborted',Window.LeftUpperTitle);
      END;
      CommUtil.Alarm;
      Aborted := FALSE;
      Window.Close(StatWin);
      CommUtil.StatusLine(time);
      StatusWindowOpen := FALSE;
    END CloseStatusWindow;

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

  PROCEDURE Cancel;
    VAR
      i                 : CARDINAL;
      CanArray          : ARRAY[0..15] OF CHAR;
    BEGIN
      FOR i:=0 TO 7 DO
        CanArray[i]:=CAN;
      END;
      FOR i:=0 TO 7 DO
        CanArray[i+8]:=CHR(8);
      END;
      RS232.SerialWrite(CanArray,8);
    END Cancel;

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

  PROCEDURE AbortRequested():BOOLEAN;
    VAR
      c                 : CHAR;
    BEGIN
      IF NOT Aborted THEN
        WHILE Keyboard.KeyPressed() DO
          c := Keyboard.RdKey();
          IF c=CHR(27) THEN
            Aborted := TRUE;
          END;
        END;
      END;
      RETURN Aborted;
    END AbortRequested;

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

  PROCEDURE FlushInput;
    VAR
      c                 : CHAR;
    BEGIN
      WHILE RS232.SerialRead(c,0) DO
        (* Flush *)
      END;
    END FlushInput;

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

  PROCEDURE ASCIISend(VAR Filename:ARRAY OF CHAR):CARDINAL;
    VAR
      f                 : FIO.File;
      Lnth              : CARDINAL;

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

    PROCEDURE SendLine;
      VAR
        i               : CARDINAL;
      BEGIN
        i:=0;
        WHILE i<Lnth DO
          RS232.SerialWrite(FBuff[i],1);
          Lib.Delay(ComSetup.Setup.ASCII.CharDelayMS);
          INC(i);
        END;
      END SendLine;

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

    BEGIN (* ASCIISend *)
      f := FIO.Open(Filename);
      FIO.EOF := FALSE;
      IF FIO.IOresult()=0 THEN
        OpenStatusWindow('ASCII Upload');
        Str.Copy(FileSpec,Filename);
        SizeInBytes := FIO.Size(f);
        Transferred := 0;
        XferMode:='';
        Errors:=0;
        LastMessage:='';
        Aborted := FALSE;
        NewFilename;
        UpdateStatus;
        WHILE (NOT FIO.EOF) AND (NOT AbortRequested()) DO
          FIO.RdStr(f,FBuff);
          Lnth := Str.Length(FBuff);
          Transferred := Transferred + LONGCARD(Lnth+2);
          IF Transferred>SizeInBytes THEN
            Transferred:=SizeInBytes;
          END;
          FBuff[Lnth]:=CHR(13);
          INC(Lnth);
          IF ComSetup.Setup.General.CROutTranslation=CRLF THEN
            FBuff[Lnth]:=CHR(10);
            INC(Lnth);
          END;
          SendLine;
          UpdateStatus;
          FlushInput;
          Lib.Delay(ComSetup.Setup.ASCII.LineDelayMS);
        END;
        FIO.Close(f);
        CloseStatusWindow;
        RETURN ORD(Aborted)
      ELSE
        CommUtil.ErrorMessage('No such file.');
        RETURN 2;
      END;
    END ASCIISend;

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

  PROCEDURE MakeCRCTable;
    CONST
      POLY              = 1021H;
    VAR
      Entry,i,CRC       : CARDINAL;
    BEGIN
      FOR Entry:=0 TO 255 DO
        CRC := Entry<<8;
        FOR i:=0 TO 7 DO
          IF 15 IN BITSET(CRC) THEN
            CRC := CARDINAL(BITSET(CRC<<1) / BITSET(POLY))
          ELSE
            CRC := CRC<<1
          END;
        END;
        CRCTable[Entry] := CRC;
      END;
    END MakeCRCTable;

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

    BEGIN
      MakeCRCTable;
      StatusWindowOpen := FALSE;
      Aborted := FALSE;
      HookOnFT := FALSE;
    END FTSupport.