Category : Modula II Source Code
Archive   : FLXCPY10.ZIP
Filename : COPYFILE.MOD

 
Output of file : COPYFILE.MOD contained in archive : FLXCPY10.ZIP
IMPLEMENTATION MODULE CopyFiles;
(* Routines to copy and move files. *)

FROM Streams IMPORT STREAM, Connect, Disconnect, input, output, EOS,
ReadRec, WriteRec, ReadChar, WriteChar, BufferStream,
RenameFile, DeleteFile;
FROM System IMPORT BYTE, ADR, TSIZE;
FROM Terminal IMPORT WriteString, Write, WriteLn, Read, BusyRead, CharRead;
FROM Storage IMPORT ALLOCATE, DEALLOCATE;
FROM DirInfo IMPORT GetDirectory, DirEntry;
FROM MSDOS IMPORT Registers,MSDOS,gtmfc,gdtfc,gscfc,GetSegs,Carry;


CONST
BufferSize = 64000;
Beep = 07x;
Backspace = 08x;

TYPE
DataBuffer = ARRAY [0..(BufferSize-1)] OF BYTE;
VAR
Buffer : POINTER TO DataBuffer;
DontCopy : BOOLEAN; (* set false in ReportAction if Prompt is
TRUE and user answers NO *)

PROCEDURE setDate( s : STREAM; d, t : CARDINAL);
VAR
r : Registers;
BEGIN (* setDate *)
GetSegs(r);
WITH r DO
AH:=gscfc; (*get/set dat/time - function 57h*)
AL:=1; (*set sub-code*)
BX:=s;
CX := t;
DX := d;
MSDOS(r);
END; (* WITH r *)
END setDate;

PROCEDURE AccessMessage( n : SourceString);
BEGIN (* AccessMessage *)
WriteString('Access denied "');
WriteString( n);
Write('"');
WriteLn;
END AccessMessage;

PROCEDURE WriteError( n : SourceString);
BEGIN (* WriteError *)
WriteString('FlexCopy - Error writing ');
WriteString( n);
WriteLn;
END WriteError;

PROCEDURE ReadError( n : SourceString);
BEGIN (* ReadError *)
WriteString('FlexCopy - Error reading ');
WriteString( n);
WriteLn;
END ReadError;


PROCEDURE Copy( SourceFile, DestFile : SourceString; Info : DirEntry) : BOOLEAN;
VAR
CopySize : LONGCARD;
reply, junk : CARDINAL;
readwrite : INTEGER;
c : CHAR;
InS, OutS : STREAM;
OK : BOOLEAN;
BEGIN (* Copy *)
CopySize := Info.Size;
OK := FALSE;
IF (Buffer = NIL) THEN (* allocate copy buffer storage (first time) *)
NEW( Buffer);
END; (* IF Buffer = NIL *)
reply := Connect( InS, SourceFile, input);
IF (reply = 0) THEN
reply := Connect( OutS, DestFile, output);
IF (reply = 5) OR (reply = 4) THEN (* access denied to output file. or no handle available *)
AccessMessage( DestFile);
OK := FALSE;
ELSIF (reply = 0) THEN (* OK *)
OK := TRUE;
WHILE CopySize > LONG( BufferSize) DO (* copy loop with full buffer *)
IF OK THEN
ReadRec( InS, Buffer, BufferSize, readwrite);
IF readwrite <> INTEGER( BufferSize) THEN
ReadError( SourceFile);
OK := FALSE;
END; (* IF read error *)
END; (* IF OK Read *)
IF OK THEN
WriteRec( OutS, Buffer, BufferSize, readwrite);
IF readwrite <> INTEGER( BufferSize) THEN
WriteError( DestFile);
OK := FALSE;
PartialCopy := TRUE;
END; (* IF write error *)
END; (* IF OK Write *)
DEC( CopySize, LONG( BufferSize));
END; (* WHILE CopySize > BufferSize+1 *)
IF (CopySize > 0) THEN (* get final part, < 1 buffer *)
IF OK THEN
ReadRec( InS, Buffer, SHORT( CopySize), readwrite);
IF readwrite <> INTEGER( SHORT( CopySize)) THEN
ReadError( SourceFile);
OK := FALSE;
END; (* IF read error *)
END (* IF OK read last *)
IF OK THEN
WriteRec( OutS, Buffer, SHORT( CopySize), readwrite);
IF readwrite <> INTEGER( SHORT( CopySize)) THEN
WriteError( DestFile);
OK := FALSE;
PartialCopy := TRUE;
END; (* IF write error *)
END; (* IF OK write last *)
END; (* IF CopySize > 0 *)
IF OK THEN (* success, make the date correct *)
setDate( OutS, Info.fdate, Info.ftime);
END; (* IF OK *)
Disconnect( OutS, TRUE);
IF (NOT OK) THEN (* failure, delete the partial file *)
junk := DeleteFile( DestFile);
END; (* IF OK *)
END; (* IF connected output *)
Disconnect( InS, TRUE);
END; (* IF connected input *)
RETURN OK;
END Copy;

PROCEDURE ReportAction( From, To : SourceString);
VAR
c : CHAR;
BEGIN (* ReportAction *)
DontCopy := FALSE;
WriteString( From);
CASE CopyStatus OF
copy : WriteString(' => '); |
move : WriteString(' -> '); |
END; (* CASE CopyStatus *)
WriteString( To);
IF (Prompt) THEN
WriteString(' ? (Y/N) : ');
REPEAT (* these two repeat loops mimic the way *)
REPEAT (* 4DOS handles the prompting process *)
BusyRead( c);
UNTIL CharRead;
c := CAP(c);
Write( c);
IF (NOT ((c = 'Y') OR (c = 'N'))) THEN
Write( Beep);
Write( Backspace);
END;
UNTIL ((c = 'Y') OR (c = 'N'));
IF (c = 'N') THEN
DontCopy := TRUE; (* don't copy the file *)
END;
END; (* IF Prompt *)
WriteLn;
END ReportAction;


(* Copy a file from the specified source to the specified destination. Return
true if file successfully copied, or not copied due to update criterion. *)
PROCEDURE CopyAFile(From, To : SourceString; Info : DirEntry) : BOOLEAN;
VAR
Target : ARRAY [0..0] OF DirEntry;
Count : CARDINAL;

(* returns TRUE if source file is newer than the target *)
PROCEDURE Newer() : BOOLEAN;
BEGIN (* Newer *)
IF (Info.fdate > Target[0].fdate) THEN
RETURN( TRUE);
ELSIF ( (Info.fdate = Target[0].fdate) AND
(Info.ftime > Target[0].ftime)) THEN
RETURN( TRUE);
ELSE
RETURN( FALSE);
END; (* date > ... *)
END Newer;

BEGIN (* CopyAFile *)
IF ((NOT Prompt) AND (NOT (Condition=all))) THEN
GetDirectory( To, Target, Count);
IF ((Condition=freshen) AND (Count=0)) THEN
RETURN FALSE;
ELSIF ((NOT Newer())
AND (Count=1)) THEN
RETURN FALSE;
END;
END; (* IF freshen or update *)
IF (Verbose OR Prompt) THEN
ReportAction( From, To);
IF (DontCopy) THEN
RETURN FALSE;
END; (* DontCopy set in ReportAction *)
END; (* IF Verbose *)
RETURN Copy( From, To, Info); (* if we get here, either all, or newer *)
END CopyAFile;

(* Move a file from the specified source to the specified destination *)
PROCEDURE MoveAFile(From, To : SourceString; Info : DirEntry) : BOOLEAN;
VAR
OK : BOOLEAN;
Moved : CARDINAL;
BEGIN (* MoveAFile *)
IF Verbose OR Prompt THEN
ReportAction( From, To);
IF (DontCopy) THEN
RETURN FALSE;
END; (* DontCopy set in ReportAction *)
END; (* IF Verbose *)
OK := FALSE;
(* IF files are on same drive, rename from one to other *)
IF (From[0] = To[0]) THEN
Moved := RenameFile( From, To);
IF (Moved = 5) THEN
AccessMessage( From);
ELSIF (Moved = 0) THEN
OK := TRUE;
ELSE
WriteString('FlexCopy -- error moving file: ');
WriteString(From);
WriteLn;
RETURN FALSE;
END; (* IF rename problem *)
ELSE
OK := Copy( From, To, Info);
IF OK THEN
IF (DeleteFile( From) <> 0) THEN
WriteString('FlexCopy -- Error deleting source file: ');
WriteString( From);
WriteLn;
END; (* IF delete problem *)
END; (* IF OK *)
END; (* IF same drive rename, else copy *)
RETURN OK;
END MoveAFile;

BEGIN (* CopyFiles *)
Condition := all; (* set default values *)
Verbose := TRUE;
Prompt := FALSE;
PartialCopy := FALSE;
CopyStatus := copy;
Buffer := NIL;
END CopyFiles.


  3 Responses to “Category : Modula II Source Code
Archive   : FLXCPY10.ZIP
Filename : COPYFILE.MOD

  1. Very nice! Thank you for this wonderful archive. I wonder why I found it only now. Long live the BBS file archives!

  2. This is so awesome! 😀 I’d be cool if you could download an entire archive of this at once, though.

  3. But one thing that puzzles me is the “mtswslnkmcjklsdlsbdmMICROSOFT” string. There is an article about it here. It is definitely worth a read: http://www.os2museum.com/wp/mtswslnk/