PROGRAM Check;

(**********************************)
(*     Version 0.01   25.12.94    *)
(*     Version 0.02   18.01.95    *)
(*     Version 0.03   21.02.95    *)
(*     Version 0.04   04.04.95    *)
(*     Version 0.05   11.09.97    *)
(*        (c) Stefan Diener       *)
(* written with Maxon-Pascal 3.00 *)
(*     by MAXON Computer GmbH     *)
(**********************************)

(****************************************************)
(*                                                  *)
(*                    compiled at                   *)
(*                                                  *)
(* Modell     : Amiga 1200                          *)
(* Kickstart  : 39.106 (Kick 3.0)                   *)
(*                                                  *)
(* CPU        : 68030, 50 MHz (incl. MMU)           *)
(* FPU        : 68882, 50 MHz                       *)
(* Turboboard : Blizzard 1230 Mk II                 *)
(*                                                  *)
(* Chip RAM   :  2 MByte                            *)
(* Fast RAM   : 20 MByte                            *)
(*                                                  *)
(* Hardisk  1 : 840 MByte IDE - Western Digital     *)
(* Controller : internal (IDE)                      *)
(*                                                  *)
(* Harddisk 2 : 540 MByte SCSI - Quantum            *)
(* Controller : Blizzard 1230 SCSI-Kit              *)
(*                                                  *)
(* Harddisk 3 : 540 MByte SCSI - IBM                *)
(* Controller : Blizzard 1230 SCSI-Kit              *)
(*                                                  *)
(* CD-ROM     : Quadro Speed, SCSI - Sanyo          *)
(* Controller : Blizzard 1230 SCSI-Kit              *)
(*                                                  *)
(* Diskdrives : internal (DD)                       *)
(*              external (HD)                       *)
(*                                                  *)
(****************************************************)

(**************************************************)
(* Das Programm ermöglicht folgende Operationen : *)
(* a) einzelne Dateien auf Fehler testen          *)
(* b) für Verzeichnisse                           *)
(*    1. Gesamtgröße feststellen                  *)
(*    2. ev. jede Datei auf Fehler testen         *)
(*    3. ev. rekursive Wiederholung für           *)
(*       alle Unterverzeichnisse                  *)
(**************************************************)

{$incl "dos.lib"}

CONST Empty = '                                                                                ';
      Dummy = '$VER: Check 0.05 (11.09.97) Stefan Diener';
      PufferSize = 2000;

TYPE MyString = ARRAY [1..200] OF Char;

VAR Leer                   : Integer;
    Summe, Temp            : LongInt;
    Zaehl1, Zaehl2, Zaehl3 : LongInt;
    LW                     : MyString;
    Check, Modus, Quick    : Boolean;
    MeinPuffer             : ARRAY [0..PufferSize] OF Byte;

PROCEDURE  Hilfe;
(* Die Help-Seite ... *)
BEGIN
  WriteLn;
  WriteLn('Check Version 0.05');
  WriteLn('A simple file and directory scanner.');
  WriteLn('(c) by Stefan Diener 1995/97');
  WriteLn;
  WriteLn('Check [-v] [-n] [-q] path|file');
  WriteLn('  -v   : verify = file test');
  WriteLn('  -n   : enter no subdirs');
  WriteLn('  -q   : quick = minimal output');
  WriteLn('  path : path to check');
  Write('  file : single file to check');
  Error('');
END;

FUNCTION ReallyAFile(Wo:MyString):Boolean;
(* Testet, ob es sich um eine echte Datei handelt. *)
VAR Datei : File OF Byte;
BEGIN
  Reset(Datei,Wo);
  IF IOResult=0 THEN BEGIN
    Close(Datei);
    ReallyAFile:=True;
  END ELSE ReallyAFile:=False;
END;

FUNCTION Punktiert(Zahl:Long):String;
(* Ausgabe der Zahl im punktierten Dezimalformat *)
VAR Kette1, Kette2 : String;
    Laenge, Posi, count : Byte;
BEGIN
  Kette1:=IntStr(Zahl);
  IF Zahl<1000 THEN Punktiert:=Kette1
  ELSE BEGIN
    Kette2:='';
    Posi:=1;
    Laenge:=Length(Kette1);
    FOR count:=1 TO Laenge DO BEGIN
      Kette2[Posi]:=Kette1[count];
      IF (count<>Laenge) AND (Frac((Laenge-count)/3)=0) THEN BEGIN
        Inc(Posi);
        Kette2[Posi]:='.';
      END;
      Inc(Posi);
    END;
    Kette2[Posi]:=chr(0);
    Punktiert:=Kette2;
  END;
END;

FUNCTION CheckIt(Name:MyString):Long;
(* Verify wird auf eine Datei angewendet. *)
(* Rückgabewert : gelesene Bytes *)
VAR Datei : File OF Byte;
    anzahl, laenge, position : LongInt;
BEGIN
  (* Datei oeffnen *)
  Reset(Datei,Name);

  IF IOResult<>0 THEN BEGIN   (* Datei laesst sich nicht oeffnen *)
    Zaehl3:=Zaehl3+1;
    IF NOT(Quick) THEN Write('  ERROR No.1');
    CheckIt:=0;
  END ELSE BEGIN   (* Datei ist offen *)

    (* DOS-Puffer auf 50 KByte setzen *)
    Buffer(Datei,51200);

    (* Dateilaenge lesen *)
    laenge:=Filesize(Datei);

    (* Datei lesen *)
    position:=0;
    While (NOT(EOF(Datei))) AND (IOResult=0) DO BEGIN
      anzahl:=laenge-position;
      IF (anzahl>PufferSize) THEN anzahl:=PufferSize;
      BlockRead(Datei,MeinPuffer,anzahl);
      position:=position+anzahl;
    END;

    (* Fehler beim Lesen aufgetreten ? *)
    IF IOResult<>0 THEN BEGIN
      Zaehl3:=Zaehl3+1;
      IF NOT(Quick) THEN Write('  ERROR No.2');
    END;

    (* Rueckgabewert und Ende *)
    CheckIt:=position;
    Close(Datei);
  END;
END;

PROCEDURE NextDir(Name:MyString);
(* Die Routine zum Directory-Scannen, rekursiv. *)
VAR MyLock : BPTR;
    FIB    : p_FileInfoBlock;
BEGIN
  MyLock:=Lock(Name,Shared_Lock);
  IF MyLock=0 THEN BEGIN
    IF NOT(Quick) THEN WriteLn('   No LOCK ! (File or path not found !!!)');
    Zaehl3:=succ(Zaehl3);
    Exit;
  END;
  New(FIB);
  IF Examine(MyLock,FIB)=0 THEN BEGIN
    IF NOT(Quick) THEN WriteLn('   No EXAMINE ! (DOS error !!!)');
    UnLock(MyLock);
    Zaehl3:=succ(Zaehl3);
    UnLock(MyLock);
    Exit;
  END;
  IF pos(':',Name)<>length(Name) THEN Name:=Name+'/';
  Leer:=Leer+2;
  While ExNext(MyLock,FIB)<>0 DO
    IF FIB^.fib_DirEntryType>=0 THEN BEGIN
      IF not(Modus) THEN BEGIN
        Zaehl2:=succ(Zaehl2);
        IF NOT(Quick) THEN WriteLn(Copy(Empty,1,Leer),'<DIR> ',FIB^.fib_FileName);
        NextDir(Name+FIB^.fib_FileName);
      END;
    END ELSE BEGIN
      IF NOT(Quick) THEN Write(Copy(Empty,1,Leer),FIB^.fib_FileName);
      Zaehl1:=succ(Zaehl1);
      IF Check THEN Temp:=CheckIt(Name+FIB^.fib_FileName)
        ELSE Temp:=FIB^.fib_size;
      Summe:=Summe+Temp;
      IF NOT(Quick) THEN WriteLn('  (',Temp,')');
    END;
  UnLock(MyLock);
  Dispose(FIB);
  Leer:=Leer-2;
END;

PROCEDURE ReadCommands;
(* Kommandozeile auswerten. *)
VAR Text : MyString;
BEGIN
  IF ParameterLen<2 THEN Hilfe;
  Text:=Copy(ParameterStr,1,ParameterLen-1);
  IF Text='' THEN Hilfe;
  While (ord(Text[length(Text)])<33) DO Delete(Text,length(Text),1);
  IF Text='' THEN Hilfe;
  While (ord(Text[1])<33) DO Delete(Text,1,1);
  IF (Text='?') OR (Text='') THEN Hilfe;
  Modus:=False;
  Check:=False;
  Quick:=False;
  While Text[1]='-' DO BEGIN
    Delete(Text,1,1);
    IF Text='' THEN Hilfe;
    CASE UpCase(Text[1]) OF
      'V' : Check:=True;
      'N' : Modus:=True;
      'Q' : Quick:=True;
      Otherwise BEGIN
        WriteLn;
        WriteLn('Parsing error : Unknown option !');
        Hilfe;
      END;
    END;
    Delete(Text,1,1);
    IF Text='' THEN Hilfe;
    While (ord(Text[1])<33) DO Delete(Text,1,1);
    IF Text='' THEN Hilfe;
  END;
  LW:=Text;
END;

(* MAIN-Part *)
BEGIN                               (* Hier geht's los. *)
  IF FromWB THEN Exit;              (* CLI-ONLY, sorry ! *)
  ReadCommands;                     (* Kommandos auswerten *)
  IF NOT(Quick) THEN WriteLn;       (* noch ein bischen Initialisierung *)
  Leer:=-2;
  Zaehl1:=0;
  Zaehl2:=0;
  Zaehl3:=0;
  Summe:=0;
  IF ReallyAFile(LW) THEN BEGIN     (* wenn's eine Datei ist ... *)
    Write(LW);
    IF Check THEN Summe:=CheckIt(LW);    (* eventuell Verify ausführen *)
    WriteLn;
    WriteLn;
    Write('1 file ');               (* Auswertung *)
    IF Check THEN WriteLn('checked.')
      ELSE WriteLn('found (but not checked) !');
    IF Zaehl3=0 THEN WriteLn('No errors detected.')
      ELSE WriteLn(Zaehl3,' errors found !');
  END ELSE BEGIN                    (* wenn's keine Datei war ... *)
    NextDir(LW);                    (* Verzeichnis lesen, ev. rekursiv *)
    WriteLn;                        (* Auswertung *)
    Write(Punktiert(Zaehl1),' files and ',Punktiert(Zaehl2), ' directories');
    IF Check THEN Write(' checked');
    WriteLn('.');
    IF Zaehl3=0 THEN WriteLn('No errors detected.')
      ELSE WriteLn(Zaehl3,' errors found !');
  END;
  WriteLn('Bytes passed : ',Punktiert(Summe));      (* gefundene Bytes *)
  WriteLn;
  DisposeAll;                       (* Speicher freigeben *)
END.                                (* Und tschüß ! *)