Turbo Toolbox/Turbo_Toolbox.iso/1989/02/anwendg/garbage.pas

Pascal/Delphi Source File | 1988-09-21 | 5.9 KB | 189 lines

(* ------------------------------------------------------ *)
(*                  GARBAGE.PAS                           *)
(*                                                        *)
(*  Dieses Programm demonstriert den Komprimierungs-      *)
(*  Mechanismus für die dBase III+ Memo-Feld Organisation *)
(*                                                        *)
(*       (c) 1988 by Dr.Lothar Wenzel und TOOLBOX         *)
(* ------------------------------------------------------ *)

PROGRAM garbage_collection;

USES Crt;

CONST
  ende = 8192;               (* Größe des Puffers für den *)
                             (* Datenbankvorspann         *)
  leer : BYTE = $20;
  beginn_stufe = 1000000000; (* für Decodierung der       *)
                             (* 10-stelligen Memoadresse  *)
  pos1 = 0;
  pos2 = 9;

TYPE
  dateien = FILE OF BYTE;
  INTEGER = longint;

VAR
  laenge_vorher  : INTEGER;  (* Länge der Quell-DBT-Datei *)
  laenge_nachher : INTEGER;  (* Länge der Ziel-TTT-Datei  *)
  aktuell        : INTEGER;
  anzahl_memo    : INTEGER;  (* Memo-Felder/Datensatz     *)
  memo_pos       : ARRAY[1..128] OF INTEGER;

  laenge_satz    : INTEGER;  (* Länge eines dBase-Satzes  *)
  anzahl_saetze  : INTEGER;  (* Anzahl der Datensätze     *)
  beginn_daten   : INTEGER;
  position       : INTEGER;
  puffer         : ARRAY[1..ende] OF BYTE;
  sektor         : ARRAY[1..512] OF BYTE;
  vorher,nachher : dateien;
  datenbank      : dateien;
  index1,index2  : INTEGER;
  name           : STRING[8];


(* -----  Konvertierung byte --> integer ---------------- *)
FUNCTION Wert(argument: BYTE): INTEGER;
BEGIN
  IF argument < $30 THEN Wert := 0
  ELSE Wert := Ord(argument-$30);
END;

(* -----  Auswertung der möglichen Fehler --------------- *)
PROCEDURE Fehler(nummer: INTEGER);
BEGIN
  CASE nummer OF
    1 : WriteLn('Datenbank ',name,' ist nicht vorhanden !');
    2 : WriteLn('Keine ',name+'.DBT-Datei vorhanden!');
    3 : WriteLn('Keine Memo-Felder vorhanden!');
  END;
  Halt;
END;

(*-----   Aufbau der .TTT-Datei aus der DBT.Datei ------- *)
PROCEDURE austausch;
VAR
  index, index3, nummer  : INTEGER;
  stufe, beginn, ort     : INTEGER;
  eintrag, zaehler       : INTEGER;
  merk, merk1, ausgabe   : BYTE;

BEGIN
  beginn := aktuell;
  FOR index := 1 TO anzahl_saetze DO BEGIN
    Seek(datenbank, beginn_daten + laenge_satz*(index-1));
    FOR index1:=1 TO laenge_satz DO
      Read(datenbank, puffer[index1]);
    FOR index2:=1 TO anzahl_memo DO BEGIN
      GotoXY(5,15);
      Write('Satz= ',index:6,' Memo= ',index2:3);
      nummer := 0;
      stufe := beginn_stufe;
      FOR index3:=pos1 TO pos2 DO
        nummer:=10*nummer+
                      wert(puffer[index3+memo_pos[index2]]);
      IF nummer >0 THEN BEGIN
        eintrag := $20;
        FOR index3:=pos1 TO pos2 DO BEGIN
          ort := -1+beginn_daten+(index-1)*laenge_satz+
                                    index3+memo_pos[index2];
          Seek(datenbank,ort);
          IF beginn >= stufe THEN eintrag := $30;
          ausgabe := eintrag + (beginn DIV stufe) * $01;
          Write(datenbank,ausgabe);
          beginn := aktuell MOD stufe;
          stufe  := stufe DIV 10;
        END;
        zaehler := 0;
        Write(nachher,leer);
        IF (laenge_vorher>512*nummer) THEN BEGIN
          Seek(vorher,512*nummer+zaehler);
          Read(vorher,merk);
          Seek(nachher,512*aktuell+zaehler);
          Write(nachher,merk);
          REPEAT
            zaehler := Succ(zaehler);
            merk1   := merk;
            Read(vorher, merk); Write(nachher, merk);
          UNTIL (merk=$1a) AND (merk1=$1a);
          WHILE (FileSize(nachher) MOD 512 <> 0) DO
            Write(nachher,leer);
          aktuell := 1 + (zaehler DIV 512);
        END;
      END;
    END;
  END;
  FOR index := 0 TO 3 DO BEGIN
    Seek(nachher, index);
    ausgabe := aktuell MOD 256;
    Write(nachher, ausgabe);
    aktuell:=aktuell DIV 256;
  END;
END;

(* ----- Anzahl der Datensätze und Memo-Felder ermitteln  *)
PROCEDURE demontage;
VAR
  index, vorspann: INTEGER;

BEGIN
  IF FileSize(datenbank) > ende THEN vorspann := ende
  ELSE vorspann := FileSize(datenbank);
  FOR index := 1 TO vorspann DO
    Read(datenbank, puffer[index]);
  anzahl_saetze := puffer[6]*256 + puffer[5];
  WriteLn('Anzahl der Datensätze = ',anzahl_saetze);
  laenge_satz := puffer[12]*256 + puffer[11];
  anzahl_memo := 0;
  index       := 33;
  position    := 1;
  beginn_daten:= 34;
  REPEAT
    beginn_daten := beginn_daten + 32;
    IF puffer[index+11]=$4d THEN BEGIN
      anzahl_memo := Succ(anzahl_memo);
      memo_pos[anzahl_memo] := position;
    END;
    position := position + puffer[index+16];
    index := index + 32;
  UNTIL puffer[index] = $0d;
  WriteLn('Anzahl der Memo-Felder= ',anzahl_memo);
  IF anzahl_memo = 0 THEN Fehler(3);
END;

(* -----  Hauptprogramm --------------------------------- *)

BEGIN
  ClrScr;
  Write('Geben Sie den Dateinamen an (ohne .DBF) --->');
  ReadLn(name);
  Assign(datenbank, name + '.DBF');
  Assign(vorher, name + '.DBT');
  Assign(nachher, name + '.TTT');
  {$I-}
  ReSet(datenbank);
  IF IOResult <> 0 THEN Fehler(1);
  ReSet(vorher);
  laenge_vorher := FileSize(vorher);
  IF IOResult <> 0 THEN Fehler(2);
  ReWrite(nachher);
  aktuell := 1;
  FOR index1 := 1 TO 512 DO Write(nachher,leer);
  Demontage;
  Austausch;
  laenge_nachher := FileSize(nachher);
  Close(nachher);
  Close(vorher);
  Close(datenbank);
  WriteLn;
  WriteLn('Erfolgreich durchgeführte Garbage Collection!');
  WriteLn;
  WriteLn('Löschen Sie die Datei ',name+'.DBT !');
  WriteLn;
  WriteLn('Länge vor  Garbage Collection= ', laenge_vorher);
  WriteLn('Länge nach Garbage Collection= ',laenge_nachher);
END.

(* ------------------------------------------------------ *)
(*                Ende von GARBAGE.PAS                    *)