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

 
Output of file : FLEXCOPY.MOD contained in archive : FLXCPY10.ZIP
MODULE FlexCopyForDOS;

(* Flexible copy program for MS-DOS. Allows multiple source arguments on the
command line, and a number of switches to control the copy process.

Author: Dave Lemire
Created: 11/26/89 *)

FROM CopyFiles IMPORT CopyAFile, MoveAFile, SourceString, Verbose, Prompt
UpdateControl, Condition, CopyControl, CopyStatus,
PartialCopy;
FROM CmdLin IMPORT ParmPtr, ReadCmdLine;
FROM Terminal IMPORT WriteString, WriteLn, Write, Read,
BusyRead, CharRead;
FROM Strings IMPORT Copy, Pos, Length, Concat, AddPath, PosLast, StrLower;
FROM OtherMSDOS IMPORT GetCurDir;
FROM GetEnvName IMPORT GetEnvName;
FROM Storage IMPORT ALLOCATE, DEALLOCATE;
FROM SYSTEM IMPORT TSIZE;
FROM DirInfo IMPORT FileName, DirEntry, GetDirectory;
FROM SubDirs IMPORT FullyQualify, IsSubdir;
FROM EntrExit IMPORT ExitStatus, FlexCopyEntry, FlexCopyExit, VersionMessage;
FROM SmallIO IMPORT WriteCard;

TYPE
SRPtr = POINTER TO SourceRecord;
SourceRecord = RECORD
SourceSpec : SourceString;
SourceDir : SourceString;
NextSource : SRPtr;
END;
TargetRecord = RECORD
Spec : SourceString;
Dir : SourceString;
Name : FileName;
END;
TargetType = (dir, file, wild, unknown);
(* Target spec type - subdir, single file name or wildcard.*)

CONST
MaxArg = 20;
CurrentDrive = 0;
ENDSTRING = 0x;
Environment = TRUE; (* 'rename' some booleans for mnemonic value *)
CommandLine = FALSE;
ESCAPE = 01bx; (* keyboard escape character *)
TAB = 09x; (* ascii TAB character *)
STAR = '*'; (* renaming characters *)
DOT = '.';
QUES = '?';

VAR
Parms : ARRAY [0..MaxArg] OF ParmPtr;
ParmCount,
CopyCount : CARDINAL;
SourceSpecList : SRPtr;
SourceFiles : ARRAY [0..150] OF DirEntry;
SourceFileCount, (* # of files in current source dir *)
SourceParmCount : CARDINAL; (* Number of parameters that specify sources,
either files or wildcards or dirs *)
EnvString : SourceString;
Target : TargetRecord;
DestIs : TargetType;
UserExit, (* Flag for user ESCape during copy *)
Banner, (* TRUE if copyright message is shown *)
DestIsDir : BOOLEAN;(* TRUE if copying to disk/directory, not a file *)
i : CARDINAL; (* loop counter *)


(* IsDevice checks to see if the source string identifies a DOS device,
e.g., CON, LPT or COM. It returns TRUE if so, FALSE otherwise. *)
PROCEDURE IsDevice( s : ARRAY OF CHAR) : BOOLEAN;
VAR
i : CARDINAL;
BEGIN (* IsDevice *)
IF (Length(s) > 5) THEN
RETURN FALSE; (* too long for device name *)
END;
i := 0; (* clear extraneous characters from s, could do less than this *)
WHILE ((s[i] <> 0x) AND (i < HIGH(s))) DO INC( i); END;
WHILE (i < HIGH(s)) DO
s[i] := 0x;
INC( i);
END;
IF ((s[3] = ':') OR (s[4] = ':')) THEN
RETURN TRUE; (* quick check for e.g., con: or lpt1: *)
ELSE
StrLower( s); (* go for case insensitive comparison *)
s[3] := ENDSTRING; (* only care about first three letters *)
IF (s = 'con') OR
(s = 'lpt') OR
(s = 'com')
THEN
RETURN TRUE;
ELSE
RETURN FALSE;
END; (* check device names *)
END; (* IF too long, etc. *)
END IsDevice;


(* This procedure prints error messages about problem switches. It
indicates where the switch is, if it is unrecognized or only disallowed
in the environment variable. It then calls FlexCopyExit to end the program *)
PROCEDURE BadSwitchComplaint( s : CHAR; Env, NotAllowed : BOOLEAN;);
BEGIN (* BadSwitchComplaint *)
IF (NotAllowed) THEN
WriteString('Invalid switch "/');
ELSE
WriteString('Unrecognized switch "/');
END;
Write(s);
IF (Env) THEN
WriteString('" in the environment.');
ELSE
WriteString('" on the command line.');
END;
WriteLn;
FlexCopyExit( UsageError);
END BadSwitchComplaint;


(* ProcessSwitches sets program status and control switches based on
the string passed to it. The Env boolean allows for control
of switches which can not be used in the environment. *)
PROCEDURE ProcessSwitches( s : ARRAY OF CHAR; Env : BOOLEAN);
CONST
NotAllowed = TRUE;
Invalid = FALSE;
VAR
i : CARDINAL;
BEGIN (* ProcessSwitches *)
i := 0;
LOOP
CASE CAP(s[i]) OF
ENDSTRING : RETURN; | (* done here *)
'M' : IF (Env) THEN
BadSwitchComplaint( s[i], Env, NotAllowed);
ELSE
CopyStatus := move; (* move files *)
END; |
'F' : IF (Env) THEN
BadSwitchComplaint( s[i], Env, NotAllowed);
ELSE
Condition := freshen; (* only existing needing update *)
END; |
'U' : IF (Env) THEN
BadSwitchComplaint( s[i], Env, NotAllowed);
ELSE
Condition := update; (* new, plus newer dates *)
END; |
'H',
'?' : IF (Env) THEN
BadSwitchComplaint( s[i], Env, NotAllowed);
ELSE
FlexCopyExit( Help); (* feed advice on switches *)
END; |
'P' : Prompt := TRUE; | (* ask for each file *)
'N' : Prompt := FALSE; | (* don't ask ever *)
'Q' : Verbose := FALSE; | (* No output to console *)
'V' : Verbose := TRUE; | (* report efforts to console *)
'X' : Banner := FALSE; | (* Don't show copyright *)
'/' : (* switch char, do nothing *) |
ELSE BadSwitchComplaint( s[i], Env, Invalid);
END; (* CASE *)
INC( i);
END; (* LOOP *)
END ProcessSwitches;

(* SetSwitches examines the command line string for proper use of switch
parameters, then calls ProcessSwitches to handle any switches in the
command line. It then removes the switch parameters from the command
line and adjusts other arguments and the parameter count appropriately. *)
PROCEDURE SetSwitches;
VAR
i : CARDINAL;

(* delete the i-th parameter by moving pointers in the Parms array *)
PROCEDURE DelParm( i : CARDINAL);
BEGIN (* DelParm *)
WHILE (i < ParmCount-1) DO
Parms[i] := Parms[i+1];
INC( i);
END; (* WHILE i < ParmCount *)
END DelParm;

(* strip out parameters with switches,
adjust Parms array and ParmCount accordingly. *)
PROCEDURE DropParms;
VAR
i : CARDINAL;
BEGIN (* DropParms *)
i := 0;
LOOP;
IF Parms[i]^[0] = '/' THEN
DelParm( i );
DEC( ParmCount);
ELSE
INC( i);
END;
IF (i = ParmCount) THEN EXIT; END;
IF ParmCount = 0 THEN FlexCopyExit( UsageError); END;
END; (* LOOP *)
END DropParms;

BEGIN (* SetSwitches *)
FOR i := 0 TO ParmCount-1 DO
IF (Parms[i]^[0] = '/') THEN
ProcessSwitches( Parms[i]^, CommandLine);
END; (* IF Parms ... *)
END; (* FOR i *)
DropParms;
END SetSwitches;

(* ExpandFileSpec takes a file spec and fills it out to it's fullest form,
expanding *'s into strings of ?'s, and setting the location of the period
separating filename from extenion correctly. *)
PROCEDURE ExpandFileSpec( VAR spec : FileName);
VAR
temp : FileName;
i,j, dp, ep : CARDINAL; (* counters, dot-point, endpoint *)

(* determine the position of the period in the expanded file spec *)
PROCEDURE SetDotpoint;
BEGIN (* SetDotpoint *)
i := 0;
WHILE ((spec[i] <> STAR) AND (spec[i] <> DOT)) DO
INC(i);
IF spec[i] = 0x THEN
dp := i;
ep := i;
RETURN;
END;
END; (* WHILE ((spec[i] <> STAR) AND (spec[i] <> DOT)) *)
IF (spec[i] = STAR) THEN
dp := 8;
ELSE
dp := i;
END;
END SetDotpoint;

BEGIN (* ExpandFileSpec *)
SetDotpoint;
i := 0; j := 0; ep := 0;
IF (ep = 0) THEN ep := dp+4; END; (* assume full extension *)
LOOP
IF (i = ep) THEN
temp[i] := 0x;
EXIT;
ELSIF (i = dp) THEN
temp[i] := '.';
INC( i); INC( j);
IF (spec[j] = '.') THEN INC(j); END; (* account for * handling *)
ELSE
IF ((spec[j] <> QUES) AND (spec[j] <> STAR) AND (spec[j] <> DOT)) THEN
temp[i] := spec[j]
INC(i); INC(j);
ELSE
temp[i] := QUES;
INC(i);
IF (spec[j] = QUES) THEN INC(j); END;
END;
END; (* IF ... *)
END; (* LOOP *)
spec := temp;
END ExpandFileSpec;

(* rename a file from the From filename to the To filename, handling
wildcards in the Target specification. *)
PROCEDURE Rename(VAR From, To : FileName);
VAR
i, j, k : CARDINAL; (* To, From, Tspec counters *)
c : CHAR;
BEGIN (* Rename *)
i := 0; j := 0; k := 0;
To := ' ';
WITH Target DO
LOOP
IF (Name[k] = 0x) THEN (* To spec sets file length limit *)
To[i] := 0x;
RETURN;
ELSIF (Name[k] = QUES) THEN
To[i] := From[j];
IF (To[i] = DOT) THEN
WHILE (Name[k] <> DOT) DO INC(k); END;
WHILE (From[j] <> DOT) DO INC(j); END;
END; (* if we got the DOT *)
ELSIF (From[j] = DOT) THEN
WHILE ((Name[k] <> DOT) AND (Name[k] <> QUES)) DO
To[i] := Name[k];
INC( i); INC(k);
END;
To[i] := DOT;
ELSIF (Name[k] = DOT) THEN
To[i] := DOT;
WHILE (From[j] <> DOT) DO INC(j); END;
ELSE
To[i] := Name[k];
END; (* IF *)
INC(i); INC( j); INC( k);
END; (*LOOP*)
END; (* WITH Target *)
END Rename;

(* GetDestName builds a destination string from the source filename and
the status information about the target. *)
PROCEDURE GetDestName( From : FileName;
VAR To : SourceString;
VAR fn : FileName);
VAR
Tname : FileName;
BEGIN (* GetDestName *)
WITH Target DO
IF (DestIs = dir) THEN
AddPath( Dir, From, To); (* return From name in whole path *)
fn := From;
ELSIF (DestIs = file) THEN
To := Spec;
fn := Name;
ELSE (* we have a wildcard renaming *)
Rename( From, Tname); (* get the name part *)
AddPath( Dir, Tname, To); (* assemble whole string *)
fn := Tname;
END;
END; (* WITH Target *)
END GetDestName;

(* AddToSourceList adds new records to the linked list of source
filespecs processed in the main program loop. Source specs are
added at the end, so that files are copied in the order specified
on the command line. *)
PROCEDURE AddToSourceList( NewRecord : SRPtr);
VAR
temp : SRPtr;
BEGIN (* AddToSourceList *)
IF SourceSpecList = NIL THEN
SourceSpecList := NewRecord
ELSE
temp := SourceSpecList;
WHILE temp^.NextSource <> NIL DO
temp := temp^.NextSource;
END; (* WHILE temp <> NIL *)
temp^.NextSource := NewRecord;
END; (* IF Source ... *)
END AddToSourceList;


(* SetSourceDir takes the complete source spec (a fully qualified filename)
and parses off the path without the filename. *)
PROCEDURE SetSourceDir( VAR sRec : SRPtr);
VAR
c : CARDINAL;
BEGIN (* SetSourceDir *)
WITH sRec^ DO
SourceDir := SourceSpec;
c := PosLast('\', SourceDir, 1000);
IF c = 2 THEN
SourceDir[3] := ENDSTRING;
ELSE
SourceDir[c] := ENDSTRING;
END; (* IF c *)
END; (* WITH sRec^ *)
END SetSourceDir;

(* CheckForWild scans a passed string for *'s and ?'s, returning TRUE if
one of either is found, FALSE otherwise. *)
PROCEDURE CheckForWild( s : ARRAY OF CHAR;) : BOOLEAN;
VAR
i : CARDINAL;
BEGIN (* CheckForWild *)
i := 0;
WHILE ((s[i] <> QUES) AND (s[i] <> STAR)) DO
INC( i);
IF (s[i] = ENDSTRING) THEN RETURN FALSE; END;
END; (* WHILE s[i] <> 0x *)
RETURN TRUE;
END CheckForWild;

(* ProcessTargetSpec takes that target specification (explicit or implied
on the command line), and fully qualifies it, determines the type of
target (file, wildcard, subdir) for subsequent use. *)
PROCEDURE ProcessTargetSpec;
VAR
i : CARDINAL;
BEGIN (* ProcessTargetSpec *)
WITH Target DO
IF NOT FullyQualify( Spec) THEN
WriteString('Error qualifying destination: "');
WriteString( Spec);
Write('"');
WriteLn;
FlexCopyExit(BadDir);
END; (* IF bad target *)
IF IsSubdir( Spec) THEN
DestIs := dir;
Dir := Spec;
Name := '????????.???';
ELSIF CheckForWild( Spec) THEN
DestIs := wild;
ELSE
DestIs := file;
END; (* IF IsSubDir *)
IF (DestIs <> dir) THEN
Dir := Spec;
i := PosLast('\', Dir, 1000);
IF i = 2 THEN (* root dir *)
Dir[3] := ENDSTRING;
ELSE
Dir[i] := ENDSTRING;
END; (* IF i *)
Copy( Spec, i+1, TSIZE( FileName), Name); (* leave just name *)
IF (DestIs = wild) THEN
ExpandFileSpec( Name);
END; (* IF wildcard *)
END; (* IF destis <> dir *)
IF (DestIs <> file) THEN (* need a final slash later, so add it *)
IF Length( Dir) > 3 THEN (* if not a root *)
Concat( Dir, '\', Dir);
END;
END; (* IF DestIs not file *)
END; (* WITH Target *)
END ProcessTargetSpec;


(* Assign values to "Target" and elements of list "SourceSpecList"
from command line values. Call IsSubdir to verify if destination is a
file or a disk/directory *)
PROCEDURE IDSourceAndDestination;
VAR
i : CARDINAL;
S : SourceString;
WkPtr : SRPtr;
BEGIN (* IDSourceAndDestination *)
SourceSpecList := NIL; (* initial values *)
DestIs := unknown;
IF (ParmCount = 1) THEN
DestIs := dir;
IF (NOT GetCurDir( CurrentDrive, Target.Spec)) THEN
WriteString('Error getting directory');
WriteLn;
FlexCopyExit( BadDir);
END; (* IF current directory failure *)
NEW( WkPtr);
S := SourceString( Parms[0]^);
IF (IsDevice( S)) THEN
WriteString( S);
WriteString( ' -- ');
FlexCopyExit( DeviceError);
END;
IF FullyQualify( S) THEN (* handle subdir spec's w/o *.* *)
IF IsSubdir( S) THEN
IF ((S[Length(S)-1] = '\') OR (S[Length(S)-1] = ':'))
THEN Concat( S, '*.*', S);
ELSE Concat( S, '\*.*', S);
END; (* IF S[ Length(S)] *)
END; (* IF IsSubdir(S) *)
ELSE
WriteString('Failure qualifying ');
WriteString(S);
WriteLn;
FlexCopyExit( BadDir);
END; (* IF FullyQualify(S) *)
WkPtr^.SourceSpec := S;
WkPtr^.NextSource := NIL;
SetSourceDir( WkPtr);
AddToSourceList( WkPtr);
ELSE
Target.Spec := SourceString( Parms[ ParmCount-1]^);
IF (IsDevice( Target.Spec)) THEN
WriteString( Target.Spec);
WriteString( ' -- ');
FlexCopyExit( DeviceError);
END;
FOR i := 0 TO ParmCount-2 DO
NEW( WkPtr);
S := SourceString( Parms[i]^);
IF (IsDevice( S)) THEN
WriteString( S);
WriteString( ' -- ');
FlexCopyExit( DeviceError);
END;
IF FullyQualify( S) THEN (* handle subdir spec's w/o *.* *)
IF IsSubdir( S) THEN
IF ((S[Length(S)-1] = '\') OR (S[Length(S)-1] = ':'))
THEN Concat( S, '*.*', S);
ELSE Concat( S, '\*.*', S);
END; (* IF S[ Length(S)] *)
END; (* IF IsSubdir(S) *)
END; (* IF FullyQualify(S) *)
WkPtr^.SourceSpec := S;
WkPtr^.NextSource := NIL;
SetSourceDir( WkPtr);
AddToSourceList( WkPtr);
SourceParmCount := ParmCount - 1;
END; (* FOR i *)
END; (* IF ParmCount *)
ProcessTargetSpec;
END IDSourceAndDestination;

(* Print the final report of how many files have been processed. *)
PROCEDURE ReportCount;
VAR
CountString : ARRAY [0..2] OF CHAR;
used : INTEGER;
BEGIN (* ReportCount *)
Write( TAB); (* TAB over *)
WriteCard( CopyCount, 4);
CASE CopyStatus OF
copy : WriteString( " file(s) copied"); |
move : WriteString( " file(s) moved"); |
END; (* CASE CopyStatus *)
WriteLn;
END ReportCount;

(* Take an array of files and invoke the copy or move function, using the
global target variable to determine the destination. *)
PROCEDURE DoCopy( FileFrom : ARRAY OF DirEntry);
VAR
c : CHAR;
i : CARDINAL;
SourceName, DestName : SourceString;
DestFile : FileName;
Success : BOOLEAN;

PROCEDURE SelfCopyError;
BEGIN (* SelfCopyError *)
WriteString("Can't copy file to itself ");
Write('"');
WriteString( SourceName);
Write('"');
WriteLn;
FlexCopyExit( SelfCopy);
END SelfCopyError;


BEGIN (* DoCopy *)
FOR i := 0 TO SourceFileCount-1 DO
Success := FALSE;
AddPath( SourceSpecList^.SourceSpec, FileFrom[i].Name, SourceName);
GetDestName( FileFrom[i].Name, DestName, DestFile);
IF SourceName = DestName THEN SelfCopyError END; (* IF source = dest *)
CASE CopyStatus OF
copy : IF ((DestIs = file) AND (i >= 1)) THEN
FlexCopyExit( BadCopy);
ELSE
Success := CopyAFile( SourceName, DestName, FileFrom[i]);
END; (* IF move error *)
|
move : IF ((DestIs = file) AND (i >= 1)) THEN
FlexCopyExit( BadMove);
ELSE
Success := MoveAFile( SourceName, DestName, FileFrom[i]);
END; (* IF move error *)
|
END (* CASE CopyStatus *)
IF Success THEN INC( CopyCount); END; (* IF Success *)
BusyRead(c);
IF (CharRead AND (c = ESCAPE)) THEN
UserExit := TRUE;
RETURN;
END; (* IF *)
END; (* FOR i *)
END DoCopy;

BEGIN (* FlexCopyForDOS *)
FlexCopyEntry; (* do setup operations *)
(* Set defaults, then allow user to modify *)
(* Condition, CopyStatus and Verbose are *)
Banner := TRUE; (* set in CopyFile. *)
UserExit := FALSE;
IF GetEnvName( 'FLEXCOPYSW', EnvString) THEN
ProcessSwitches( EnvString, Environment);
END;
ReadCmdLine( ParmCount, Parms); (* Process the command line *)
IF ParmCount = 0 THEN FlexCopyExit( UsageError); END;

(* If a valid command line, process it for switches, and gripe if there
are no arguments other than switches. *)
SetSwitches;
IF ParmCount = 0 THEN FlexCopyExit( UsageError); END;

IF (Verbose AND Banner) THEN VersionMessage; END; (* IF Verbose *)
IDSourceAndDestination; (* process source and destination file specs. *)
CopyCount := 0;

(* Here's the main loop. While we still have files to process, and the
user hasn't hit the escape key, chain through the linked list of
source specs, and copy/move the files from each to the destination. *)

WHILE ((NOT UserExit) AND
(SourceSpecList <> NIL)) DO
GetDirectory( SourceSpecList^.SourceSpec, SourceFiles, SourceFileCount);
IF (SourceFileCount > 0) THEN
DoCopy( SourceFiles)
ELSE
WriteString('File not found: "');
WriteString( SourceSpecList^.SourceSpec);
Write('"');
WriteLn;
END; (* IF SouceFileCount > 0 *)
SourceSpecList := SourceSpecList^.NextSource; (* next source spec *)
END; (* WHILE SourceSpecList <> NIL AND NOT UserExit *)
IF (Verbose AND
(Banner OR (CopyCount > 0))) THEN
ReportCount;
END;
IF (UserExit) THEN
FlexCopyExit( UserCancel);
ELSIF (PartialCopy) THEN
FlexCopyExit( TargetOverflow);
ELSE
FlexCopyExit( OK);
END; (* if normal or partial copy *)
END FlexCopyForDOS.


  3 Responses to “Category : Modula II Source Code
Archive   : FLXCPY10.ZIP
Filename : FLEXCOPY.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/