Metropoli BBS
VIEWER: crmstat.mod MODE: TEXT (ASCII)
(*---------------------------------------------------------------------------
 :Program.     CrmStat
 :Contents.    CrM-Allround-Utility
 :Author.      Alexander Ehlert
 :Address.     Beethovenstr. 59/3  72458 Albstadt
 :Copyright.   Giftware!
 :Language.    Oberon-2
 :Translator.  Amiga-Oberon V3.10
 :History.     V1.0   25.10.93 first version
               V1.01  1.12.93 added interactive crunchmode
               V1.02  6.12.93 added interactive decrunchmode
               V1.03  6.12.93 fixed errors!
 --------------------------------------------------------------------------*)
MODULE CrMStat;
IMPORT D:Dos,
       A:Arguments,
       S:Strings,
       E:Exec,
       u:Utility,
       SYSTEM,
       CrM,      (* for lightning crunch speed !!!*)
       NoGuruRq; (* murphy protection ;-> *)

VAR pattern,dir,string : ARRAY 256 OF CHAR;
    fanz,fcanz,len,crlen,
    danz               : LONGINT;
    fidi               : D.FileLockPtr;
    info               : D.FileInfoBlock;
    rekursiv,attrib,intadcr,
    Attrib,intacr      : BOOLEAN;

PROCEDURE GetStrings(dn : ARRAY OF CHAR;VAR dir,name : ARRAY OF CHAR);
VAR x,lpos : INTEGER;
BEGIN
  lpos:=-1;
  FOR x:=0 TO SHORT(S.Length(dn))-1 DO
    CASE dn[x] OF
      "/",":" : lpos:=x;
    ELSE END;
  END;
  dir:="";
  name:="";
  IF lpos#-1 THEN
    S.Cut(dn,0,lpos+1,dir);
    S.Delete(dn,0,lpos+1);
  END;
  S.Cut(dn,0,S.Length(dn),name);
END GetStrings;

PROCEDURE CheckCommands(cmds : ARRAY OF CHAR):BOOLEAN;
VAR x : LONGINT;
BEGIN
  IF cmds[0]="-" THEN
    FOR x:=1 TO S.Length(cmds)-1 DO
      CASE cmds[x] OF
         "r" : rekursiv:=TRUE;
        |"a" : attrib:=TRUE;
        |"A" : Attrib:=TRUE;
        |"c" : intacr:=TRUE; Attrib:=TRUE;
        |"d" : intadcr:=TRUE;attrib:=TRUE;
      ELSE END;
    END;
    RETURN TRUE;
  ELSIF cmds[0]="?" THEN
    D.PrintF("\n\[33mUsage :\[0m CrMStat [-raAcd] [<path>|<file>]\n\n"
             "\[33m -r\[0m : rekursiv file scan (scans all directories)\n"
             "\[33m -a\[0m : show all crunched files\n"
             "\[33m -A\[0m : show all not-crunched files\n"
             "\[33m -c\[0m : interactive crunchmode\n"
             "\[33m -d\[0m : interactive decrunchmode\n"
             "\[33m      Crunchmodes:\[0m\n"
             "        0 : LZH\n"
             "        1 : NORM\n"
             "        2 : LZHSAMPLE\n"
             "        3 : NORMSAMPLE\n"
             "\nDisable RTDD(only when running \[33;1mCrMStat V1.03\[0m)!\n"
             "PS.: if you like this program, you could send me a gift:\n"
             "     PD-Stuff,Disks,Monitors,A5000 or 68040'ers for my AMIGA,\n"
             "     GigaByte-Harddisks(only SCSI-II) or other nice little\n"
             "     things! :-) :-) :-)\n"
             "to whom?? TO ME!!!!\n"
             "\[32m->->-> Alexander Ehlert\n"
             "       Beethovenstr.59/3\n"
             "       72458 Albstadt Ebingen\n\[0m"
             "\n");
    HALT(0);
  ELSE
    RETURN FALSE;
  END;
END CheckCommands;

PROCEDURE ShowCBytes(hook : u.HookPtr;
                    csa  : E.APTR;
                    cta  : E.APTR):LONGINT;
VAR
  ct : CrM.CurrentStatsPtr;
  cs : CrM.CrunchStructPtr;
BEGIN
  ct:=cta;
  cs:=csa;
  D.PrintF("Crunching: (%8.8ld/%8.8ld) => %8.8ld\r",
           cs^.SrcLen-ct^.ToGo,
           cs^.SrcLen,ct^.Len);
  RETURN 1;
END ShowCBytes;

PROCEDURE CrunchFile(name : ARRAY OF CHAR;size : LONGINT);
VAR
  file  : D.FileHandlePtr;
  cs    : CrM.CrunchStructPtr;
  dh    : CrM.DataHeader;
  data  : UNTRACED POINTER TO SYSTEM.BYTE;
  mode  : ARRAY 1 OF CHAR;
  smode : LONGSET;
  cnt,
  nlen  : LONGINT;
  hook  : u.Hook;
BEGIN
  D.PrintF("Crunchmode(0=LZH/ 1=Normal/ 2=LZHS/ 3=NormS/ 4=none)\n");
  REPEAT
    mode[0]:=D.ReadChar();
  UNTIL (mode[0]>="0")&(mode[0]<="4");
  CASE mode[0] OF
     "0" : smode:=LONGSET{CrM.LZH};
    |"1" : smode:=LONGSET{CrM.Normal};
    |"2" : smode:=LONGSET{CrM.LZH,CrM.Sample};
    |"3" : smode:=LONGSET{CrM.Normal,CrM.Sample};
  ELSE RETURN
  END;
  smode:=smode+LONGSET{CrM.Overlay,CrM.LEDFlash};
  file:=D.Open(name,D.oldFile);
  IF file#NIL THEN
    cs:=CrM.AllocCrunchStructTags(CrM.CMAlgo,smode);
    IF cs#NIL THEN
      data:=E.AllocVec(size,LONGSET{E.public,E.memClear});
      IF data#NIL THEN
        CrM.InitCrunchStruct(cs,data,data,size,size);
        u.InitHook(SYSTEM.ADR(hook),ShowCBytes);
        cs^.DisplayHook:=SYSTEM.ADR(hook);
        cs^.DisplayStep:=512;
        cs^.DataHdr:=SYSTEM.ADR(dh);        (* <- Don't Forget! *)
        cnt:=D.Read(file,data^,size);       (* Read Data *)
        D.OldClose(file); file:=NIL;
        IF cnt=size THEN
          nlen:=CrM.CrunchData(cs);
          IF (nlen#0) AND (nlen+14<size) THEN
            D.PrintF("\nNewLen: %8.ld\n",nlen+SIZE(dh));
            file:=D.Open(name,D.newFile);
            IF file#NIL THEN
              cnt:=D.Write(file,dh,SIZE(dh)); (* Write Dataheader *)
              cnt:=D.Write(file,data^,nlen);  (* Write Data *)
              D.OldClose(file); file:=NIL;
            END;
          ELSE
            D.PrintF("Crunch error!\n");
          END;
        END;
        E.FreeVec(data);
      END;
      CrM.FreeCrunchStruct(cs);
    END;
    IF file#NIL THEN D.OldClose(file) END;
  END;
END CrunchFile;

PROCEDURE DecrunchFile(name : ARRAY OF CHAR;size : LONGINT);
VAR
  file  : D.FileHandlePtr;
  dh    : CrM.DataHeader;
  cnt   : LONGINT;
  mode  : SET;
  c     : CHAR;
  data,
  ndata : UNTRACED POINTER TO SYSTEM.BYTE;

BEGIN
  D.PrintF("Decrunch?(Y/N)\n");
  REPEAT
    c:=D.ReadChar();
  UNTIL (CAP(c)="Y") OR (CAP(c)="N");
  IF CAP(c)="N" THEN RETURN END;
  file:=D.Open(name,D.oldFile);
  IF file#NIL THEN
    cnt:=D.Read(file,dh,SIZE(dh));
    mode:=CrM.CheckCrunched(dh);
    IF {CrM.Normal,CrM.LZH}*mode#{} THEN (* file crunched ? *)
      data:=E.AllocVec(dh.OriginalLen+dh.MinSecDist,LONGSET{E.public,E.memClear});
      IF data#NIL THEN
        cnt:=D.Read(file,data^,size-SIZE(dh));
        IF cnt=size-SIZE(dh) THEN
          ndata:=CrM.Decrunch(data,data,dh);
          IF ndata#NIL THEN
            D.OldClose(file);
            file:=D.Open(name,D.newFile);
            IF file#NIL THEN
              cnt:=D.Write(file,ndata^,dh.OriginalLen);
              D.OldClose(file);
              file:=NIL
            END;
          END;
        END;
      END;
      E.FreeVec(data);
    END;
    IF file#NIL THEN D.OldClose(file) END;
  END;
END DecrunchFile;

PROCEDURE FStat(name : ARRAY OF CHAR;size : LONGINT);
VAR file  : D.FileHandlePtr;
    dh    : CrM.DataHeader;
    flags : SET;
BEGIN
  file:=D.Open(name,D.oldFile);
  IF file=NIL THEN RETURN END;
  IF SIZE(dh)=D.Read(file,dh,SIZE(dh)) THEN END;
  D.OldClose(file);
  flags:=CrM.CheckCrunched(dh);
  IF {CrM.Normal,CrM.LZH}*flags#{} THEN      (* Schnittmenge *)
    INC(fcanz);
    INC(crlen,dh.CrunchedLen);
    INC(len,dh.OriginalLen);
    IF attrib THEN
      D.PrintF("%32.32s %8.ld -> %8.ld",SYSTEM.ADR(name),dh.OriginalLen,dh.CrunchedLen);
      IF CrM.LZH IN flags THEN
        D.PrintF(" LZH");
      ELSE
        D.PrintF(" NORM");
      END;
      IF CrM.Sample IN flags THEN
        D.PrintF("SAMPLE");
      END;
      D.PrintF("\n");
    END;
    IF intadcr THEN DecrunchFile(name,size) END;
  ELSIF Attrib THEN
     D.PrintF("%32.32s %8.ld not crunched!\n",SYSTEM.ADR(name),size);
     IF intacr THEN CrunchFile(name,size) END;
  END;
END FStat;

PROCEDURE DStat(dir : D.FileLockPtr;VAR pat : ARRAY OF CHAR;VAR rek : BOOLEAN);
VAR
  apath : D.AnchorPathPtr;
  odir,ndir  : D.FileLockPtr;
  erg   : LONGINT;
BEGIN
  apath:=E.AllocVec(SIZE(apath^),LONGSET{E.public,E.memClear});
  IF (dir=NIL) OR (apath=NIL) THEN RETURN END;
  odir:=D.CurrentDir(dir);
  apath.strLen:=SIZE(apath.buf);
  erg:=D.MatchFirst(pat,apath^);
  WHILE erg=0 DO
    IF apath.info.dirEntryType>0 THEN
      IF rek THEN
        INC(danz);
        ndir:=D.Lock(apath.buf,D.sharedLock);
        IF attrib OR Attrib THEN
          D.PrintF("%s :\n",SYSTEM.ADR(apath.buf));
        END;
        DStat(ndir,pat,rek);
        IF attrib OR Attrib THEN
          D.PrintF("- - - - - - - - - - - - - - - - -\n");
        END;
        D.UnLock(ndir);
      END;
    ELSE
      INC(fanz);
      FStat(apath.buf,apath.info.size);
    END;
    erg:=D.MatchNext(apath^);
    IF ~attrib & ~Attrib THEN
      D.PrintF("%ld files %ld dirs scanned\r",fanz,danz);
    END;
  END;
  dir:=D.CurrentDir(odir);
  D.MatchEnd(apath^);
  E.FreeVec(apath);
END DStat;

BEGIN
  REPEAT pattern[0]:=D.ReadChar() UNTIL pattern[0]=CHR(10);(* clear buffer *)
  D.PrintF("$VER:CrMStatV1.03\r\o");
  D.PrintF("\[33;1mCrMStat V1.03 \[0m---\[22;32m (c) 1993 Alexander Ehlert \[0m\n");
  IF A.NumArgs()>0 THEN
    A.GetArg(1,string);
    IF CheckCommands(string) AND (A.NumArgs()>1) THEN
      A.GetArg(2,string);
    ELSE
      string:="#?";
    END;
    fidi:=D.Lock(string,D.sharedLock);
    IF (fidi#NIL) AND D.Examine(fidi,info) THEN
      IF info.dirEntryType>0 THEN
        pattern:="#?";
        DStat(fidi,pattern,rekursiv);
      ELSIF info.dirEntryType<0 THEN
        D.UnLock(fidi);
        fidi:=NIL;
        FStat(string,info.size);
      END;
    ELSE
      GetStrings(string,dir,pattern);
      fidi:=D.Lock(dir,D.sharedLock);
      IF (fidi#NIL) AND D.Examine(fidi,info) THEN
        IF info.dirEntryType>0 THEN
          DStat(fidi,pattern,rekursiv)
        END;
      END;
    END;
    D.PrintF("%ld files %ld dirs scanned\n",fanz,danz);
    D.PrintF("%ld crunched files found\n",fcanz);
    D.PrintF("Original Length: %ld\n",len);
    D.PrintF("Crunched Length: %ld\n",crlen);
  ELSE
    string:="?";
    IF CheckCommands(string) THEN END;
  END;
CLOSE
  IF fidi#NIL THEN D.UnLock(fidi) END;
END CrMStat.
[ RETURN TO DIRECTORY ]