[<<Previous Entry] [^^Up^^] [Next Entry>>] [Menu] [About The Guide]
DB12.PAS

 { ---------------------------------------------------------------- }
 {             TDB DEMOPROGRAMM 12 - DATENBANK PACKEN               }
 { ---------------------------------------------------------------- }
 { Erzeugt eine neue Datenbank ("DB12.DBF"), "f.llt" sie mit        }
 { 100 Testdatens.tzen und gibt diese aus.                          }
 { Anschlie.end werden einige Datens.tze gel.scht, die Datenbank    }
 { gepackt und der (neue) Inhalt noch einmal ausgegeben.            }
 { ---------------------------------------------------------------- }
 {       (c)  1992  by  Aurora  featuring  M.J. Schwaiger           }
 { ---------------------------------------------------------------- }
 {      History:                                                    }
 { 1992-04-15   MS   Interfacefestlegung und Implementierung.       }
 { ---------------------------------------------------------------- }

 PROGRAM DbDemo12;

 {$UNDEF Windows}

   USES
     DbTypes,                 { Enth.lt die Typdefinitionen f.r alle }
                             { Module des Datenbanksystems TDB.     }
     ADatum,                  { Definition TDate (unter anderem ...) }
     AStrTool,                                  { Stringformatierung }
     TDB,                     { Die eigentlichen Datenbank-Objekte.  }
     ATestGen,                                  { Testdatengenerator }
     LongIdle,                { Idle-Prozeduren f.r l.ngere Vorg.nge }
     Error;                  { Fehlerbehandlungsroutinen, -handler  }


   VAR
     CI             : TCreateInfo;
     DB             : PDataBase;                  { Datenbankobjekt }
     Index          : PIndex;                         { Indexobjekt }
     Datum          : TDate;
     Cnt            : BYTE;
     Typ            : CHAR;                               { Feldtyp }
     Size,                                               { Feldgr..e }
     NK             : BYTE;          { Bei Zahlen: Nachkommastellen }


   BEGIN                                            { Hauptprogramm }
 {$IFNDEF Windows}
     SetErrHandler (ErrPrint);         { Alle Fehler werden auf dem }
                                       { Drucker mitprotokolliert.  }
     SetLongIdleHandler (LIdleScreenInit,    { "Fortschrittsanzeige" }
                                 LIdleScreenUpDate,  LIdleScreenDone);
 {$ENDIF}
     WRITELN (MEMAVAIL);

     WRITELN;
  (*
     FILLCHAR (CI.Felder, SIZEOF (CI.Felder), 0);    { Vorsicht ist }
                                    { die Mutter der Porzellankiste }

     CI.Felder [1].Name := 'NAME';           { Felddefinitionen f.r }
     CI.Felder [1].Typ := 'C';                 { die neue Datenbank }
     CI.Felder [1].Size := 50;
     CI.Felder [1].NK := 0;

     CI.Felder [2].Name := 'VORNAME';
     CI.Felder [2].Typ := 'C';
     CI.Felder [2].Size := 50;
     CI.Felder [2].NK := 0;

     CI.Felder [3].Name := 'STRASSE';
     CI.Felder [3].Typ := 'C';
     CI.Felder [3].Size := 100;
     CI.Felder [3].NK := 0;

     CI.Felder [4].Name := 'PLZ';
     CI.Felder [4].Typ := 'N';
     CI.Felder [4].Size := 12;
     CI.Felder [4].NK := 0;

     CI.Felder [5].Name := 'GEBOREN';
     CI.Felder [5].Typ := 'D';
     CI.Felder [5].Size := 8;
     CI.Felder [5].NK := 0;

     CI.Felder [6].Name := 'GEHALT';
     CI.Felder [6].Typ := 'N';
     CI.Felder [6].Size := 16;
     CI.Felder [6].NK := 2;

     CI.AnzFelder := 6;                        { Exakt 6 Felder ... }

     WRITELN;
     WRITELN;

                             { Datenbank erzeugen, 100 Datens.tze   }
                            { anh.ngen, Datenbank wieder schlie.en. }
     WRITELN (GenerateCreate ('DB12', CI, 1000));
 *)
     DB := NEW (PDataBase,  Use ('DB12'));

     IF GetErr = 0 THEN
     BEGIN
       Index := NEW (PIndex,  Use ('DB12Name',  'NAME',  DB));
       DB^.IndexOn ('NAME',  Index);

       WRITELN (MEMAVAIL);
  (*
       DB^.First;

       Cnt := 0;

       WHILE (GetErr = 0) AND NOT (DB^.EOF) DO
       BEGIN
         INC (Cnt);

         WRITELN (Cnt : 3, '-', DB^.RecNo : 3, ': ',
                       DB^.Read ('NAME'), ' ', DB^.ReadR ('GEHALT'));

         DB^.Skip (1);
       END; { WHILE NOT (DB^.EOF) DO }

       WRITELN;
       WRITELN ('Das waren ', Cnt, ' Datens.tze !');
       WRITELN;

       DB^.Go (10);
       DB^.Delete;
       DB^.Go (20);
       DB^.Delete;
       DB^.Go (30);
       DB^.Delete;
       DB^.Go (40);
       DB^.Delete;
       DB^.Go (50);
       DB^.Delete;
       DB^.Go (60);
       DB^.Delete;
       DB^.Go (70);
       DB^.Delete;
       DB^.Go (80);
       DB^.Delete;
       DB^.Go (90);
       DB^.Delete;
       DB^.Go (100);
       DB^.Delete;
 *)
       IF NOT (DB^.Pack) THEN
         WRITELN ('Probleme beim Packen !')
       ELSE
       BEGIN
         DB^.First;

         Cnt := 0;

         WHILE (GetErr = 0) AND NOT (DB^.EOF) DO
         BEGIN
           INC (Cnt);

           WRITELN (Cnt : 3,  '-',  DB^.RecNo : 3,  ': ',
                         DB^.READ ('NAME'),  ' ',  DB^.ReadR ('GEHALT'));

           DB^.Skip (1);
         END; { WHILE NOT (DB^.EOF) DO }

         WRITELN;
         WRITELN ('Das waren ',  Cnt,  ' Datens.tze !');
         WRITELN;
       END; { IF NOT (DB^.Pack) THEN ... ELSE }

       DISPOSE (DB,  CLOSE); { Index wird automatisch mit gel.scht ! }
     END; { IF GetErr = 0 THEN }

     WRITELN (MEMAVAIL);

     WRITELN;
     WRITE ('Weiter mit Taste ...');
     READLN;
     WRITELN;
   END. { PROGRAM DbDemo12 }

This page created by ng2html v1.05, the Norton guide to HTML conversion utility. Written by Dave Pearson