Turbo Toolbox/Turbo_Toolbox.iso/dtx9101/tools/dbtopas/dbutil.pas

Pascal/Delphi Source File | 1991-03-07 | 22.9 KB | 775 lines

(* ------------------------------------------------------ *)
(*                     DBUTIL.PAS                         *)
(*                dBase III Schnittstelle                 *)
(*             (c) 1991 F.Vogler & DMV-Verlag             *)
(* ------------------------------------------------------ *)
UNIT DBUTIL;

{.$DEFINE Debug }       (* zum Testen den '.' löschen ... *)

INTERFACE

USES Dos, Crt;

{$IFDEF Debug}
VAR
  OutF    : Text;
  OutTyp  : CHAR;
  Ch      : CHAR;
  OutName : PathStr;
{$ENDIF}

CONST
  MAX_OPENED = 3;    { maximale Anzahl offener DBF-Dateien }

TYPE
  pBuffer = ^tBuffer;
  tBuffer = RECORD
    Buf : ARRAY [1..4096] OF BYTE;
  END;

  pField = ^tField;          { Zeiger auf Feldbeschreibung }
  tField = RECORD            { Beschreibung eines Felds    }
    F_Name   : STRING [10];
    F_Type   : CHAR;
    F_Length : BYTE;
    F_Dec    : BYTE;
    F_Offset : WORD;         { erstes Byte des Felds       }
  END;

  pDatabase = ^tDatabase;    { Zeiger auf eine DBF-Datei   }
  tDatabase = RECORD         { Daten für jede DBF-Datei    }
    DOS_FName    : PathStr;
    DBT_FName    : PathStr;
    Fields       : ARRAY [1..128] OF pField;
    MaxFields    : BYTE;
    RecLength    : WORD;
    RecNumber    : LONGINT;
    StartByte    : WORD;
    LastRecord   : LONGINT;
    FieldCont    : tBuffer;
    ContainsMemo : BOOLEAN;
    MemoOpened   : BOOLEAN;
    MemoRead     : BOOLEAN;
    MemoBuffer   : pBuffer;
  END;

VAR
  DBF_Selected : BYTE;     { aktuell selektierte DBF-Datei }
  DBF_File     : FILE;     { DBF- und DBT-Dateien sind     }
  DBT_File     : FILE;     { nicht typisiert.              }
  a_DBF_File   : ARRAY [1..MAX_OPENED] OF pDatabase;
                           { Zeiger auf eine DBF-Datei     }
  aBuffer      : tBuffer;


  FUNCTION DBF_Open(Select : WORD;
                    FName  : PathStr) : BOOLEAN;
    (* öffnet eine DBF-Datei.                             *)
    (*                                                    *)
    (* Argumente: Select = Arbeitsbereich                 *)
    (*            FName  = DOS-Name der DBF-Datei         *)

  FUNCTION DBF_Read(Select : WORD;
                    RecNo  : LONGINT) : BOOLEAN;
    (* Versucht, eine DBF-Datei zu öffnen und             *)
    (* initialisiert die verwendeten Variablen.           *)
    (*                                                    *)
    (* Argumente: Select = Arbeitsbereich                 *)
    (*            RecNo  = zu lesender Datensatz          *)
    (* Rückgabe : TRUE, wenn der Satz gelesen wurde       *)
    (*                                                    *)
    (* Struktur einer DBF-Datei:                          *)
    (*                                                    *)
    (*                   Bytes     Inhalt                 *)
    (*   Bytes 1..32 :  5- 8   (LONGINT) = Anzahl Records *)
    (*                  9-10   (WORD)    = Offset 1.Satz  *)
    (*                 11-12   (WORD)    = Bytes/Record   *)
    (*                                                    *)
    (*   Bytes 32..1.Satz (in Einheiten zu je 32 Bytes)   *)
    (*                                                    *)
    (*                  1-10   (ASCIIZ)  = F_Name         *)
    (*                    12   (CHAR)    = F_Type         *)
    (*                    17   (BYTE)    = F_Length       *)
    (*                    18   (BYTE)    = F_Dec          *)
    (*                                                    *)
    (*   Jeder Datensatz beginnt mit einem Markierungs-   *)
    (*   feld: ' ' = Datensatz aktiv, '*' gelöscht.       *)
    (* -------------------------------------------------- *)

  PROCEDURE DBF_Close;
    (* Schließt DBF-Datei                                 *)

  FUNCTION Get_By_Nr(Select, i : WORD) : STRING;
    (* Gibt den Inhalt eines Feldes zurück                *)
    (*                                                    *)
    (* Argumente: Select = Arbeitsbereich                 *)
    (*            i      = Nummer des Felds               *)

  FUNCTION Get_Fields_Nr(Select : WORD;
                         FName  : STRING) : WORD;
    (* Gibt die Feldnummer zurück                         *)
    (*                                                    *)
    (* Argumente: Select = Arbeitsbereich                 *)
    (*            FName  = Feldname                       *)

  FUNCTION Get_Fields_Cont(Select : WORD;
                           FName : STRING) : STRING;
    (* Selektiert ein Feld, wenn der Datensatz gelesen    *)
    (* und gibt dessen Inhalt als String zurück. Ein      *)
    (* leerer String bedeutet, daß das Feld nicht         *)
    (* gefunden wurde.                                    *)
    (*                                                    *)
    (* Argumente: Select = Arbeitsbereich                 *)
    (*            FName  = Feldname                       *)

CONST
  MAXKEYS = 600;          { maximale Anzahl an NDX-Zeigern }

TYPE
  pIndex = ^tIndex;
  tIndex = RECORD
    Satz       : LONGINT;
    Last, Next : pIndex;
  END;

VAR
  Header    : pIndex;     { Zeiger auf ersten Datensatz    }
  FoundKeys : LONGINT;    { Anzahl der indizierten Records }


  FUNCTION NTX_Get(FName  : STRING;
                   IdxKey : STRING;
                   IsNtx  : BOOLEAN) : BOOLEAN;
    (* Durchsucht NTX- oder NDX-Datei und zählt gefundene *)
    (* Indizes in die Variable "FoundKeys". Entsprechende *)
    (* Datensätze werden während der Prozedur "NewKey"    *)
    (* gespeichert.                                       *)
    (*                                                    *)
    (* Argumente: FName  = kompl. Name der NTX-Datei      *)
    (*            IdxKey = gesuchter Schlüssel            *)
    (*            IsNtx  = TRUE  für NTX-Datei            *)
    (*                     FALSE für NDX-Datei            *)
    (* Rückgabe : TRUE, wenn Schlüssel gefunden wurde     *)

  FUNCTION IndexKey(FName : STRING;
                     IsNtx : BOOLEAN) : STRING;
    (* Gibt den Indexschlüssel zurück, der unter dBase    *)
    (* mit INDEX ON ...  angelegt wurde. Er beginnt in    *)
    (* NDX-Dateien mit Byte 22, in NTX-Dateien mit        *)
    (* Byte 24 und endet mit #0.                          *)
    (*                                                    *)
    (* Argumente: FName = Dateiname                       *)
    (*            IsNtx = TRUE für Clipper NTX-Dateien    *)

  FUNCTION FExists(FName : PathStr) : BOOLEAN;
    (* gibt TRUE zurück, wenn die angegebene Datei        *)
    (* existiert                                          *)

  FUNCTION Trim(S : STRING) : STRING;
    (* entführt führende und folgende Leerzeichen einer   *)
    (* Zeichenkette                                       *)

  FUNCTION StUpCase(S : STRING) : STRING;
    (* Wandelt eine Zeichenkette in Großbuchstaben um     *)


IMPLEMENTATION

VAR
  MaxnPtr  : pIndex;         { Letzter Zeiger auf tIndex   }
  NTX      : FILE;           { Handle der Indexdatei       }
  IndexLen : BYTE;           { Länge des Schlüssels in der }
                             { Indexdatei                  }
  KeyLen   : WORD;           { Minimum von IndexLen und    }
                             { Length(INDXKEY)             }
  MaxPages : LONGINT;        { Seiten in der NDX-Datei     }


  FUNCTION StUpCase(S : STRING) : STRING;
  VAR
    i : WORD;
  BEGIN
    FOR i := 1 TO Length(S) DO S[i] := UpCase(S[i]);
    StUpCase := S;
  END;

  FUNCTION Trim(S : STRING) : STRING;
  VAR
    i    : WORD;
    SLen : BYTE ABSOLUTE S;
  BEGIN
    WHILE (SLen > 0) AND (S[SLen] <= ' ') DO DEC(SLen);
    i := 1;
    WHILE (i <= SLen) AND (S[i] <= ' ') DO INC(i);
    DEC(i);
    IF i > 0 THEN Delete(S, 1, i);
    Trim := S;
  END;

  FUNCTION FExists(FName : PathStr) : BOOLEAN;
  VAR
    f : FILE;
  BEGIN
    Assign(f, FName);
    {$I-}
    Reset(f)
    {$I+} ;
    IF IOResult = 0 THEN BEGIN
      Close(f);
      FExists := TRUE;
    END ELSE FExists := FALSE;
  END;

  FUNCTION DBT_Read(Select : WORD;
                    RecNo  : LONGINT) : BOOLEAN;
  VAR
    r  : LONGINT;
    LL : LONGINT;
  BEGIN
    WITH a_DBF_File[Select]^ DO BEGIN
      IF MemoOpened THEN BEGIN
        r := RecNo * 512;
        Seek(DBT_File, r);
        LL := 512;
        {
        BlockRead(DBT_File, aBuffer, 4);
        Move(aBuffer.buf[1], LL, 4);
        Seek(DBT_File, r);
        LL := LL + 4;
        }
        BlockRead(DBT_File, MemoBuffer^, LL);
        DBT_Read := TRUE;
      END ELSE
        DBT_Read := FALSE;
    END;
  END;

  FUNCTION Get_Fields_Nr(Select : WORD;
                         FName  : STRING) : WORD;
  VAR
    i : WORD;
    s : STRING;
  BEGIN
    s := StUpCase(Trim(FName));
    i := 1;
    WITH a_DBF_File[Select]^ DO BEGIN
      WHILE (i <= MaxFields) AND
            (Trim(Fields[i]^.F_Name) <> s) DO INC(i);
      IF (i <= MaxFields) THEN
        Get_Fields_Nr := i
      ELSE
        Get_Fields_Nr := 0;
    END;
  END;

  FUNCTION Get_By_Nr(Select, i : WORD) : STRING;
  VAR
    s : STRING;
    r : LONGINT;
    e : INTEGER;
  BEGIN
    s[0] := Chr(0);
    WITH a_DBF_File[Select]^ DO BEGIN
      MemoRead := FALSE;
      IF (i > 0) AND (i <= MaxFields) THEN BEGIN
        Move(FieldCont.Buf[Fields[i]^.F_Offset],
             s[1], Fields[i]^.F_Length);
        s[0] := Chr(Fields[i]^.F_Length);
        IF Fields[i]^.F_Type = 'M' THEN BEGIN
          Val(Trim(s), r, e);
          IF (r > 0) AND (e = 0) THEN
            MemoRead := DBT_Read(Select, r);
        END;
      END;
    END;
    Get_By_Nr := s;
  END;

  FUNCTION Get_Fields_Cont(Select : WORD;
                           FName  : STRING) : STRING;
  BEGIN
    Get_Fields_Cont := Get_By_Nr(Select,
                       Get_Fields_Nr(Select, FName));
  END;

  PROCEDURE DBF_Close;
  BEGIN
    {$I-}
    Close(DBF_File);
    {$I+}
    IF IOResult <> 0 THEN ;
    {$I-}
    Close(DBT_File);
    {$I+}
    IF IOResult <> 0 THEN ;
    DBF_Selected := 0;
  END;

  PROCEDURE Blocks(    Start          : LONGINT;
                       Select, Number : WORD;
                   VAR Buffer         : tBuffer);
    (*  füllt den Puffer "Buffer"                         *)
    (* Argumente : Start  = Anfangsadresse zum Lesen      *)
    (*             Select = Arbeitsbereich                *)
    (*             Number = Anzahl zu lesender Bytes      *)
  BEGIN
    WITH a_DBF_File[Select]^ DO BEGIN
      IF DBF_Selected <> Select THEN BEGIN
        DBF_Close;
        Assign(DBF_File, DOS_FName);
        Reset(DBF_File, 1);
        IF ContainsMemo THEN BEGIN
          Assign(DBT_File, DBT_FName);
          Reset(DBT_File, 1);
          MemoOpened := TRUE;
        END;
      END;
      DBF_Selected := Select;
      Seek(DBF_File, Start);
      BlockRead(DBF_File, Buffer, Number);
    END;
  END;

  FUNCTION DBF_Open(Select : WORD;
                    FName  : PathStr) : BOOLEAN;
  VAR
    s         : STRING;
    i, Offset : WORD;
    r         : LONGINT;
  BEGIN
    DBF_Open := FALSE;
    IF NOT (Select IN [1..MAX_OPENED]) THEN Exit;
    s := StUpCase(FName);

    IF NOT FExists(s) THEN Exit;

    IF a_DBF_File[Select] = NIL THEN
      New(a_DBF_File[Select]);
    WITH a_DBF_File[Select]^ DO BEGIN
      Assign(DBF_File, s);
      DOS_FName    := s;
      ContainsMemo := FALSE;
      MemoOpened   := FALSE;
      MemoBuffer   := NIL;
      MemoRead     := FALSE;
      Reset(DBF_File);
      Blocks(0, Select, 128, aBuffer);
      Move(aBuffer.Buf[5], RecNumber, 4);

      Move(aBuffer.Buf[9], StartByte, 2);

      Move(aBuffer.Buf[11], RecLength, 2);

      r         := 32;
      MaxFields := 0;
      Offset    := 2;
      WHILE (r+4) < (StartByte) DO BEGIN
        INC(MaxFields);
        New(Fields[MaxFields]);
        WITH Fields[MaxFields]^ DO BEGIN
          Blocks(r, Select, 32, aBuffer);
          i      := 1;
          F_Name := '';
          WHILE aBuffer.Buf[i] > 0 DO BEGIN
            F_Name := F_Name + CHAR(aBuffer.Buf[i]);
            i := i+1;
          END;
          F_Type := CHAR(aBuffer.Buf[12]);
          IF (F_Type = 'M') AND
              NOT ContainsMemo THEN BEGIN
            s := Copy(DOS_FName, 1,
                      Pos('.', DOS_FName)) + 'DBT';
            IF FExists(s) THEN BEGIN
              New(MemoBuffer);
              DBT_FName    := s;
              ContainsMemo := TRUE;
            END;
          END;
          F_Length := aBuffer.Buf[17];
          F_Dec    := aBuffer.Buf[18];
          F_Offset := Offset;
          Offset   := Offset + F_Length;
        END;
        r := r + 32;
      END;
      DBF_Open := TRUE;
{$IFDEF Debug}
      IF OutTyp = 'S' THEN ClrScr;
      IF OutTyp = 'F' THEN Append(OutF);
      WriteLn(OutF, 'File Name: ', FName,
                    ' is Nr: ', Select);
      WriteLn(OutF, 'Contains ', RecNumber:10,
                    ' Recs; Record Length is ', RecLength);
      WriteLn(OutF, 'Nr Name      Type  Len  Dec');

      FOR i := 1 TO MaxFields DO
        WITH Fields[i]^ DO BEGIN
          Write(OutF, i:3, F_Name:10, '  ',
                      F_Type:1, '   ');
          Write(OutF, F_Length:3);
          IF F_Type = 'N' THEN Write(OutF, F_Dec:4);
          WriteLn(OutF);
          IF (OutTyp = 'S') AND ((i MOD 20) = 0) THEN BEGIN
            Write('Hit any key to continue...');
            Ch := ReadKey;
          END;
        END;

      IF OutTyp = 'F' THEN Close(OutF);
{$ENDIF}
    END;
  END;

  FUNCTION DBF_Read(Select : WORD;
                    RecNo  : LONGINT) : BOOLEAN;
  VAR
    r : LONGINT;
  BEGIN
    DBF_Read := FALSE;
    IF NOT (Select IN [1..MAX_OPENED]) THEN Exit;
                                           { illegal nr    }
    WITH a_DBF_File[Select]^ DO BEGIN
      IF (RecNo < 1) OR(RecNo > RecNumber) THEN Exit;
                                           { illegal RecNo }
      LastRecord := RecNo;
      r := (RecNo-1) * RecLength + StartByte;
      Blocks(r, Select, RecLength, FieldCont);
    END;
    DBF_Read := TRUE;
  END;

  FUNCTION IndexKey(FName : STRING;
                     IsNtx : BOOLEAN) : STRING;
  VAR
    Bufs : ARRAY [0..511] OF BYTE;
    s    : STRING;
    i    : WORD;
  BEGIN
    Assign(NTX, FName);
    Reset(NTX, 512);
    BlockRead(NTX, Bufs, 1);
    Close(NTX);
    IF IsNtx THEN
      i := 22
    ELSE
      i := 24;  { Start des Indexschlüssels (INDEX ON ...) }
    s := '';
    WHILE (i < 512) AND (Bufs[i] >= 32) DO BEGIN
      s := s + Chr(Bufs[i]); INC(i);
    END;
    IndexKey := s;
  END;


  FUNCTION Equals(s1, s2 : STRING) : BYTE;
    (* Byteweiser Stringvergleich                         *)
    (* Argumente: s1 = Index aus der Datei                *)
    (*            s2 = gesuchter Schlüssel                *)
    (*            Length(s1) = Length(s2) !!!             *)
    (* Rückgabe : 0, wenn s1 < s2                         *)
    (*            1, wenn s1 = s2                         *)
    (*            2, wenn s1 > s2                         *)
  VAR
    i : WORD;
    b : BYTE;
  BEGIN
    b := 1;
    i := 0;
    WHILE (i < Length(s1)) AND (b = 1) DO BEGIN
      INC(i);
      IF s1[i] < s2[i] THEN
        b := 0
      ELSE IF s1[i] > s2[i] THEN
        b := 2;
    END;
    Equals := b;
  END;

  FUNCTION NewRec(RecNo : LONGINT;
                  IsNtx : BOOLEAN) : BOOLEAN;
  BEGIN
    NewRec := FALSE;
    IF FoundKeys = MAXKEYS THEN Exit;
    NewRec := TRUE;
    INC(FoundKeys);
    IF Header = NIL THEN BEGIN
      New(Header);
      MaxnPtr      := Header;
      Header^.Last := NIL;
    END ELSE BEGIN
      New(MaxnPtr^.Next);
      MaxnPtr^.Next^.Last := MaxnPtr;
      MaxnPtr             := MaxnPtr^.Next;
    END;
    MaxnPtr^.Next := NIL;
    MaxnPtr^.Satz := RecNo;

{$IFDEF Debug}
    Write(OutF, ' add found ', FoundKeys, ' ', RecNo);
    IF OutTyp = 'S' THEN BEGIN
      Write(' [enter]->'); ReadLn;
    END ELSE
      WriteLn(OutF);
{$ENDIF}

  END;


  PROCEDURE NTX_Read(Ofs0   : LONGINT;
                     KeyLen : WORD;
                     IdxKey : STRING);
  VAR
    Ofs1, PG, Satz : LONGINT;
    j, Max, Offset : WORD;
    i              : INTEGER;
    BB             : BYTE;
    Buffer         : ARRAY [0..1023] OF BYTE;
    OneStr         : STRING;
    ok             : BOOLEAN;
  BEGIN
    Ofs1 := Ofs0;
    IF FoundKeys = MAXKEYS THEN Exit;
    WHILE (Ofs1 > 0) DO BEGIN
      Seek(NTX, Ofs1);
      BlockRead(NTX, Buffer, 1);
      Move(Buffer[0], Max, 2);
      Move(Buffer[2], Offset, 2);
      ok := TRUE;
      i  := -1;
      WHILE (i < Pred(Max)) AND ok DO BEGIN
        INC(i);
        Move(Buffer[i*2+2], j, 2);
        Move(Buffer[j+8], OneStr[1], IndexLen);
        OneStr[0] := Chr(IndexLen);
        BB := Equals(Copy(OneStr, 1, KeyLen),
                     Copy(IdxKey, 1, KeyLen));
        IF BB IN [1..2] THEN BEGIN
          Move(Buffer[j], PG, 4);
          PG := PG DIV 1024;
          Move(Buffer[j+4], Satz, 4);
          IF (BB = 1) AND (PG = 0) THEN
            IF NOT (NewRec(Satz, TRUE)) THEN Exit;
          IF PG > 0 THEN BEGIN
            NTX_Read(PG, KeyLen, IdxKey);
            IF BB = 1 THEN
              IF NOT (NewRec(Satz, TRUE)) THEN Exit;
          END;
          IF BB = 2 THEN ok := FALSE;
        END;
      END;
      Ofs1 := 0;
      IF ok THEN BEGIN
        Move(Buffer[Max*2+2], j, 2);
        Move(Buffer[j], Ofs1, 4);
        Ofs1 := Ofs1 DIV 1024;
      END;
    END;
  END;


  FUNCTION NTX_Get(FName  : STRING;
                   IdxKey : STRING;
                   IsNtx  : BOOLEAN) : BOOLEAN;
  TYPE
    EinRecPtr = ^EinRec;
    EinRec    = RECORD
      PG   : LONGINT;
      Satz : LONGINT;
      Key  : STRING [30];
      Next : EinRecPtr;
    END;
  VAR
    Buffer     : ARRAY [0..1023] OF BYTE;      { ein Block }
    Root       : LONGINT;                      { Start PG  }
    KeyOffset  : BYTE;
    BB         : BYTE;
    Pass       : LONGINT;


    PROCEDURE NDX_Start;
    BEGIN
      Assign(NTX, FName);
      Reset(NTX, 512);
      BlockRead(NTX, Buffer, 1);
      Move(Buffer[12], IndexLen, 1);
      Move(Buffer[0], Root, 4);
      Move(Buffer[18], KeyOffset, 1);
      Move(Buffer[4], MaxPages, 4);
    END;

    PROCEDURE NTX_Start;
    BEGIN
      Assign(NTX, FName);
      Reset(NTX, 1024);
      BlockRead(NTX, Buffer, 1);
      Move(Buffer[4], Root, 4);
      Root := Root DIV 1024;
      Move(Buffer[14], IndexLen, 2);
    END;

    PROCEDURE NDX_Read(Ofs0 : LONGINT);
    VAR
      Buffer         : ARRAY [0..511] OF BYTE;
      Rec, PGG, Satz : LONGINT;
      Key            : STRING;
      Offset         : WORD;
      ok             : BOOLEAN;
    BEGIN
      IF FoundKeys = MAXKEYS THEN Exit;
      Rec := Ofs0;
      Seek(NTX, Rec);
      BlockRead(NTX, Buffer, 1);
      ok     := TRUE;
      Offset := 4;
      WHILE ok AND ((Offset + KeyOffset) <= 512) DO BEGIN
        Move(Buffer[Offset], PGG, 4);
        Move(Buffer[Offset+4], Satz, 4);
        Move(Buffer[Offset+8], Key[1], IndexLen);
        Key[0] := Chr(IndexLen);
        Offset := Offset + KeyOffset;
        IF (Satz + PGG) = 0 THEN
          ok := FALSE
        ELSE BEGIN
          IF (KeyLen > 0) THEN
            BB := Equals(Copy(Key, 1, KeyLen),
                         Copy(IdxKey, 1, KeyLen))
          ELSE
            BB := 1;

{$IFDEF Debug}
          Write(OutF, 'Internalkey: ', Key,
                      ' Searchkey: ', IdxKey, ' ', BB);
          IF (BB = 0) THEN             { Internal < Search }
            IF OutTyp = 'S' THEN BEGIN
              Write(' [enter]->'); ReadLn;
            END ELSE
              WriteLn(OutF);
{$ENDIF}
          IF (BB = 1) AND (PGG = 0) THEN
            IF NOT (NewRec(Satz, IsNtx)) THEN Exit;
          IF BB IN [1..2] THEN BEGIN
            IF PGG > 0 THEN BEGIN
{$IFDEF Debug}
              Write(' add pointer ', PGG, ' ', Key);
              IF OutTyp = 'S' THEN BEGIN
                Write(' [enter]->'); ReadLn;
              END ELSE
                WriteLn(OutF);
{$ENDIF}
              IF (FoundKeys >= 600) OR (BB = 2) THEN
                ok := FALSE;
            END;
          END;
          IF PGG > 0 THEN NDX_Read(PGG);
        END;
      END;
      IF ok THEN BEGIN
        INC(Rec);
        IF Rec > MaxPages THEN ok := FALSE;
      END;
      IF NOT ok THEN Rec := 0;
    END;

  BEGIN
    NTX_Get   := FALSE;
    Header    := NIL;
    FoundKeys := 0;
{$IFDEF Debug}
    IF OutTyp = 'F' THEN Append(OutF);
    ClrScr;
    WriteLn(OutF, 'Index: ', FName, ' ',
                  FExists(FName), ' ', Length(IdxKey), ' ',
                  IdxKey);
    Write(OutF, IndexKey(FName, IsNtx));
    IF OutTyp = 'S' THEN BEGIN
      Write(' [enter]->'); ReadLn;
    END ELSE
      WriteLn(OutF);
{$ENDIF}
    IF Length(Trim(FName)) = 0 THEN Exit;
    IF NOT FExists(FName) THEN Exit;
    IF IsNtx THEN
      NTX_Start
    ELSE
      NDX_Start;
{$IFDEF Debug}
    Write(OutF, 'Is_NTX: ', IsNtx, ' Root ', Root);
    IF OutTyp = 'S' THEN BEGIN
      Write(' [enter]->'); ReadLn;
    END ELSE
      WriteLn(OutF);
{$ENDIF}
    KeyLen := Length(IdxKey);
    IF IndexLen < KeyLen THEN KeyLen := IndexLen;
    IF Root > 0 THEN
      IF IsNtx THEN
        NTX_Read(Root, KeyLen, IdxKey)
      ELSE
        NDX_Read(Root);
    NTX_Get := Header <> NIL;
    Close(NTX);
{$IFDEF Debug}
    Write(OutF, 'Recs Found ', FoundKeys);
    IF OutTyp = 'S' THEN BEGIN
      Write(' [enter]->'); ReadLn;
    END ELSE
      WriteLn(OutF);
    IF OutTyp = 'F' THEN Close(OutF);
{$ENDIF}
  END;

  PROCEDURE Init;
{$IFDEF Debug}
  VAR
    x, y : BYTE;
{$ENDIF}
  VAR
    i : WORD;
  BEGIN
    FOR i := 1 TO MAX_OPENED DO
      a_DBF_File[i] := NIL;
    DBF_Selected := 0;
       { keine dBase III Datei ist geöffnet }
{$IFDEF Debug}
    ClrScr;
    Write('Output to S(creen), P(rinter), F(ile) S/P/F ');
    x := WhereX;
    y := WhereY;
    REPEAT
      GotoXY(x,y);
      OutTyp := ReadKey;
      OutTyp := UpCase(OutTyp);
    UNTIL OutTyp IN ['F', 'P', 'S'];
    CASE OutTyp OF
      'F' : BEGIN
              REPEAT
                Write('Output Text File Name? ');
                ReadLn(OutName);
              UNTIL Length(OutName) > 0;
              Assign(OutF, OutName);
              IF NOT FExists(OutName) THEN BEGIN
                Rewrite(OutF);
                Close(OutF);
              END;
            END;
      'P' : BEGIN
              Assign(OutF, 'PRN');
              Rewrite(OutF);
            END;
      'S' : BEGIN
              Assign(OutF, 'CON');
              Rewrite(OutF);
            END;
    END;
{$ENDIF}

  END;


BEGIN
  Init;
END.
(* ------------------------------------------------------ *)
(*               Ende von DBUTIL.PAS                      *)