{$R-}    {Range checking off}
{$S+}    {Stack checking on}
{$I+}    {I/O checking on}
{$N-}    {No numeric coprocessor}

(* The routines in this file present fairly general purpose tools for
   accessing dBASE III and dBASE III Plus files from within a Turbo
Pascal
   program. The main routines are:

      FUNCTION OpenDbf(VAR D : DbfInfoType;) : Integer;
      FUNCTION CloseDbf(VAR D : DbfInfoType) : Integer;
      PROCEDURE GetDbfRecord(VAR D : DbfInfoType; RecNum : Integer);
      PROCEDURE PutDbfRecord(VAR D : DbfInfoType; RecNum : Integer);
      PROCEDURE AppendDbf(VAR D : DbfInfotype);

      A skeletal program would go something like:
        BEGIN
        {...initialize and get filename of .dbf file into FileName
field
            of DbfInfoType Record variable ...  }
        IF OpenDbf(...)  { to open the file              }
        {... the rest of your program including calls to
             GetDbfRecord and/or PutDbfRecord as needed  }
        IF CloseDbf (...) { to close the file            }
        END.

      Upon exit from the GetDbfRecord Procedure, the CurRecord field
of the
      DbfInfoType variable contains the current record contents.  Each
field
      can be accessed using its offset into the CurRecord with the
variable
      Off in the Fields array.
      Upon entry to the PutDbfRecord Procedure, the CurRecord should
contain
      the data that you want to write.

      See the demo program for some examples.
*)



Uses
  Crt, {Unit found in TURBO.TPL}
  Dos, {Unit found in TURBO.TPL}
  DBF;

TYPE
  PseudoStr = ARRAY[1..255] OF Char;

VAR
  DemoInfo : DbfInfoType;
  l, i, j : Integer;
  blanks : Str255;
  SizeOfFile : Real;
  r : longint;

  
  
PROCEDURE List(VAR D : DbfInfoType);

    
PROCEDURE ShowField(VAR a; VAR F : FieldRecord);

    VAR
      Data : PseudoStr ABSOLUTE a;

    BEGIN
    WITH F DO
      BEGIN
      CASE Typ OF
        'C', 'N', 'L' : Write(Copy(Data, 1, Len));
        'M' : Write('Memo      ');
        'D' : Write(Copy(Data, 5, 2), '/',
              Copy(Data, 7, 2), '/',
              Copy(Data, 1, 2));
      END;                    {CASE}
      IF Len <= Length(Name) THEN
        Write(Copy(blanks, 1, Length(Name)-Pred(Len)))
      ELSE
        Write(' ');
      END;                    {WITH F}
    END;                      {ShowField}

  BEGIN                       {List}
  WriteLn;
  Write('Rec Num ');
  WITH D DO
    BEGIN
    FOR i := 1 TO NumFields DO
      WITH Fields[i] DO
        IF Len >= Length(Name) THEN
          Write(Name, Copy(blanks, 1, Succ(Len-Length(Name))))
        ELSE
          Write(Name, ' ');
    WriteLn;
    r := 1;
    WHILE r <= NumRecs DO
      BEGIN
      GetDbfRecord(DemoInfo, r);
      WriteLn;
      Write(r:7, ' ');
      FOR i := 1 TO NumFields DO ShowField(CurRecord[Fields[i].Off],
Fields[i]);
      r := r+1;
      END;                    {WHILE r }
    END;                      {WITH D }
  END;                        {List}

  
PROCEDURE DisplayStructure(VAR D : DbfInfoType);

  
VAR
    row, i : Integer;

  BEGIN
  row := 0;
  WITH D DO
    BEGIN
    FOR i := 1 TO NumFields DO
      BEGIN
      WITH Fields[i] DO
        BEGIN
        IF i MOD 22 = 0 THEN
          BEGIN
          WriteLn;
          Wait;
          row := 0;
          END;
        row := Succ(row);
        IF row MOD 22 = 1 THEN
          BEGIN
          ClrScr;
          Write(' #  Field Name   Type  Length  Decimal');
          row := 2;
          END;
        GoToXY(1, row);
        Write(i:2, Name:12, Typ:5, Len:9);
        IF Typ = 'N' THEN Write(Dec:5);
        END;                  {WITH Fields}
      END;                    {FOR}
    WriteLn;
    Wait;
    END;                      {WITH D}
  END;                        { DisplayStructure }



BEGIN                         {Demonstration of DBF routines}
WITH DemoInfo DO
  BEGIN
  FillChar(blanks, SizeOf(blanks), $20);
  blanks[0] := Chr(255);
  ClrScr;
  GoToXY(10, 10);
  Write('Name of dBASE file (.DBF assumed): ');
  Read(FileName);
  IF Pos('.', FileName) = 0 THEN FileName := FileName+'.DBF';
  IF OpenDbf(DemoInfo) <> 0 THEN ErrorHalt('Unable to open
'+FileName);
  ClrScr;
  SizeOfFile := FileSize(dFile);
  WriteLn('File Name: ', FileName);
  WriteLn('Date Of Last Update: ', DateOfUpdate);
  WriteLn('Number of Records: ', NumRecs:10);
  WriteLn('Size of File: ', SizeOfFile:15:0);
  WriteLn('Length of Header: ', HeadLen:11);
  WriteLn('Length of One Record: ', RecLen:7);
  IF WithMemo THEN WriteLn('This file contains Memo fields.');
  Wait;
  ClrScr;
  DisplayStructure(DemoInfo);
  ClrScr;
  List(DemoInfo);
  WriteLn;
  Wait;
  IF CloseDbf(DemoInfo) <> 0 THEN ErrorHalt('Error closing file.');
  END; {WITH}
END.                          {of Demo program }

