ProfitPress Mega CDROM2 …eeware (MSDOS)(1992)(Eng)/ProfitPress-MegaCDROM2.B6I/UTILITY/DIR/DU113.ZIP/DU.MOD

Text File | 1992-04-10 | 18.0 KB | 814 lines

MODULE du;

IMPORT FIO,IO,Lib,Str,SYSTEM,Storage;

TYPE
  String = ARRAY [0..128] OF CHAR;
  FileSpec = RECORD
    i : BOOLEAN;
    n : String;
  END;
  bs = SET OF [0..31];
  DirStack = POINTER TO DirStackEntry ;
  DirStackEntry = RECORD
    d : String ;
    n : DirStack ;
  END;

CONST
  FileAttr = FIO.FileAttr{FIO.archive,FIO.hidden,FIO.system,FIO.directory};

  eol =
    CHAR(13)+CHAR(10);
  helptext =
    'du v1.13 (c) 1991-92 Arnt Gulbrandsen'+eol+eol+
    'du {options|filespec} {directory {options|filespecs}} '+eol+
    '/a -a  List individual file sizes'+eol+
    '/d -d  Debug'+eol+
    '/i -i  Include following filespecs'+eol+
    "/n -n  Don't include subdirectories in directory size"+eol+
    '/s -s  Sum only (like -0)'+eol+
    '/x -x  Exclude following filespecs'+eol+
    "/w -w  Show wasted space (in percent)"+eol+
    "/z -z  Don't show 0k directories / files"+eol+
    '/0...  Show only the top 0..65535 levels of the directory tree'+eol+
    '/? /h  Help'+eol+eol+
    '/e -e  Only count files dated earlier than the given date.  -e311091, eg.'+eol+
    '/l -l  Only count later, as -e.  The date format depends on the country.'+eol+eol+
    'Filespecs may contain ? (any single character except /), * (0 or more'+eol+
    'chars), and [list] (matches any single character in the list).  The full'+eol+
    'stop is not special, *[a-cx]* will match any file containing A,B,C or'+eol+
    'X anywhere in the file name or extension.';

VAR
  opt_a,
  opt_d,
  opt_h,
  opt_n,
  opt_w,
  opt_z:BOOLEAN;
  max_depth,
  cur_depth:CARDINAL;
  IncludeAll,
  include:BOOLEAN;

  Specs : ARRAY [0..99] OF FileSpec;
  FileSpecs : CARDINAL;

  stepup ,
  granularity : LONGCARD;

  later ,
  earlier : CARDINAL ;

  filedata:FIO.DirEntry;


PROCEDURE Match(VAR a,b: String):BOOLEAN;

  PROCEDURE Test(p,q:CARDINAL):BOOLEAN;
  VAR
    f:BOOLEAN;
    r:CARDINAL;
  BEGIN
    IF (p=0) AND (q=0) THEN
      RETURN(TRUE);
    ELSIF (p=0) AND (b[q-1]='/') THEN
      RETURN(TRUE);
    ELSIF (p=0) OR (q=0) THEN
      RETURN(FALSE);
    ELSE
      DEC(p);
      DEC(q);
      CASE a[p] OF
        |'?':
          RETURN(Test(p,q));
        |'*':
          r:=q;
          REPEAT
            IF b[r]='/' THEN
              f:=(p=0);
            ELSE
              f:=Test(p,r);
            END;
            IF r>0 THEN
              DEC(r);
            END;
          UNTIL f OR (r=0);
          RETURN(f);
        |']':
          r:=p;
          WHILE (a[r]#'[') AND (r>0) DO
            DEC(r);
          END;
          INC(r);
          f:=FALSE;
          WHILE NOT(f) AND (r<p) DO
            IF a[r+1]='-' THEN
              f:=(a[r]<=b[q]) AND (a[r+2]>=b[q]);
            ELSE
              f:=(a[r]=b[q]);
            END;
            INC(r);
          END;
          RETURN(f);
      ELSE
        RETURN((a[p]=b[q]) AND Test(p,q));
      END;
    END;
  END Test;

BEGIN
  RETURN(Test(Str.Length(a),Str.Length(b)));
END Match;



PROCEDURE Print(TrueSize,NominalSize:LONGCARD;VAR name:String;dir:BOOLEAN);

  PROCEDURE PrintWasted;
  BEGIN
    IF opt_w THEN
      IF TrueSize>0 THEN
        IO.WrLngCard(LONGCARD(LONGREAL(TrueSize-NominalSize)*100.0/LONGREAL(TrueSize)),2);
        IO.WrStr('.');
        IO.WrLngCard(LONGCARD(LONGREAL(TrueSize-NominalSize)*10005.0/LONGREAL(TrueSize)/10.0) MOD 10,1);
      ELSE
        IO.WrStr(' 0.0');
      END;
      IO.WrStr('%  ');
    END;
  END PrintWasted;

BEGIN
  IF dir THEN
    IF (cur_depth<=max_depth) AND (NOT(opt_z) OR (TrueSize>0)) THEN
      IO.WrLn;
      IO.WrLngCard(TrueSize DIV 1024,7);
      IO.WrStr('k  ');
      PrintWasted;
      IO.WrStr(name);
    END;
  ELSE
    IF opt_a AND (NOT(opt_z) OR (TrueSize>0)) THEN
      IO.WrLn;
      IO.WrLngCard(TrueSize DIV 1024,7);
      IO.WrStr('k  ');
      PrintWasted;
      IO.WrStr(name);
    END;
  END;
END Print;



PROCEDURE ScanDirectory(VAR dir:String;VAR TrueSize,NominalSize:LONGCARD);
VAR
  NominalFileSize,
  TrueFileSize : LONGCARD;
  file : String;
  foo : BOOLEAN;
  bar : CARDINAL;
  SubDirs ,
  nsd : DirStack;
  csd : POINTER TO DirStack;
BEGIN
  SubDirs := NIL;
  INC(cur_depth);
  Str.Concat(file,dir,'*.*');
  NominalSize:=0;
  TrueSize:=0;
  IF FIO.ReadFirstEntry(file,FileAttr,filedata) THEN
    REPEAT
      Str.Lows(filedata.Name);
      IF IncludeAll THEN
        INC(NominalSize,32);
        INC(TrueSize,32);
      END;
      TrueFileSize:=0;
      NominalFileSize:=0;
      IF
        (filedata.Name[0]#'.')
      AND
        (filedata.Name[1]#'.')
      THEN
        Str.Concat(file,dir,filedata.Name);
        IF FIO.directory IN filedata.attr THEN
          csd:=ADR(SubDirs);
          WHILE csd^#NIL DO
            csd:=ADR(csd^^.n);
          END;
          Storage.ALLOCATE(csd^,SIZE(DirStackEntry));
          IF csd^=NIL THEN
            IO.WrLn;
            IO.WrStr('Error: Out of memory.');
            HALT;
          END;
          Str.Concat(csd^^.d,file,'/');
          csd^^.n:=NIL;
        ELSIF (filedata.date>=later) AND (filedata.date<=earlier) THEN
          foo:=IncludeAll;
          FOR bar:=1 TO FileSpecs DO
            IF Specs[bar].i THEN
              foo:=foo OR Match(Specs[bar].n,file);
            ELSE
              foo:=foo AND NOT(Match(Specs[bar].n,file));
            END;
          END;
          IF foo THEN
            NominalFileSize:=filedata.size;
            TrueFileSize:=LONGCARD(bs(filedata.size+stepup)*bs(granularity));
            Print(TrueFileSize,NominalFileSize,file,FALSE);
          END;
        END;
      END;
      INC(TrueSize,TrueFileSize);
      INC(NominalSize,NominalFileSize);
    UNTIL NOT(FIO.ReadNextEntry(filedata));
    WHILE SubDirs#NIL DO
      ScanDirectory(SubDirs^.d,TrueFileSize,NominalFileSize);
      Print(TrueFileSize,NominalFileSize,SubDirs^.d,TRUE);
      IF opt_n THEN
        TrueFileSize:=0;
        NominalFileSize:=0;
      END;
      INC(TrueSize,TrueFileSize);
      INC(NominalSize,NominalFileSize);
      nsd:=SubDirs;
      SubDirs:=SubDirs^.n;
      Storage.DEALLOCATE(nsd,SIZE(DirStackEntry));
    END;
  END;
  DEC(cur_depth);
  TrueSize:=LONGCARD(bs(TrueSize+stepup)*bs(granularity));
END ScanDirectory;




PROCEDURE IsFilespec(VAR a:String):BOOLEAN;
VAR
  p:CARDINAL;
  f:BOOLEAN;
BEGIN
  p:=0;
  f:=(a[0]#CHAR(0)) AND (a[0]#'/') AND (a[0]#'-');
  WHILE f AND (a[p]#CHAR(0)) DO
    IF a[p]='\' THEN
      a[p]:='/';
    END;
    f:=f AND (a[p] IN Str.CHARSET{'0'..'9','A'..'Z','a'..'z','$','%',
                                  "'",'-','@','{','}','~','`','!','#',
                                  '(',')','&','.','/','[','?','*',
                                  CHAR(128)..CHAR(255)});
    IF a[p]='[' THEN
      REPEAT
        INC(p);
        f:=f AND (a[p]#CHAR(0)) AND (a[p]#'[') AND (a[p]#'-');
        IF f AND (a[p+1]='-') AND (a[p+2]#']') THEN
          INC(p);
        END;
        INC(p);
      UNTIL NOT(f) OR (a[p]=']');
    END;
    INC(p);
  END;
  RETURN(f);
END IsFilespec;



PROCEDURE IsDirectory(a:String):BOOLEAN;

  (*
   * I copied the FIO ReadFirstEntry / ReadNextEntry
   * and deleted some error checking so ReadFirstEntry
   * doesn't burp on being given a nonsense path
   * like -a or *.zip
   *)

  PROCEDURE ReadFirstEntry ( DirName : ARRAY OF CHAR;
                             Attr    : FIO.FileAttr;
                             VAR D   : FIO.DirEntry) : BOOLEAN;
  VAR
    r  : SYSTEM.Registers;
  BEGIN
    WITH r DO
      AH := 1AH;
      DS := Seg(D);
      DX := Ofs(D);
      Lib.Dos(r);    (* set DTA *)
      AH := 4EH;
      DS := Seg(DirName);
      DX := Ofs(DirName);
      CL := SHORTCARD(Attr);
      CH := SHORTCARD(0);
      Lib.Dos(r);
      IF (BITSET{SYSTEM.CarryFlag} * Flags) # BITSET{} THEN
        RETURN FALSE;
      END;
    END;
    RETURN TRUE;
  END ReadFirstEntry;

  PROCEDURE ReadNextEntry(VAR D: FIO.DirEntry) : BOOLEAN;
  VAR
    r : SYSTEM.Registers;
  BEGIN
    WITH r DO
      AH := 1AH;
      DS := Seg(D);
      DX := Ofs(D);
      Lib.Dos(r);    (* set DTA *)
      AH := 4FH;
      Lib.Dos(r);
      IF (BITSET{SYSTEM.CarryFlag} * Flags) # BITSET{} THEN
        RETURN FALSE;
      END;
    END;
    RETURN TRUE;
  END ReadNextEntry;


VAR
  d:FIO.DirEntry;
  foo:String;
BEGIN
  IF (Str.CharPos(a,'*')<65535) THEN
    RETURN(FALSE);
  END;
  IF (Str.CharPos(a,'[')<65535) THEN
    RETURN(FALSE);
  END;
  IF (Str.CharPos(a,'?')<65535) THEN
    RETURN(FALSE);
  END;
  IF ReadFirstEntry(a,FileAttr,d) AND (FIO.directory IN d.attr) THEN
    RETURN(TRUE);
  ELSE
    IF (a[Str.Length(a)-1] IN Str.CHARSET{'/','\'}) THEN
      Str.Concat(foo,a,'*.*');
    ELSE
      Str.Concat(foo,a,'/*.*');
    END;
    RETURN(ReadFirstEntry(foo,FileAttr,d));
  END;
END IsDirectory;


PROCEDURE GetDate(a:String;pos:CARDINAL):CARDINAL;
VAR
  CountryBuffer: ARRAY [0..63] OF SHORTCARD;
  r : SYSTEM.Registers;
  dd,mm,yy : String ;
  d,m,y:LONGCARD;
  ok : BOOLEAN ;
BEGIN
  Str.Delete(a,0,pos);
  IF Str.Length(a)>5 THEN
    a[6]:=CHAR(0);

    r.DS:=Seg(CountryBuffer);
    r.DX:=Ofs(CountryBuffer);
    r.AX:=3800H;
    Lib.Dos(r);

    CASE CountryBuffer[0] OF
      |0: Str.Slice(yy,a,4,2);
          Str.Slice(mm,a,0,2);
          Str.Slice(dd,a,2,2);
      |1: Str.Slice(yy,a,4,2);
          Str.Slice(mm,a,2,2);
          Str.Slice(dd,a,0,2);
      |2: Str.Slice(yy,a,0,2);
          Str.Slice(mm,a,2,2);
          Str.Slice(dd,a,4,2);
    ELSE
      RETURN(MAX(CARDINAL));
    END;

    ok:=TRUE;
    y:=Str.StrToCard(yy,10,ok);
    IF ok THEN
      m:=Str.StrToCard(mm,10,ok);
      IF (m=0) OR (m>12) THEN ok:=FALSE END;
      IF ok THEN
        d:=Str.StrToCard(dd,10,ok);
        IF (d=0) OR (d>31) THEN ok:=FALSE END;
      END;
    END;
    IF ok THEN
      IF y>79 THEN
        y:=y+1900;
      ELSE
        y:=y+2000;
      END;
      RETURN(CARDINAL((y-1980)*512+m*32+d));
    ELSE
      RETURN(MAX(CARDINAL));
    END;
  END;
  RETURN(MAX(CARDINAL));
END GetDate;




PROCEDURE IsSwitch(a:String):BOOLEAN;
VAR
  foo,
  bar,
  gaz : CARDINAL ;
  valid:BOOLEAN ;
BEGIN
  IF Str.Length(a)>1 THEN
    IF (a[0]='-') OR (a[0]='/') THEN
      valid:=TRUE;
      bar:=0;
      FOR foo:=1 TO Str.Length(a)-1 DO
        IF (a[foo]>='0') AND (a[foo]<='9') THEN
          IF (bar>6553) OR ( (bar=6553) AND (a[foo]>'5') ) THEN
            valid:=FALSE;
          ELSE
            bar:=bar*10+(CARDINAL(a[foo])-48);
          END;
        ELSIF a[foo] IN Str.CHARSET{'e','l'} THEN
          bar:=0;
          IF GetDate(a,foo+1)<MAX(CARDINAL) THEN
            foo:=foo+6;
          ELSE
            valid:=FALSE;
          END;
        ELSIF a[foo] IN Str.CHARSET{'a','s','d','h','?','w','z','i','x','n'} THEN
          bar:=0;
        ELSE
          valid:=FALSE;
        END;
      END;
    ELSE
      valid:=FALSE;
    END;
  ELSE
    valid:=FALSE;
  END;
  RETURN(valid);
END IsSwitch;



PROCEDURE CheckArgs();
VAR
  argno,
  argv:CARDINAL;
  arg:String;
BEGIN
  opt_d:=FALSE;
  opt_h:=FALSE;
  argv:=Lib.ParamCount();
  FOR argno:=1 TO argv DO
    Lib.ParamStr(arg,argno);
    IF IsSwitch(arg) THEN
      IF IsDirectory(arg) THEN
        IO.WrLn;
        IO.WrStr(arg);
        IO.WrStr(' is valid both as switch and base directory.');
        Lib.SetReturnCode(2);
        HALT;
      ELSIF IsFilespec(arg) THEN
        IO.WrLn;
        IO.WrStr(arg);
        IO.WrStr(' is valid both as switch and file specification.');
        Lib.SetReturnCode(2);
        HALT;
      ELSE
        IF Str.CharPos(arg,'d')<MAX(CARDINAL) THEN
          opt_d:=TRUE;
        END;
        IF Str.CharPos(arg,'h')<MAX(CARDINAL) THEN
          opt_h:=TRUE;
        END;
      END;
    ELSIF IsDirectory(arg) THEN
      (* all dirs are filespecs also so don't try IsFilespec *)
    ELSIF IsFilespec(arg) THEN
      (* no action necessary *)
    ELSE
      IO.WrLn;
      IO.WrStr(arg);
      IO.WrStr(" isn't a valid argument.");
      Lib.SetReturnCode(2);
      HALT;
    END;
  END;
  IF opt_d THEN
    IO.WrLn;
    IO.WrStr('Command line arguments:');
    FOR argno:=1 TO argv DO
      Lib.ParamStr(arg,argno);
      IO.WrLn;
      IO.WrStr('  "');
      IO.WrStr(arg);
      IF IsDirectory(arg) THEN
        IO.WrStr('" is a base directory');
      ELSIF IsSwitch(arg) THEN
        IO.WrStr('" is a switch');
      ELSE
        IO.WrStr('" is a file specification');
      END;
    END;
  END;
END CheckArgs;




PROCEDURE SetFlags(a:String);
VAR
  foo:CARDINAL;
  bar:BOOLEAN;
BEGIN
  bar:=FALSE;
  FOR foo:=1 TO Str.Length(a) DO
    CASE a[foo] OF
      |'a':
        opt_a:=TRUE;
        bar:=FALSE;
      |'s':
        max_depth:=0;
        bar:=FALSE;
      |'d':
        bar:=FALSE;
      |'e':
        bar:=FALSE;
        earlier:=GetDate(a,foo+1);
        foo:=foo+6;
      |'h','?':
        bar:=FALSE;
      |'l':
        bar:=FALSE;
        later:=GetDate(a,foo+1);
        foo:=foo+6;
      |'w':
        opt_w:=TRUE;
        bar:=FALSE;
      |'z':
        opt_z:=TRUE;
        bar:=FALSE;
      |'x':
        include:=FALSE;
        bar:=FALSE;
      |'i':
        include:=TRUE;
        bar:=FALSE;
      |'n':
        opt_n:=TRUE;
        bar:=FALSE;
      |'0'..'9':
        IF NOT(bar) THEN
          max_depth:=0;
        END;
        max_depth:=max_depth*10+(CARDINAL(a[foo])-48);
        bar:=TRUE;
    END;
  END;
END SetFlags;



PROCEDURE FindClusterSize(dir:String);
VAR
  r : SYSTEM.Registers;
BEGIN
  IF (Str.Length(dir)>2) AND (dir[1]=':') THEN
    r.DL:=SHORTCARD(dir[0])-96;
  ELSE
    r.DL:=0;
  END;
  r.AH:=36H;
  Lib.Dos(r);
  IF r.AX=0FFFFH THEN
    stepup:=1023;
  ELSE
    stepup:=LONGCARD(r.AX*r.CX-1);
  END;
  granularity:=MAX(LONGCARD)-stepup;
END FindClusterSize;


PROCEDURE WrDate(d:CARDINAL);
BEGIN
  CASE ((d DIV 32) MOD 16) OF
    |1: IO.WrStr('January ');
    |2: IO.WrStr('February ');
    |3: IO.WrStr('March ');
    |4: IO.WrStr('April ');
    |5: IO.WrStr('May ');
    |6: IO.WrStr('June ');
    |7: IO.WrStr('July ');
    |8: IO.WrStr('August ');
    |9: IO.WrStr('September ');
    |10: IO.WrStr('October ');
    |11: IO.WrStr('November ');
    |12: IO.WrStr('December ');
  END;
  IO.WrCard(d MOD 32,2);
  IO.WrStr(', ');
  IO.WrCard((d DIV 512)+1980,4);
  IO.WrLn;
END WrDate;


PROCEDURE ParseArgs();
VAR
  argv,
  argno : CARDINAL;
  arg : String;

  s_depth ,
  s_later ,
  s_earlier : CARDINAL;
  s_a,
  s_n,
  s_w,
  s_z,
  s_inc : BOOLEAN;

  base : String;

  lastglobalfs : CARDINAL;

  PROCEDURE DoScan();
  VAR
    TrueSize,
    NominalSize : LONGCARD;

    foo:CARDINAL;
    bar:LONGCARD;
  BEGIN
    IncludeAll:=TRUE;
    FOR foo:=1 TO FileSpecs DO
      IF Specs[foo].i THEN
        IncludeAll:=FALSE;
      END;
    END;
    IF base[Str.Length(base)-1]#'/' THEN
      Str.Append(base,'/');
    END;
    IF opt_d THEN
      IO.WrLn;
      IO.WrLn;
      IO.WrStr('Base directory: ');
      IO.WrStr(base);
      IO.WrLn;
      IO.WrStr('  Switches: ');
      IF opt_a THEN
        IO.WrStr('a ');
      END;
      IF opt_n THEN
        IO.WrStr('n ');
      END;
      IF opt_w THEN
        IO.WrStr('w ');
      END;
      IF opt_z THEN
        IO.WrStr('z ');
      END;
      IO.WrLn;
      IO.WrLn;
      IF earlier<MAX(CARDINAL) THEN
        IO.WrStr('  Count files dated on or before:  ');
        WrDate(earlier);
      END;
      IF later>0 THEN
        IO.WrStr('  Count files dated on or after:  ');
        WrDate(later);
      END;
      IF (earlier=MAX(CARDINAL)) AND (later=0) THEN
        IO.WrStr('  No file date limits.');
        IO.WrLn;
      END;
      IO.WrLn;
      IO.WrStr('  List depth:');
      IO.WrCard(max_depth,6);
      IF IncludeAll THEN
        IO.WrLn;
        IO.WrStr('  Include all files');
      END;
      FOR foo:=1 TO FileSpecs DO
        IO.WrLn;
        IF Specs[foo].i THEN
          IO.WrStr('  Include: ');
        ELSE
          IO.WrStr('  Exclude: ');
        END;
        IO.WrStr(Specs[foo].n);
      END;
    ELSE
      FindClusterSize(base);
      ScanDirectory(base,TrueSize,NominalSize);
      Print(TrueSize,NominalSize,base,TRUE);
    END;
  END DoScan;

  PROCEDURE FixAppearance();
  VAR
    foo:CARDINAL;
  BEGIN
    foo:=0;
    WHILE arg[foo]#CHAR(0) DO
      IF arg[foo]='\' THEN
        arg[foo]:='/';
      ELSIF (arg[foo]>='A') AND (arg[foo]<='Z') THEN
        arg[foo]:=CHAR(CARDINAL(arg[foo])+32);
      END;
      INC(foo);
    END;
  END FixAppearance;

BEGIN
  later:=0;
  earlier:=MAX(CARDINAL);
  opt_a:=FALSE;
  opt_n:=FALSE;
  opt_w:=FALSE;
  opt_z:=FALSE;
  include:=TRUE;
  max_depth:=65535;
  base:='.';
  FileSpecs:=0;
  argv:=Lib.ParamCount();
  argno:=0;
  WHILE argno<argv DO
    INC(argno);
    Lib.ParamStr(arg,argno);
    IF IsSwitch(arg) THEN
      SetFlags(arg);
    ELSE
      FixAppearance;
      IF IsDirectory(arg) THEN
        IF Str.Compare(base,'.')#0 THEN
          DoScan;
          later:=s_later;
          earlier:=s_earlier;
          opt_a:=s_a;
          opt_n:=s_n;
          opt_w:=s_w;
          opt_z:=s_z;
          include:=s_inc;
          max_depth:=s_depth;
          FileSpecs:=lastglobalfs;
        END;
        base:=arg;
        s_later:=later;
        s_earlier:=earlier;
        s_a:=opt_a;
        s_n:=opt_n;
        s_w:=opt_w;
        s_z:=opt_z;
        s_inc:=include;
        s_depth:=max_depth;
        lastglobalfs:=FileSpecs;
      ELSE
        INC(FileSpecs);
        Specs[FileSpecs].i:=include;
        Specs[FileSpecs].n:=arg;
        Str.Lows(Specs[FileSpecs].n);
      END;
    END;
  END;
  DoScan;
END ParseArgs;



BEGIN
  CheckArgs;
  IF opt_h THEN
    IO.WrLn;
    IO.WrStr(helptext);
    Lib.SetReturnCode(1);
  ELSE
    ParseArgs;
    Lib.SetReturnCode(0);
  END;
  IO.WrLn;
END du.