Turbo Toolbox/Turbo_Toolbox.iso/1989/06/anwendg/dbdoc1.pas

Pascal/Delphi Source File | 1989-01-24 | 16.2 KB | 423 lines

(* ------------------------------------------------------ *)
(*                      DBDOC.PAS                         *)
(* Demonstration des Zugriffs auf dBase III-Daten-        *)
(* bankfiles aus Turbo Pascal. Das Programm gibt den      *)
(* Inhalt einer dBase III-Datei auf dem Bildschirm aus.   *)
(* Dabei wird insbesondere der Umgang mit den einzelnen   *)
(* Unterprogrammen gezeigt.                               *)
(*            (c) 1989  G.Born  & TOOLBOX                 *)
(* ------------------------------------------------------ *)
PROGRAM dbdoc;

(* definiere die Datentypen und die globalen Variablen    *)
(* für den Zugriff auf die .DBF Datei                     *)

USES Crt, Dos;

CONST
  PathLength  = 65;
  Word_len    = 2;                    (* Länge Word       *)
  Byte_len    = 1;                    (* Länge Byte       *)

TYPE
  header = RECORD             (* Header einer dBase Datei *)
             version   : BYTE;
                              (* Version 03H oder 83H     *)
             datum     : ARRAY [1..3] OF BYTE;
                              (* Datum JJ MM TT           *)
             records   : LONGINT;
                              (* Records in Datenbank     *)
             headerb   : word;
                              (* Zahl der Bytes im Kopf   *)
             recordb   : word;
                              (* Zahl der Bytes pro Record*)
             reserve   : ARRAY [1..20] OF BYTE;
                              (* reservierte Bytes        *)
           END;

TYPE
  feld = RECORD               (* Feldbeschreibung im Kopf *)
           fname       : ARRAY [1..11] OF BYTE;
                              (* Feldname 11 Zeichen      *)
           ftyp        : BYTE;
                              (* C N L D M                *)
           dummy1      : ARRAY [1..4] OF BYTE;
                              (* Dummy Feld               *)
           laenge      : BYTE;
                              (* Zahl der Stellen         *)
           komma       : BYTE;
                              (* Zahl der Nachkommastellen*)
           dummy2      : ARRAY [1..2] OF BYTE;
                              (* reservierte Bytes        *)
           id          : BYTE;
                              (* ID Byte                  *)
           dummy3      : ARRAY [1..11] OF BYTE;
                              (* reserviert               *)
         END;

TYPE
  Name   = STRING[PathLength];   (* Typ Filename          *)
  dbtyp  = FILE;                 (* Datenbankfile untyped *)
  dbsatz = ARRAY [1..1024] OF BYTE;  (* Typ für Datensatz *)

VAR
  kopf     : header;           (* Variable f. Dateiheader *)
  felder   : ARRAY [0..128] OF feld;        (* 128 Felder *)
  anzahl   : LONGINT;                  (* Zahl der Felder *)
  FileName : Name;                     (* Dateiname       *)
  DbFile   : dbtyp;                    (* File            *)

  Buffer   : dbsatz;
  recnr    : LONGINT;                 (* Satznummer Dbase *)
  jahr, monat, tag, wtag : word;      (* Datum            *)
  i,j   : INTEGER;                    (* Index            *)
  tmp   : CHAR;                       (* Hilfsvariable    *)

(* ------------------------------------------------------ *)
(*                    Hilfsroutinen                       *)

PROCEDURE Write_hex (value, len : INTEGER);
  {  Ausgabe eines Wertes als Hexzahl auf der Standard-    }
  {  ausgabe. Durch Len wird festgelegt, ob ein            }
  {  Byte (Len = 1) oder Wort (Len = 2) ausgegeben         }
  {  werden soll.                                          }

CONST Hexzif : ARRAY [0..15] OF CHAR = '0123456789ABCDEF';
VAR temp : INTEGER;

BEGIN
  IF len = Word_len THEN BEGIN       (* 2 Bytes ?         *)
    temp := Swap (value) AND $0FF;   (* high byte holen   *)
    Write(Hexzif[temp DIV 16]:1, Hexzif[temp MOD 16]:1);
  END;
  temp := value AND $0FF;            (* low byte holen    *)
  Write(Hexzif[temp DIV 16]:1, Hexzif[temp MOD 16]:1);
END;  { Write_hex }

FUNCTION Open(VAR fp: dbtyp; fname: Name): BOOLEAN;
  {  Öffne eine Datei und gebe Ergebnis als boolean zurück }

BEGIN
  Assign(fp,fname);                  (* setze Filename    *)
{$I-}                                (* Errorcheck off    *)
  Reset(fp);                         (* open file         *)
{$I+}                                (* Errorcheck on     *)
  IF IOResult = 0 THEN
    Open := TRUE
  ELSE
    Open := FALSE;
END;  { Open }

PROCEDURE GetHeader (VAR handle : dbtyp);
  { Die Routine liest den Dateiheader ein und prüft, ob es }
  { sich um eine gültige DBASE III Datei handelt. Im Fehler}
  { fall terminiert das Programm mit einer Meldung.        }

BEGIN
  BlockRead(handle, kopf, 1);      (* lese Kopf der Datei *)
  IF Eof(handle) THEN BEGIN        (* dBase Datei ?       *)
    WriteLn('Keine dBase III-Datei, da (EOF) erreicht');
    Halt;
  END;
  WITH kopf DO BEGIN
    IF (version <> $83) AND (version <> $03) THEN BEGIN
                                   (* kein dBase Header ? *)
      WriteLn('Keine dBase III-Datei, da Header ',
              '(Code) falsch');
      Write('Code : ');
      Write_hex(kopf.version, Byte_len); (* setze Code ab *)
      Halt;
    END ELSE
      IF version = $02 THEN BEGIN  (* dBase II Header     *)
        WriteLn ('dBase II Header');
        Halt;
       END;
  END;
END;  { GetHeader }

PROCEDURE GetFieldDef (VAR handle : dbtyp);
  {  lese und decodiere die Feldbescheibung der dBase III- }
  {  Datei, es sind maximal 128 Felder zulässig            }

VAR i, j    : INTEGER;
    headend : BYTE;

BEGIN
  anzahl := ((kopf.headerb - 1) DIV 32) - 1;
                   (* Zahl der Felder                     *)
                   (* Reset Datei um mit neuer Puffersize *)
  Reset (handle,32);          (* zugreifen zu können      *)
  Seek (handle, 1);           (* setze Zeiger auf 2. Feld *)
  FOR i := 1 TO anzahl DO BEGIN
                              (* lese n Felddefinitionen  *)
    BlockRead (handle, felder[i], 1);
    IF Eof(handle) THEN BEGIN        (* Fehler abfangen?  *)
      WriteLn('Fehler: Ende Feldbeschreibung erreicht');
      Halt;
     END;
  END;

  { prüfe ob nächstes Byte das Header Ende signalisiert    }

  Reset(handle, 1);             (* als File mit Bytes op  *}
  seek(handle, kopf.headerb-1); (* auf Endezchn i. Kopf   *)
  BlockRead(handle, headend,1); (* lese Endezeichen       *)
  IF headend <> $0D THEN BEGIN  (* Ende = 0DH             *)
    WriteLn('Fehler: Header Ende nicht gefunden');
    Halt;
  END;
  recnr := kopf.headerb;        (* merke Feldanfang       *)
  Reset(handle, 1);             (* Datei als Bytes öffnen *)
END; { GetFieldDef }

PROCEDURE GetRecord (VAR handle: FILE; VAR satz : dbsatz);
  {  lese einen Satz aus der DBASE III - Datenbank und     }
  {  gebe das Ergebnis in satz zurück. Die Daten sind      }
  {  als ASCII - Text in der Datenbank abgelegt.           }

BEGIN
  Seek(handle,recnr);          (* positioniere Lesezeiger *)
  BlockRead(handle, satz, kopf.recordb);
                               (* lese Satz in Buffer     *)
  IF Eof(handle) THEN BEGIN    (* EOF erreicht -> Fehler  *)
    WriteLn('EOF erreicht !!!');
    Halt;
  END;
END;  { GetRecord }

PROCEDURE PutRecord (VAR handle: FILE; VAR satz : dbsatz);
  {  schreibe einen Satz in die DBASE III - Datenbank.     }
  {  Die Daten sind als ASCII - Text im Puffer, geordnet   }
  {  nach Feldern, abzulegen.                              }

BEGIN
  Seek(handle,recnr);       (* positioniere Schreibzeiger *)
  BlockWrite(handle, satz, kopf.recordb);
                            (* in die Datenbank schreiben *)
  GetDate(jahr, monat, tag, wtag);        (* lese Datum   *)

  kopf.datum[1] := jahr MOD 100;   (* Jahr 0 .. 99        *)
  kopf.datum[2] := monat;          (* Monat               *)
  kopf.datum[3] := tag;            (* Tag                 *)

  Seek(handle,1);                  (* auf Datumsfeld      *)
  BlockWrite(handle,kopf.datum,3); (* Datum aktualisieren *)
END; { PutRecord }

PROCEDURE AppendBlank (VAR handle : FILE);
  { Hänge einen leeren Satz in die DBASE III - Datenbank an}
  { nach dem Aufruf steht der Schreiblesezeiger auf diesem }
  { Satz, d.h. PutRecord kann direkt Daten speichern.      }

VAR tmp : BYTE;
    i   : INTEGER;

BEGIN
  recnr := kopf.headerb + kopf.recordb * kopf.records;
                                           (* calc record *)
  Seek(handle, recnr);                     (* auf Ende    *)
  FOR i := 1 TO kopf.recordb DO BEGIN
    tmp := $20;               (* setz Blank in Puffer und *)
    BlockWrite(handle,tmp,1); (* in Datei schreiben       *)
  END;
  tmp := $1A;                 (* EOF - Marke anhängen     *)
  BlockWrite(handle,tmp,1);   (* schreibe Marke           *)
  GetDate(jahr,monat,tag,wtag);    (* lese Datum          *)

  kopf.datum[1] := jahr MOD 100;   (* Jahr 0 .. 99        *)
  kopf.datum[2] := monat;          (* Monat               *)
  kopf.datum[3] := tag;            (* Tag                 *)
  Seek (handle,1);                 (* auf Datumsfeld      *)
  BlockWrite(handle,kopf.datum,3); (* Datum aktualisieren *)

  kopf.records := kopf.records + 1;(* Korrektur Recordzahl*)
  Seek (handle, 4);              (* auf Position in Header*)
 BlockWrite (handle,kopf.records,4);
                                  (* Header aktualisieren *)
END; { AppendBlank }

PROCEDURE Skip;
  { Positioniere den Schreib-/Lesezeiger einen Satz weiter.}

BEGIN
  recnr := recnr + kopf.recordb;  (* nächster Satz        *)

END; { Skip }

PROCEDURE GotoBottom;
  { Positioniere den Schreib-/Lesezeiger auf Satz 1.       }

BEGIN
  recnr := kopf.headerb;          (* erster Satz          *)
END; { GotoBottom }

FUNCTION DBEof (VAR handle: FILE): BOOLEAN;
  { Prüfe, ob EOF() der Datenbank erreicht ist             }

BEGIN                       (* Dateiende erreicht ?       *)
  IF recnr >= kopf.headerb + kopf.recordb*kopf.records THEN
    DBEof := TRUE                        (* ja            *)
  ELSE
    DBEof := FALSE;                      (* nein          *)
END;  { DBEof }

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

BEGIN
                                        (* Kopf ausgeben  *)
  ClrScr;
  WriteLn ('DBASE III (DBF) DOC             ',
           ' (c) Born Version 1.0');
  WriteLn;
  Write ('File    : ');
  Read (FileName);                      (* lese Dateiname *)
  WriteLn;
  IF Length(FileName) = 0 THEN BEGIN    (* Leereingabe ?  *)
    WriteLn ('Der Name der Eingabedatei fehlt');
    Halt;
  END;

    {------------------------------------------------------}
    {      *** Bearbeitung der DBASE III Datei ***         }
    {  Dabei ist darauf zu achten, daß ein File mit dem    }
    {  angegegeben Namen existiert.                        }
    {------------------------------------------------------}

  IF NOT (Open (DbFile,FileName)) THEN BEGIN
                                   (* Datei vorhanden?    *)
    WriteLn ('Datei existiert nicht');
    Halt;
   END;

    {------------------------------------------------------}
    { lese und decodiere den Header der dBase III-Datei    }
    {------------------------------------------------------}

  GetHeader(DbFile);               (* lese Header         *)

    {------------------------------------------------------}
    { ***  Ausgabe des Headers der dBase III-Datei ***     }
    { Die Version gibt dabei an, ob intern Memofelder be-  }
    { nutzt wurden (version = 83H -> Memodatei)            }
    {------------------------------------------------------}
  WITH kopf DO BEGIN
    WriteLn ('Header der dBase III-Datei');
    WriteLn;
    Write ('Version      ');         (* Version DBF Datei *)
    Write_hex (version,Byte_len);
    WriteLn;
    WriteLn ('Datum        ', datum[3],':',
                              datum[2],':',datum[1]);
    WriteLn ('Records      ', records);
    WriteLn ('Header Länge ', headerb);
    WriteLn ('Record Länge ', recordb);
    WriteLn;
  END;
  WriteLn ('Weiter, bitte die <RET> Taste betätigen');
  tmp := ReadKey;

    {------------------------------------------------------}
    { lese und decodiere die Feldbescheibung der dBase III-}
    { Datei, es sind maximal 128 Felder zulässig           }
    {------------------------------------------------------}

  GetFieldDef(DbFile);           (* lese Feldbeschreibung *)
  WriteLn('Feldbeschreibung der Datei ', FileName);
  WriteLn;
  WriteLn('Feldname   │   Typ    │ Stellen │ Kommastellen');
  WriteLn('───────────┼──────────┼─────────┼─────────────');

  FOR i := 1 TO anzahl DO BEGIN  (* n Felddefinitionen    *)
    FOR j:= 1 TO 11 DO
      Write(Chr(felder[i].fname[j])); (* Name des Feldes  *)
    Write('│');
    CASE Chr(felder[i].ftyp) OF       (* gebe Feldtyp aus *)
      'N': Write('Numerisch │');
      'C': Write('Character │');
      'L': Write('Logical   │');
      'D': Write('Datum     │');
      'M': Write('Memo      │');
    END; { case }

    Write ('    ',felder[i].laenge:2);
    Write ('   │   ',felder[i].komma:2);
    WriteLn;
  END;
  WriteLn('───────────┴──────────┴─────────┴─────────────');

    {------------------------------------------------------}
    { *** Hinweis: Die Recordlänge ist 1 Byte größer als   }
    {              dies aus den Feldlängen ersichtlich ist,}
    {              da im ersten Byte des Records die In-   }
    {              formation für gelöschte Sätze steht (*).}
    {------------------------------------------------------}

  WriteLn ('Recordlänge in Bytes      ',kopf.recordb);
  WriteLn ;
  WriteLn ('Weiter, bitte die <RET> Taste betätigen');
  tmp := ReadKey;

    {------------------------------------------------------}
    { lese und decodiere die Datensätze der dBase III-Datei}
    {------------------------------------------------------}

  WriteLn ('Datensätze der dBase III-Datei ', FileName);
  WriteLn;

    {------------------------------------------------------}
    { Hier wird gezeigt, wie der Inhalt der Datei satzweise}
    { per FOR Schleife gelesen werden kann.                }
    {------------------------------------------------------}

  GotoBottom;                          (* auf 1. Satz     *)
  FOR i := 1 TO kopf.records DO BEGIN  (* Alle Records    *)
    GetRecord(DbFile,Buffer);          (* lese Satz       *)
    FOR j:= 1 TO kopf.recordb DO
      Write (Chr(Buffer[j]));        (* dokumentiere Satz *)
    WriteLn;
    Skip;                              (* nächster Satz   *)
  END;

    {------------------------------------------------------}
    { Der Inhalt des ersten Satzes wird verändert und in   }
    { die Datenbank zurückgespeichert                      }
    {------------------------------------------------------}

  Buffer[2] := Ord ('H');              (* ändere Feld 1   *}
  Buffer[3] := Ord ('a');
  Buffer[4] := Ord ('l');
  Buffer[5] := Ord ('l');
  Buffer[6] := Ord ('o');
  GotoBottom;                          (* auf 1. Satz     *)
  PutRecord (DbFile,Buffer);           (* speichere Satz  *)

    {------------------------------------------------------}
    { Alternativ besteht die Möglichkeit, die Datei satz-  }
    { weise zu lesen, bis EOF() erreicht ist. Hierfür dient}
    { die Funktion DBEof().                                }
    {------------------------------------------------------}

  WriteLn('Lese Datei nochmals');
  GotoBottom;                          (* auf 1. Satz     *)
  WHILE NOT DBEof (DbFile) DO BEGIN
    GetRecord (DbFile, Buffer);        (* lese Satz       *)
    Skip;                              (* nächster Satz   *)
  END;
  WriteLn('EOF Erreicht');

    {------------------------------------------------------}
    { Es wird ein leerer Satz angefügt und mit dem Inhalt  }
    { des letzten Satzes überschrieben                     }
    {------------------------------------------------------}

  WriteLn('Leersatz anhängen');
  AppendBlank(DbFile);            (* Leersatz anhängen    *)
  PutRecord(DbFile,Buffer);       (* alten Satz speichern *)
  Close(DbFile);
  WriteLn('Ende DBDOC');

END.
(* ------------------------------------------------------ *)
(*                  Ende von DBDOC.PAS                    *)