(* 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 iSizeInBytes 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.