PROGRAM GarbageCompactor; {$I "Include:Utils/Break.i"} {$I "Include:Libraries/DOS.i"} {$I "Include:Utils/DateTools.i"} {$I "Include:Utils/StringLib.i"} {$I "Include:Utils/Parameters.i"} { Trash Compactor version 1.11 December 7, 1991 version 1.1 December 7, 1991 version 1.0 November 26, 1991 Stephan Zuercher internet: szuerche@jarthur.claremont.edu GEnie: S.ZUERCHER A program that will check the trashcan for file that have been in the trashcan for more than a specified number of days, deleting any files that meet the requirement of having been there long enough. This program was inspired by a program on Norton Desktop (an add-on to Microsoft's Windows for the IBM PC) that does pretty much the same thing as this program. Forgive me for not having written it in C. I need the practice in Pascal and PCQ also happens to be the only compiled programming language available to me right now. Command line parameters: TrashCompactor [-#] [path1] [path2] ... [path10] [quiet] Where # is the number of days old a file must be before it gets sent to Never-Never Land and path1, path2, ... path10 are up to ten different paths to the various trashcans that may or may NOT be floating around your system. If the quiet switch is given, the program will NOT tell you that it is deleting files. If no parameters are given on the command line, the program will default to 5 days old, SYS:Trashcan, and will tell you that it is in fact deleting files. There is a maximum number of days old for -# parameter. It is 28 days. There is also a minimum number of days. That's one day. 8) Version 1.11 We couldn't delete subdirectories of the trashcan. It checked the date on the subdir before deletion, however, if _any_ files had been deleted from the subdir, its date would be the current date and the subdir itself wouldn't get deleted. Solution: Try to delete all subdirs. If they're empty, then they disappear, otherwise they stay. Not pretty, but it works. Version 1.1 If there was more than one subdirectory in the Trashcan it would only find the first. Argh. I knew I shouldn't have used the code from Find.p. Well its rewritten now. It should work. Version 1.0 Well, it runs. Doesn't give back 200 bytes of memory, but I know where that is. } TYPE CLarray1 = ARRAY [1..12] OF String; CLarray2 = ARRAY [1..10] OF String; VAR CLstrings : CLarray2; BeQuiet : BOOLEAN; MaxDaysOld, DelYear, count, numdel, totdel : Short; DelMonth,DelDay : BYTE; FUNCTION StringToInteger(t : String) : Integer; { This function takes an integer value from a string and converts it into a pascal integer. Please NOT that it has been modified for TrashCompactor by stopping before the negative sign that is prepended to each string passed. That means if you steal this routine for your own program you'll have to modify it for negative numbers, or if you'll only be needing positive conversions, change the DOWNTO 1 in the FOR loop to DOWNTO 0. } VAR tot,x,count,place,factor,length : Integer; BEGIN { StringToInteger } x := 0; { Initialize variables } tot := 0; factor := 1; length := strlen(t); FOR count := length-1 DOWNTO 1 DO { Loop for last digit in number to first } BEGIN x := (ORD(t[count])-48) * factor; { Determine value of a digit } { Multiply x by the factor for the place value } tot := tot + x; { Add x to the current tot } factor := factor * 10; { Multiply factor by 10, to get the value for the next multiplication factor } END; StringToInteger := tot; END; { StringToInteger } PROCEDURE GetCL(VAR CLstr : CLarray2; VAR DaysBack : Short; VAR ShutUp : BOOLEAN); { This procedure gets the command line parameters, and returns an array containing up to ten paths minus the other parameters. The proceudre also returns how many days old a file can be before it gets deleted and whether output should be suppressed. } VAR allCLstr : CLarray1; numparams, count, returncount : Short; temp : String; BEGIN DaysBack := 5; ShutUp := False; FOR count := 1 TO 12 DO allCLstr[count] := AllocString(128); count := 0; returncount := 0; temp := AllocString(128); REPEAT BEGIN count := count + 1; GetParam(count,allCLstr[count]); END UNTIL (strlen(allCLstr[count]) < 1) OR (count = 12); IF strlen(allCLstr[count]) < 1 THEN numparams := count - 1 ELSE numparams := count; FOR count := 1 TO numparams DO IF strnieq(allCLstr[count],"-",1) THEN BEGIN strcpy(temp,allCLstr[count]); IF (temp[1] = 'h') OR (temp[1] = 'H') OR (temp[1] = '?') THEN DaysBack := -42 ELSE BEGIN DaysBack := StringToInteger(temp); IF DaysBack > 28 THEN DaysBack := 28; END END ELSE IF strnieq(allCLstr[count],"QUIET",5) THEN ShutUp := True ELSE BEGIN returncount := returncount + 1; CLstr[returncount] := allCLstr[count]; END; IF returncount = 0 THEN CLstr[1] := strdup("SYS:Trashcan") ELSE IF returncount < 10 THEN FOR returncount := returncount + 1 TO 10 DO CLstr[returncount] := AllocString(1); END; { Get CL } PROCEDURE GetDeleteDate( DaysBack : SHORT; VAR DelMonth,DelDay : BYTE; VAR DelYear : SHORT); VAR SysDate, DelDate : DateDescription; BEGIN TimeDesc(SysDate); { Get System Date. If this isn't set } WITH SysDate DO { before execution, thou art reamed... } BEGIN IF (Year/4) = (Year DIV 4) THEN { Is this a leap year? If so... make } DaysInMonth[1] := 29; { # of days in Feb = 29 instead of 28 } IF Day > DaysBack THEN BEGIN DelDay := Day - DaysBack; { If we are >DaysBack into the month, } DelMonth := Month; { just back up the date x days to find } DelYear := Year; { what date to delete file before } END { Block } ELSE IF Month > 1 THEN { Otherwise if this isn't Jan, we back } BEGIN { into the previous month, keeping the } DelDay := (Day-DaysBack) + DaysInMonth[Month-2]; DelMonth := Month - 1; { year. Note DaysInMonth is zero based} DelYear := Year; { but Month isn't. Go figure... } END { Block } ELSE BEGIN { Otherwise we get to back up into the } DelDay := (Day-DaysBack) + DaysInMonth[11]; DelMonth := 12; { previous year! Month *has* to be Dec} DelYear := Year - 1 { in case you care to know... } END; { Block } END; { With Block } END; FUNCTION CheckDateAndDelete( path : String; FIBptr : FileInfoBlockPtr) : BOOLEAN; VAR pathname, filename : String; DOSError, datediff : Integer; DD : DateDescription; DeleteIt : BOOLEAN; dirlock : FileLock; BEGIN DeleteIt := FALSE; { set up some stuff... } pathname := AllocString(140); filename := AllocString(31); strcpy(pathname,path); { path is dir file is in } strcpy(filename,ADR(FIBptr^.fib_FileName)); { get filename from FIB } strcat(pathname,"/"); { put a / on the end of dir } strcat(pathname,filename); { put filename on end of dir } StampDesc(FIBptr^.fib_Date,DD); { get date from file } WITH DD DO IF DelYear > Year THEN { check date against global } DeleteIt := TRUE { DelDates } ELSE IF DelYear = Year THEN IF DelMonth > Month THEN DeleteIt := TRUE ELSE IF DelMonth = Month THEN IF DelDay > Day THEN DeleteIt := TRUE; IF NOT BeQuiet THEN { Print out the filename if we're allowed } Write(pathname,' '); IF DeleteIt THEN { Delete file if its old enough. } BEGIN IF DeleteFile(pathname) THEN BEGIN IF NOT BeQuiet THEN { Inform user of deletion } WriteLn('\e[33;1mdeleted.\e[31;40;0m'); END ELSE BEGIN DeleteIt := FALSE; { Problem... } DOSError := IOErr; IF (DOSError = ERROR_DELETE_PROTECTED) THEN BEGIN IF BeQuiet THEN { We tell the user about deletion } Write(pathname,' '); { Protection even if we're supposed } { to be quiet... } WriteLn('protected from deletion.'); END ELSE IF NOT BeQuiet THEN { Inform user of error } WriteLn('not deleted. \e[33;1mError #',DOSError,'\e[31;40;0m'); END; END ELSE IF NOT BeQuiet THEN WriteLn('not deleted. File too new.'); CheckDateAndDelete := DeleteIt; END; PROCEDURE DeleteDir(pathname : String); { We try to delete the directory. Assuming its empty it works, otherwise, it not empty and we don't do anything. In version 1.1, this procedure didn't exist. I used a call to CheckDateAndDelete and checked FIBptr within that function to see if this was a directory. It it was, the function didn't do any string manipulation to get a pathname, because the correct one was already in the calling parameters. Only one problem, deleting a file within a directory changes its date. That means that subdirectories in the trashcan NEVER got deleted unless they were empty to begin with. Now we try to delete all subdirs. If they're empty they're gone, if not then we leave them. Simple. } VAR DOSError : Integer; BEGIN IF NOT BeQuiet THEN Write(pathname,' '); IF NOT DeleteFile(pathname) THEN BEGIN DOSError := IOErr; IF DOSError <> ERROR_DIRECTORY_NOT_EMPTY THEN BEGIN IF NOT BeQuiet THEN WriteLn('not deleted. \e[33;1mError #',DOSError,'\e[31;40;0m'); END ELSE IF NOT BeQuiet THEN WriteLn('not deleted.'); END ELSE IF NOT BeQuiet THEN WriteLn('\e[33mdeleted.\e[31;40;0m'); END; { DeleteDir } FUNCTION CleanUpDir(dir : string) : Short; { This function runs down the dir list using ExNext...If it finds a directory, it calls itself recursively. After it goes through a directory, it tries to delete it if files were deleted from within it } VAR flock, dirlock : FileLock; FIBptr : FileInfoBlockPtr; DoAnother, barf : BOOLEAN; DOSError : Integer; count, subdircount : Short; newdir : String; BEGIN count := 0; flock := Lock(dir,ACCESS_READ); IF flock = NIL THEN { Couldn't get lock: dir doesn't exist! } CleanUpDir := -1; New(FIBptr); IF NOT Examine(flock,FIBptr) THEN { Can't get info on flock!? } BEGIN Unlock(flock); CleanUpDir := 0; END; IF FIBptr^.fib_DirEntryType < 0 THEN { This isn't a directory, its a file! } BEGIN Unlock(flock); CleanUpDir := -2; END; REPEAT BEGIN DoAnother := ExNext(flock, FIBptr); IF CheckBreak THEN DoAnother := FALSE; IF DoAnother THEN BEGIN IF FIBptr^.fib_DirEntryType < 0 THEN { we've got a file... } BEGIN IF CheckDateAndDelete(dir,FIBptr) THEN count := count + 1; END ELSE BEGIN { Another directory... } newdir := AllocString(109); strcpy(newdir,dir); strcat(newdir,"/"); strcat(newdir,ADR(FIBptr^.fib_FileName)); subdircount := CleanUpDir(newdir); count := count + subdircount; IF subdircount > 0 THEN BEGIN dirlock := Lock(newdir,ACCESS_READ); IF dirlock = NIL THEN BEGIN WriteLn('Unable to lock ',newdir); Exit(25); END; IF NOT Examine(dirlock,FIBptr) THEN BEGIN WriteLn('Unable to examine ',newdir); Exit(25); END; Unlock(dirlock); DeleteDir(newdir); END; END END ELSE BEGIN DOSError := IOErr; { This might not be bad... } IF (DOSError <> ERROR_NO_MORE_ENTRIES) AND NOT CheckBreak THEN WriteLn('\nError #',DOSError,' has occurred.'); END; END; UNTIL NOT DoAnother; Unlock(flock); CleanUpDir := count; END; BEGIN GetCL(CLstrings,MaxDaysOld,BeQuiet); IF (MaxDaysOld = -42) OR strieq(CLstrings[1],"H") OR strieq(CLstrings[1],"?") THEN BEGIN WriteLn; WriteLn('\e[33;1mTrashCompactor\e[31;40;0m by Stephan Zuercher'); WriteLn('Version 1.11 on December 7, 1991'); WriteLn; WriteLn('Usage: TrashCompactor -# [path1] [path2] ... [path10] [QUIET]'); WriteLn; WriteLn('Where # = age of files in days before deletion occurs.'); WriteLn(' The default is 5 days.'); WriteLn(' path# = one of ten possible directories to treat as'); WriteLn(' Trashcans. Default is SYS:Trashcan.'); WriteLn(' QUIET = a switch that controls the whether the program'); WriteLn(' outputs information about file deletion to the'); WriteLn(' screen.'); Exit(20); END; GetDeleteDate(MaxDaysOld,DelMonth,DelDay,DelYear); count := 1; numdel := 0; totdel := 0; WHILE (StrLen(CLStrings[count]) > 0) AND NOT CheckBreak DO BEGIN numdel := CleanUpDir(CLStrings[count]); IF numdel >= 0 THEN totdel := totdel + numdel ELSE BEGIN Write(CLStrings[count]); IF numdel = -2 THEN WriteLn(' is NOT a directory.') ELSE WriteLn(' does NOT exist.'); END; count := count + 1; END; IF NOT BeQuiet THEN WriteLn(totdel,' files deleted.'); END.