Category : Batch File Utilities - mostly for DOS
Archive   : BATUTIL.ZIP
Filename : CLNTMP.MOD

MODULE ClnTmp;

(* calling format is:

clntmp /n

where: MinN <= n <= MaxN
(MinN and MaxN are constants defined below)

Action: Clean directories ...\TMP of files older than n days.
Only affects current default drive when clntmp is called.
Will find all directories that end in \TMP on current drive.
Gives names of directories found and number of files deleted.
Will NOT find subdirectories with any special attributes set.
Will NOT delete files with any special attributes set.
CTRL-X terminates program operation.
Requires MSDOS 2.0 or better.

Author: Randall A. Maddox
12209 M Peach Crest Drive
Germantown, MD 20874
(301) 428-9581

Update History:
Originally written: 5/23/88

*)


(* *+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+ *)

(* imports *)

FROM BitByteOps IMPORT
ByteAnd;

FROM Break IMPORT
DisableBreak;

FROM ErrorCode IMPORT
SetErrorCode,ExitToOS;

FROM InOut IMPORT
WriteString, WriteCard, WriteLn;

FROM Keyboard IMPORT
KeyPressed, Read;

FROM NumberConversion IMPORT
StringToCard;

FROM Strings IMPORT
Assign, Pos, Concat, CompareStr, Length;

FROM Storage IMPORT
ALLOCATE;

FROM SYSTEM IMPORT
(* registers *)
AX, BX, CX, DS, DX, ES,
(* types *)
BYTE,WORD, ADDRESS,
(* procedures *)
ADR, TSIZE, GETREG, SETREG, CODE, SWI;


(* *+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+ *)

(* local declarations *)

TYPE
PathStr = ARRAY[0..64] OF CHAR;
PathStructPtr = POINTER TO PathStruct;
PathStruct = RECORD (* holds paths to ..\TMP directories *)
PathName : PathStr;
Next : PathStructPtr
END;
FNameStruct = ARRAY[0..12] OF CHAR;
FNamePtr = POINTER TO FNameStruct;
FAttrPtr = POINTER TO BYTE;

CONST
Dos = 21H; (* DOS services interrupt number *)
FindFirst = WORD(4E00H); (* DOS function = Find first matching file *)
FindNext = WORD(4F00H); (* DOS function = Find next matching file *)
PushBP = 55H; (* Assembly instruction to Push BP register *)
PopBP = 5DH; (* Assembly instruction to Pop BP register *)
LAHF = 9FH; (* Assembly instruction to Load AH from Flags *)
Nul = 000C; (* ASCII Null character *)
CTRLX = 030C; (* ASCII Control X *)
WildCard = '????????.???'; (* matches any file *)
OptSep = '/'; (* option separator on command line *)
PathSep = '\'; (* separator used in path names *)
MinN = 0; (* minimum value of EN parameter *)
MaxN = 65535; (* maximum value of EN parameter *)
FlagMask = BITSET(0100H); (* mask to check for DOS error codes *)

VAR
FirstTmp : PathStructPtr; (* head of ..\TMP directory list *)
DTAAdr : ADDRESS; (* address of default DTA *)
FAttr : FAttrPtr; (* pointer to DTA file attribute byte *)
FName : FNamePtr; (* pointer to DTA file name *)
FDate : ADDRESS; (* pointer to DTA file creation date *)
DelDate : WORD; (* delete files with FDate < DelDate *)
TMPDir : ARRAY[0..3] OF CHAR; (* ending of directories to clean *)
EN : CARDINAL; (* n command line parameter value *)
Error : BOOLEAN; (* true if any error has occurred *)
ErrNum : CARDINAL; (* number of error that occurred *)
NumDirs : CARDINAL; (* total number of subdirectories found *)
NumTmps : CARDINAL; (* number of ..\TMP directories found *)
NumFiles : CARDINAL; (* total number of files deleted *)

(* *+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+ *)

(* local procedures *)

PROCEDURE WriteError(Num : CARDINAL);

(* Given an error number in Num, display appropriate error message.
Expects to be at start of a new line, leaves cursor on start of
next new line after message *)

BEGIN
CASE Num OF
1 : WriteString('Delete failed on: ') |
2 : WriteString('CTRL-X, program terminating at user request') |
3 : WriteString('Command line option not present') |
4 : WriteString(OptSep);
WriteString(' not found in command line') |
5 : WriteString('No digits following ');
WriteString(OptSep); |
6 : WriteString('Unable to convert digits to CARDINAL number') |
7 : WriteString('n parameter out of range') |
8 : WriteString('Incorrect DOS version, requires 2.0 or higher') |
9 : WriteString('Got lost in directory tree, please call Randy')
ELSE
WriteString('Please call Randy, unidentified error number: ');
WriteCard(Num,1)
END; (* case *)
WriteLn
END WriteError;


(* *+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+ *)

PROCEDURE Terminate(Num : CARDINAL);

(* set exit error code to ErrNum and exit to Operating System *)

BEGIN
SetErrorCode(Num);
ExitToOS
END Terminate;

(* *+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+ *)

PROCEDURE CheckCtrlX(VAR Ch : CHAR);

(* see if a key has been pressed, if so read the keystroke, if it is
CTRL-X then terminate the program, else just return keystroke in Ch,
return Nul in Ch if no key pressed *)

BEGIN
Ch := Nul;
IF (KeyPressed()) THEN (* user did something *)
Read(Ch); (* let's see what *)
IF (Ch = CTRLX) THEN (* user wants to terminate *)
Error := TRUE;
ErrNum := 2;
WriteLn;
WriteError(ErrNum);
WriteLn;
Terminate(ErrNum) (* and end the program *)
END (* if *)
END (* if *)
END CheckCtrlX;

(* *+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+ *)

PROCEDURE SignOn();

(* Sign on and let user know something is happening *)

BEGIN
WriteLn;WriteLn;
WriteString('CLNTMP - temporary directory cleaning program, Version 3.0, 5/23/88');
WriteLn;
WriteString('Written in Logitech Modula-2, by Randy Maddox, for BDS, Inc. (703) 481-8700');
WriteLn;WriteLn
END SignOn;

(* *+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+ *)

PROCEDURE CheckDOS();

(* We need version 2.0 or higher. If version < 2.0, terminate here
and do not return to calling process. *)

CONST
Quit = WORD(0000H); (* DOS 1.0 function = terminate program *)
GetVer = WORD(3000H); (* DOS function = Get DOS version number *)
LoMask = BITSET(00FFH); (* mask for low byte of WORD *)

VAR
I : CARDINAL;

BEGIN
SETREG(AX,GetVer);
CODE(PushBP);
SWI(Dos); (* DOS returns AL = major, AH = minor version number *)
CODE(PopBP);
GETREG(AX,I);
I := CARDINAL(BITSET(I) * LoMask); (* i.e., AL *)
IF (I < 2) THEN
(* can't continue with incorrect DOS version *)
Error := TRUE;
ErrNum := 8; (* incorrect DOS version *)
WriteString('ERROR: ');
WriteCard(ErrNum,1);
WriteLn;WriteLn;
WriteError(ErrNum);
WriteLn;WriteLn;
WriteString('Program terminating with no action taken.');
WriteLn;WriteLn;
(* special termination for DOS 1.X *)
SETREG(AX,Quit);
CODE(PushBP);
SWI(Dos) (* no return, end of this program *)
END (* if *)
END CheckDOS;

(* *+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+ *)

PROCEDURE GetDTAaddr(VAR DTA : ADDRESS);

(* Return address of current DTA in DTA *)

CONST
GetDTA = WORD(2F00H); (* DOS function = Get current DTA address *)

VAR
I,J : CARDINAL;

BEGIN
SETREG(AX,GetDTA);
CODE(PushBP);
SWI(Dos); (* DOS returns ES = DTA.SEGMENT, BX = DTA.OFFSET *)
CODE(PopBP);
GETREG(ES,I);
GETREG(BX,J);
DTA.SEGMENT := I;
DTA.OFFSET := J
END GetDTAaddr;

(* *+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+ *)

PROCEDURE GetEN(VAR N : CARDINAL;
DTA : ADDRESS);

(* get command tail and find /n parameter, return in N if found,
set Error and ErrNum if not found or not valid *)

TYPE
CommandTail = RECORD
Tail : ARRAY[0..126] OF CHAR
END;
CommandPtr = POINTER TO CommandTail;

VAR
CmdPtr : CommandPtr;
CmdLen : POINTER TO BYTE;
GotDigit : BOOLEAN;
TmpAdr : ADDRESS;
TmpStr : ARRAY[0..5] OF CHAR;
I,J,K,L : CARDINAL;

BEGIN
GotDigit := FALSE; (* initialize some variables *)
TmpAdr := DTA;
INC(TmpAdr.OFFSET,1); (* offset of command tail in DTA *)
CmdPtr := TmpAdr; (* point to command tail *)
CmdLen := DTA; (* length byte for command tail *)
I := ORD(CmdLen^);
IF (I < 2) THEN (* can't even be /n *)
Error := TRUE; (* set flag *)
ErrNum := 3 (* command line tail too short *)
ELSE (* got something, let's see what *)
(* look through command tail for OptSep *)
J := 0; (* initialize array index *)
WHILE (J < I) & (~ Error) DO
IF (CmdPtr^.Tail[J] = OptSep) THEN (* up to 5 digits after OptSep *)
K := 0; (* indexed offset into Tail *)
L := 0; (* offset into TmpStr *)
WHILE (K <= 5) & ((J + K) < I) DO
INC(K);
IF (CmdPtr^.Tail[J + K] >= '0') & (CmdPtr^.Tail[J + K] <= '9') THEN
GotDigit := TRUE;
TmpStr[L] := CmdPtr^.Tail[J + K];
INC(L)
ELSIF (GotDigit) THEN (* finished with digits *)
K := I + 1 (* bail out of inner while loop *)
END (* if *)
END; (* inner while *)
TmpStr[L] := Nul; (* terminate string *)
IF (~ GotDigit) THEN
Error := TRUE;
ErrNum := 5 (* command tail and OptSep present, but no digit(s) *)
ELSE (* try to convert digit(s) to CARDINAL *)
StringToCard(TmpStr,N,Error);
Error := ~ Error; (* reverse for correct sense *)
IF (Error) THEN
ErrNum := 6 (* digits failed to convert to CARDINAL *)
ELSIF (N < MinN) OR (N > MaxN) THEN
Error := TRUE;
ErrNum := 7 (* n parameter out of range *)
END
END;
J := I + 1; (* bail out of outer while loop *)
ELSE
INC(J); (* continue outer while loop *)
IF (J >= I) THEN
Error := TRUE;
ErrNum := 4 (* command tail present, but no OptSep *)
END (* if *)
END (* if *)
END (* outer while *)
END (* if *)
END GetEN;

(* *+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+ *)

PROCEDURE BadCommandLine(Num : CARDINAL);

(* didn't get correct command line, tell user, give instructions,
and terminate program, i.e., do not return to calling process *)

BEGIN
WriteString('ERROR: ');
WriteCard(Num,1);
WriteLn;WriteLn;
WriteError(Num);
WriteLn;
WriteString('Proper calling syntax is:');
WriteLn;WriteLn;
WriteString(' clntmp /n');
WriteLn;WriteLn;
WriteString(' where: ');
WriteCard(MinN,1);
WriteString(' <= n <= ');
WriteCard(MaxN,1);
WriteLn;WriteLn;
WriteString('Action: Clean ...\TMP directories of files older than n days.');
WriteLn;
WriteString(' Affects only current default drive.');
WriteLn;
WriteString(' Finds subdirectories that end in \TMP on current drive.');
WriteLn;
WriteString(' Will NOT find subdirectories with any special attributes set.');
WriteLn;
WriteString(' Will NOT delete files with any special attributes set.');
WriteLn;
WriteString(' Lists ..\TMP directories cleaned and number of files deleted.');
WriteLn;
WriteString(' Assumes current system date is correct.');
WriteLn;
WriteString(' Requires MSDOS 2.0 or higher.');
WriteLn;WriteLn;
WriteString('Program terminating with no files deleted.');
WriteLn;
Terminate(Num) (* end of program, no return to calling process *)
END BadCommandLine;

(* *+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+ *)

PROCEDURE SetFileAdrs(VAR FAttr : FAttrPtr;
VAR FDate : ADDRESS;
VAR FName : FNamePtr;
DTA : ADDRESS);

(* set global variables pointing to file data found in DTA *)

VAR
TmpAdr : ADDRESS;

BEGIN
TmpAdr := DTA;
INC(TmpAdr.OFFSET,21);
FAttr := TmpAdr; (* pointer to file attribute byte *)
INC(TmpAdr.OFFSET,3);
FDate := TmpAdr; (* pointer to file date word *)
INC(TmpAdr.OFFSET,6);
FName := TmpAdr (* pointer to file name as ASCIIZ *)
END SetFileAdrs;

(* *+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+ *)

PROCEDURE FindTMPs(VAR Dirs : CARDINAL;
VAR Tmps : CARDINAL;
VAR First : PathStructPtr;
TMP : ARRAY OF CHAR;
DTA : ADDRESS);

(* search directory tree for ..\TMP directories, make singly linked
list of ..\TMP directories found *)

TYPE
DirStructPtr = POINTER TO DirStruct;
DirStruct = RECORD (* holds directory tree structure *)
PathName : PathStr;
Checked : BOOLEAN;
LeftNeighbor : DirStructPtr;
NextLevel : DirStructPtr;
PrevLevel : DirStructPtr
END;

CONST
DirAttr = WORD(10H); (* file attribute for subdirectory *)
DirMask = BYTE(10H); (* mask for DirAttr detection *)
NotDir = BYTE(0CFH); (* mask for DirAttr separation *)
Current = '.'; (* current directory *)
Parent = '..'; (* parent directory *)

VAR
TmpAdr : ADDRESS;
CurTmp : PathStructPtr;
CurDir : DirStructPtr; (* directory being searched *)
TmpDir : DirStructPtr; (* temporary pointer to directory *)
LastDir : DirStructPtr; (* last subdirectory found *)
CurPath : PathStr; (* current path name *)
TmpStr : PathStr;
Ch : CHAR;
TreeDone : BOOLEAN;
OK : BOOLEAN;
I,J,K,L : CARDINAL;

BEGIN
(* initialize some variables *)
Dirs := 0;Tmps := 0; (* counters *)
TreeDone := FALSE; (* reset when done *)
First := NIL;CurTmp := NIL;
CurDir := NIL;TmpDir := NIL;LastDir := NIL;
ALLOCATE(CurDir,TSIZE(DirStruct)); (* create root node *)
WITH CurDir^ DO
PathName[0] := PathSep;
PathName[1] := Nul;
Checked := FALSE;
LeftNeighbor := NIL;
NextLevel := NIL;
PrevLevel := NIL
END; (* with *)
REPEAT (* start loop through directory tree *)
(* find and process all subdirectories *)
I := 0; (* none found yet *)
CurDir^.Checked := TRUE; (* reset flag so we don't recheck this one *)
Assign(CurDir^.PathName,TmpStr);
IF (Length(TmpStr) > 1) THEN
Concat(TmpStr,PathSep,TmpStr)
END;
Assign(TmpStr,CurPath); (* save name of current path *)
Concat(TmpStr,WildCard,TmpStr);
TmpAdr := ADR(TmpStr[0]); (* point to our string *)
K := TmpAdr.SEGMENT;
L := TmpAdr.OFFSET;
SETREG(AX,FindFirst);
SETREG(CX,DirAttr);
SETREG(DS,K);
SETREG(DX,L);
CODE(PushBP);
SWI(Dos);
CODE(PopBP,LAHF);
GETREG(AX,J); (* check for error code from DOS *)
J := CARDINAL(BITSET(J) * FlagMask);
IF (J = 0) THEN (* found first OK, see what all is in there *)
LOOP (* start infinite loop to find all subdirectories*)
J := ORD(ByteAnd(FAttr^,DirMask)); (* check attribute *)
IF (J # 0) THEN (* Dir bit, 4, is set *)
J := ORD(ByteAnd(FAttr^,NotDir)); (* any special bits set? *)
IF (J = 0) THEN (* OK, but is it current or parent? *)
IF (Pos(Current,FName^) = 0)
OR (Pos(Parent,FName^) = 0) THEN
J := 1 (* don't use current or parent *)
END (* if *)

END (* if *)
ELSE (* Dir bit, 4, not set *)
J := 1 (* not a directory *)
END; (* if *)
IF (J = 0) THEN (* got a directory *)
INC(I); (* count of subdirectories this time through outer REPEAT *)
INC(Dirs); (* total count of subdirectories found *)
(* put in tree *)
ALLOCATE(TmpDir,TSIZE(DirStruct)); (* create new record *)
Concat(CurPath,FName^,TmpDir^.PathName); (* put in pathname *)
(* then set its pointers *)
IF (LastDir = CurDir) THEN (* first subdirectory at this level *)
CurDir^.NextLevel := TmpDir;
TmpDir^.LeftNeighbor := NIL
ELSE (* adding new one to right *)
TmpDir^.LeftNeighbor := LastDir
END; (* if *)
TmpDir^.PrevLevel := CurDir;
TmpDir^.NextLevel := NIL;
TmpDir^.Checked := FALSE; (* we just found this subdirectory *)
LastDir := TmpDir;
(* check for ..\TMP and put in queue if needed *)
K := Length(LastDir^.PathName);
IF (K >= Length(TMP)) THEN
OK := TRUE;
K := K - Length(TMP);
FOR L := 0 TO (Length(TMP) - 1) DO
IF (TMP[L] # LastDir^.PathName[L + K]) THEN
OK := FALSE
END (* if *)
END; (* for *)
IF OK THEN (* got a ..\TMP directory to add to list *)
(* First always points to the head of the list,
CurTmp^.Next points to the previous head of the list.
The end of the list is found when CurTmp^.Next = NIL *)
INC(Tmps); (* count the ..\TMP directory *)
ALLOCATE(CurTmp,TSIZE(PathStruct)); (* create new record *)
(* set pathname *)
CurTmp^.PathName := LastDir^.PathName;
(* and set pointers *)
CurTmp^.Next := First;
First := CurTmp
END (* if *)
END (* if *)
END; (* if *)
SETREG(AX,FindNext); (* look for next entry in CurDir *)
CODE(PushBP);
SWI(Dos);
CODE(PopBP,LAHF);
GETREG(AX,J); (* check for error code from DOS *)
J := CARDINAL(BITSET(J) * FlagMask);
IF (J # 0) THEN EXIT END (* quit when no more files found *)
END (* inner loop *)
END; (* if *)
IF (I > 0) THEN (* subdirectory(s) found *)
CurDir := LastDir (* make this be current directory for search *)
ELSE (* no subdirectories found *)
REPEAT (* back up to previous unchecked directory *)
IF (CurDir^.LeftNeighbor # NIL) THEN (* go left if can *)
CurDir := CurDir^.LeftNeighbor
ELSIF (CurDir^.PrevLevel # NIL) THEN (* or back up if not *)
CurDir := CurDir^.PrevLevel
ELSE (* should be back at root, check this *)
IF (CompareStr(CurDir^.PathName,PathSep) # 0) THEN
Error := TRUE;
ErrNum := 9
ELSE
TreeDone := TRUE
END (* if *)
END (* if *)
UNTIL (~ CurDir^.Checked) OR (TreeDone) OR (Error)
END; (* if *)
CheckCtrlX(Ch) (* check for user termination *)
UNTIL (TreeDone) OR (Error) (* outer loop *)
END FindTMPs;

(* *+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+ *)

PROCEDURE SetDelDate(VAR DelDate : WORD;
EN : CARDINAL);

(* set DelDate in appropriate format *)

CONST
GetDate = WORD(2A00H); (* DOS function = Get system date *)
PushDX = 52H; (* Assembly instruction to Push DX register *)
PopDX = 5AH; (* Assembly instruction to Pop DX register *)
MonthMask = BITSET(0FF00H); (* mask month from system date *)
DayMask = BITSET(00FFH); (* mask day from system date *)

VAR
DaysIn : ARRAY[1..12] OF CARDINAL; (* # of days in each month *)
Date : CARDINAL; (* # of days since 1/1/1980 *)
Ch : CHAR;
I : CARDINAL;
Yr,Mo,Day : CARDINAL;

BEGIN
(* get system date *)
SETREG(AX,GetDate);
CODE(PushBP);
SWI(Dos);
CODE(PopBP,PushDX);
GETREG(CX,Yr); (* year, 1980 to 2099 *)
CODE(PopDX);
GETREG(DX,I); (* DH = month, 1 to 12; DL = day, 1 to 31 *)
Mo := CARDINAL(BITSET(I) * MonthMask) DIV 100H; (* month *)
Day := CARDINAL(BITSET(I) * DayMask); (* day of month *)
(* set values for DaysIn array *)
DaysIn[1] := 31; (* January *)
DaysIn[2] := 28; (* February *)
DaysIn[3] := 31; (* March *)
DaysIn[4] := 30; (* April *)
DaysIn[5] := 31; (* May *)
DaysIn[6] := 30; (* June *)
DaysIn[7] := 31; (* July *)
DaysIn[8] := 31; (* August *)
DaysIn[9] := 30; (* September *)
DaysIn[10] := 31; (* October *)
DaysIn[11] := 30; (* November *)
DaysIn[12] := 31; (* December *)
(* check for leap year *)
IF ((Yr MOD 4) = 0) AND ((Yr MOD 400) <> 0) THEN
DaysIn[2] := 29 (* reset February for leap year *)
END;
(* now convert our date to a number of days since 1/1/1980 *)
Date := 0; (* initialize date variable *)
(* add in the days of the preceding years *)
FOR I := 1980 TO (Yr - 1) DO
IF ((I MOD 4) = 0) AND ((I MOD 400) <> 0) THEN
INC(Date,366) (* leap year *)
ELSE
INC(Date,365) (* normal year *)
END (* if *)
END; (* for *)
(* then the days of the preceding months of current year *)
FOR I := 1 TO (Mo - 1) DO
INC(Date,DaysIn[I])
END; (* for *)
INC(Date,Day); (* and last the day of current month *)
(* then subtract off our n parameter = EN *)
IF (Date > EN) THEN (* avoid cardinal overflow *)
Date := Date - EN
ELSE
Date := 1 (* earliest date is 1/1/1980 *)
END; (* if *)
(* then convert back to Yr, Mo, Day *)
Yr := 0;Mo := 0;Day := 0;
LOOP (* first set Yr, 1980 = 0, etc. *)
I := 1980 + Yr;
IF ((I MOD 4) = 0) AND ((I MOD 400) <> 0) THEN
IF (Date > 366) THEN
DEC(Date,366); (* leap year *)
INC(Yr)
ELSE
EXIT
END (* if *)
ELSE
IF (Date > 365) THEN
DEC(Date,365); (* normal year *)
INC(Yr)
ELSE
EXIT
END (* if *)
END (* if *)
END; (* loop *)
I := 0; (* initialize index for DaysIn *)
LOOP (* then set Mo *)
INC(Mo);
INC(I);
IF (Date > DaysIn[I]) THEN
DEC(Date,DaysIn[I])
ELSE
EXIT
END (* if *)
END; (* loop *)
Day := Date; (* and last do Day *)
(* tell user what we are doing *)
WriteString('Deleting ..\TMP files created prior to (mm/dd/yyyy): ');
WriteCard(Mo,1);
WriteString('/');
WriteCard(Day,1);
WriteString('/');
WriteCard((Yr + 1980),1);
WriteLn;WriteLn;
(* now put Yr, Mo, Day into DelDate in appropriate format *)
(* MSDOS filedate format is 16 bits as follows:

15 14 13 12 11 10 9 8 7 6 5 4 3 2 1 0
y y y y y y y m m m m d d d d d

where: yyyyyyy = year, 0 to 119 for 1980 to 2099
mmmm = month, 1 to 12
ddddd = day of month, 1 to 31 *)

Date := Yr * 200H; (* put in year *)
Date := Date + (Mo * 20H); (* month *)
Date := Date + Day; (* day of month *)
DelDate := WORD(Date) (* and set DelDate *)
END SetDelDate;

(* *+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+ *)

PROCEDURE DeleteTMPs(Date : WORD;
First : PathStructPtr;
VAR Files : CARDINAL);

(* go through singly linked list of ..\TMP directories and try
to delete files older than Date *)

CONST
DelFile = WORD(4100H); (* DOS function = Delete specified file *)
Ordinary = WORD(0000H); (* attribute of ordinary files *)
OKMask = BYTE(0DFH); (* mask to check if OK to delete file *)

VAR
CurTmp : PathStructPtr;
TmpStr : PathStr;
CurPath : PathStr;
CurFile : PathStr;
TmpAdr : ADDRESS;
Ch : CHAR;
I,J : CARDINAL;

BEGIN
(* then set pointer and start loop *)
CurTmp := First; (* point to first entry in list *)
Files := 0; (* none deleted yet *)
REPEAT (* for each ..\TMP directory found *)
(* tell user which directory we are cleaning *)
WriteString('Cleaning: ');
WriteString(CurTmp^.PathName);
WriteLn;
(* delete all ordinary files for which FDate^ < Date *)
Assign(CurTmp^.PathName,TmpStr);
Concat(TmpStr,PathSep,TmpStr);
Assign(TmpStr,CurPath); (* save current path *)
Concat(TmpStr,WildCard,TmpStr);
TmpAdr := ADR(TmpStr[0]); (* point to our string *)
I := TmpAdr.SEGMENT;
J := TmpAdr.OFFSET;
SETREG(AX,FindFirst);
SETREG(CX,Ordinary);
SETREG(DS,I);
SETREG(DX,J);
CODE(PushBP);
SWI(Dos);
CODE(PopBP,LAHF);
GETREG(AX,J); (* check for error code from DOS *)
J := CARDINAL(BITSET(J) * FlagMask);
IF (J = 0) THEN (* found first OK, see what all is in there *)
LOOP (* start infinite loop to find all ordinary files *)
J := ORD(ByteAnd(FAttr^,OKMask)); (* check attribute *)
IF (J = 0) THEN (* got ordinary file, no special bits set *)
IF (FDate^ < Date) THEN (* delete this file *)
INC(Files); (* count it *)
Assign(CurPath,CurFile); (* set name of file to delete *)
Concat(CurFile,FName^,CurFile);
TmpAdr := ADR(CurFile[0]);
I := TmpAdr.SEGMENT;
J := TmpAdr.OFFSET;
SETREG(AX,DelFile);
SETREG(DS,I);
SETREG(DX,J);
CODE(PushBP);
SWI(Dos);
CODE(PopBP,LAHF);
GETREG(AX,J); (* check for error code from DOS *)
J := CARDINAL(BITSET(J) * FlagMask);
IF (J # 0) THEN
Error := TRUE;
ErrNum := 1;
WriteError(ErrNum);
WriteString(CurFile);
WriteLn
END (* if *)
END (* if *)
END; (* if *)
SETREG(AX,FindNext); (* look for next entry in CurTmp *)
CODE(PushBP);
SWI(Dos);
CODE(PopBP,LAHF);
GETREG(AX,J); (* check for error code from DOS *)
J := CARDINAL(BITSET(J) * FlagMask);
IF (J # 0) THEN EXIT END (* quit when no more files found *)
END (* inner loop *)
END; (* if *)
(* set for next ..\TMP directory *)
CurTmp := CurTmp^.Next;
CheckCtrlX(Ch) (* check for user termination *)
UNTIL (CurTmp = NIL) (* i.e., finished with list *)
END DeleteTMPs;

(* *+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+ *)

(* module body *)

BEGIN (* main module *)

SignOn(); (* tell user we're here *)
CheckDOS(); (* then check DOS for correct DOS version *)

(* if CheckDOS returns, we can go on our merry way *)
DisableBreak; (* can only interrupt with CTRL-X under program control *)
(* initialize some variables *)
Error := FALSE; (* no errors yet *)
ErrNum := 0;
GetDTAaddr(DTAAdr); (* get current DTA address from DOS *)
GetEN(EN,DTAAdr); (* get command tail and look for /n *)

(* let's see where we are at and how we are doing *)
IF (~ Error) THEN
WriteString('CTRL-X terminates program at any point.');
WriteLn;WriteLn
ELSE (* got an error already *)
BadCommandLine(ErrNum) (* can't continue *)
END; (* if *)

(* OK so far *)
TMPDir := '\TMP'; (* name of directories to clean *)
SetFileAdrs(FAttr,FDate,FName,DTAAdr);
FindTMPs(NumDirs,NumTmps,FirstTmp,TMPDir,DTAAdr);
IF (Error) THEN
WriteString('ERROR: ');
WriteCard(ErrNum,1);
WriteLn;WriteLn;
WriteError(ErrNum);
WriteLn;
WriteString('Program terminating with no files deleted.');
WriteLn;
Terminate(ErrNum)
ELSE (* OK to go ahead and try to delete files in ..\TMP directories *)
(* let user know we did something *)
WriteString('Total subdirectories = ');
WriteCard(NumDirs,1);
WriteString(' ..\TMP subdirectories = ');
WriteCard(NumTmps,1);
WriteLn;WriteLn;
IF (FirstTmp = NIL) THEN
WriteString('No ..\TMP directories found.');
WriteLn;
WriteString('Program terminating with no files deleted.');
WriteLn;
Terminate(ErrNum)
ELSE (* got some ..\TMP directories to clean *)
SetDelDate(DelDate,EN); (* files < DelDate will get deleted *)
DeleteTMPs(DelDate,FirstTmp,NumFiles);
(* tell user how many files we deleted, and terminate program *)
WriteLn;
WriteString('Files deleted = ');
WriteCard(NumFiles,1);
WriteLn;
Terminate(ErrNum)
END (* if *)
END (* if *)

END ClnTmp. (* main module *)