Category : Modula II Source Code
Archive   : M2PROT.ZIP
Filename : QCPROTO.MOD

(*# call(o_a_copy => off) *)
(*%F _fdata *)
(*# call(seg_name => null) *)
(*%E *)
(*# module(implementation=>on) *)
(*# data(seg_name => null) *)
IMPLEMENTATION MODULE QCproto;

(* This JPI Modula-2 module is part of *)

(* QC -- a communications program *)
(* by Carl Neiburger *)
(* 169 N. 25th St.*)
(* San Jose, Calif. 95116 *)

(* CompuServe No. 72336,2257 *)

FROM FioAsm IMPORT PathStr, PathTail;
FROM PathFind IMPORT FileTree, UnFileTree, FilePtr, ParsePath;
FROM Str IMPORT Append, Compare, Concat, Delete;
FROM QCdisp IMPORT PressKey, PromptForString, QCDef, Kermit, BPlus,
XModem, XModem1K, ZModem, Yes, ProtoNames;
FROM QCkermit IMPORT ReceiveKermit, SendKermit;
FROM QCxm IMPORT SimpleXmProtos, ReceiveXmodem, SendXmodem;
FROM QCzm IMPORT ReceiveZmodem, SendZmodem;
IMPORT NFIO;
FROM Storage IMPORT DEALLOCATE;

VAR
FilePath, FileName, GetFiles : PathStr;
dummy : ARRAY [0..66] OF CHAR;

PROCEDURE GetFileName;
VAR OK: BOOLEAN;
BEGIN
FilePath := '';
OK := FALSE;
REPEAT
IF PromptForString('File to receive (Return to abort): ', FileName) THEN
IF NFIO.Exists(FileName) THEN
Concat( dummy, FileName, ' Exists. OK to overwrite it?');
OK := Yes (dummy);
ELSE
OK := TRUE
END
END
UNTIL OK OR (FileName[0] = 0C );
END GetFileName;

PROCEDURE GetPath;
BEGIN
FileName[0] := 0C;
IF NOT PromptForString(
'Directory to put file in ("." for current; Return to abort):', FilePath ) THEN
RETURN
END;
LOOP
IF ParsePath( FilePath, PathTail(FileName) ) THEN
Append(FilePath, '\');
FileName[0] := 0C;
RETURN
ELSIF NOT
PromptForString(
'Directory was not valid. Enter directory (Return for current): ',
FilePath ) THEN
RETURN
END
END
END GetPath;

PROCEDURE ReceiveProtocol;
BEGIN
CASE QCDef.Protocol OF
BPlus : RETURN;
|XModem, XModem1K:
GetFileName;
IF FileName[0] = 0C THEN
PressKey('Transfer aborted.');
RETURN
END
ELSE
GetPath;
IF FilePath[0] = 0C THEN
PressKey('Transfer aborted.');
RETURN
END
END;
IF QCDef.Protocol = Kermit THEN
IF PromptForString(
'If connected to "server," files to GET; Otherwise Return: ',
GetFiles ) THEN END;
ReceiveKermit( FilePath, GetFiles )
ELSE
IF (QCDef.Protocol IN SimpleXmProtos) AND (FileName[0] = 0C) THEN
RETURN
END;
IF QCDef.Protocol = ZModem THEN
ReceiveZmodem( FilePath );
ELSE
ReceiveXmodem( FilePath, FileName )
END
END;
END ReceiveProtocol;

PROCEDURE SendProtocol;
VAR FileList, ThisFile, ThatFile, TempFile: FilePtr;
BatchFile : NFIO.File;
BEGIN
CASE QCDef.Protocol OF
BPlus : RETURN;
|XModem, XModem1K:
dummy := 'Enter file to send or Return to abort: '
ELSE
dummy := 'Enter file(s) to send or "/" + batch list file or Return to abort: '
END;
IF NOT PromptForString(dummy, FileName) THEN
RETURN
END;
IF FileName[0] = '/' THEN
Delete(FileName, 0, 1);
BatchFile := NFIO.Open(FileName);
IF BatchFile = MAX(CARDINAL) THEN
Concat(dummy, 'Cannot find ', FileName);
PressKey(dummy);
RETURN
END;
FileList := NIL;
WHILE NOT NFIO.EOF(BatchFile) DO
NFIO.RdStr(BatchFile, FileName);
IF FileName[0] <> 0C THEN
IF FileList = NIL THEN
FileList := FileTree ( FileName );
ThisFile := FileList;
ELSE
ThisFile^.Next := FileTree ( FileName );
END;
WHILE (ThisFile <> NIL) AND (ThisFile^.Next <> NIL) DO
ThisFile := ThisFile^.Next
END
END
END;
NFIO.Close(BatchFile);
WHILE ThisFile^.Next <> NIL DO (* delete any duplicates *)
ThatFile := ThisFile;
WHILE ThatFile^.Next <> NIL DO
IF Compare(ThisFile^.Name, ThatFile^.Next^.Name) = 0 THEN
TempFile := ThatFile^.Next;
ThatFile^.Next := TempFile^.Next;
DISPOSE(TempFile)
ELSE
ThatFile := ThatFile^.Next
END;
END;
ThisFile := ThisFile^.Next
END
ELSE
FileList := FileTree ( FileName )
END;
IF FileList <> NIL THEN
CASE QCDef.Protocol OF
Kermit : SendKermit( FileList );
|ZModem : SendZmodem( FileList )
|ELSE SendXmodem( FileList )
END;
UnFileTree( FileList )
ELSE
PressKey('No matching files');
END
END SendProtocol;

END QCproto.