Club Amiga de Montreal - CAM/CAM_CD_1.iso/files/595.lha/TrashCompactor_v1.11/tc.p

Text File | 1991-12-07 | 15.1 KB | 434 lines

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:  [e-mail]
                       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.