'* --------------------------------------*
'*  Prog.-Name: DBQUICK.BAS              *
'*  Anzeige von Informationen �ber       *
'*       dBase-Datenbankdateien          *
'*  Prog.-Sprache: Quick-Basic 4.5       *
'*          alle Grafikkarten            *
'*  (c) Redaktionsb�ro Everts&Hagedorn   *
'*  Autor:  Karl-Ernst Prankel           *
'* --------------------------------------*
CONST FALSCH = 0, WAHR = NOT FALSCH
TYPE Header
  Version AS STRING * 1
  Jahr AS STRING * 1
  Monat AS STRING * 1
  Tag AS STRING * 1
  AnzSaetze AS LONG
  LenVorspann AS INTEGER
  LenSatz AS INTEGER
  Dummy1 AS INTEGER
  Transakt AS STRING * 1
  Kodiert AS STRING * 1
  Dummy2 AS STRING * 12
  Mdx AS STRING * 1
  Dummy3 AS STRING * 3
END TYPE
TYPE SatzStrukt
  Feldname AS STRING * 11
  FeldTyp AS STRING * 1
  Dummy01 AS STRING * 4
  LenFeld AS STRING * 1
  LenDezStelle AS STRING * 1
  Dummy02 AS STRING * 2
  ArbeitsBer AS STRING * 1
  Dummy03 AS STRING * 11
END TYPE
DECLARE SUB Ende ()
DECLARE SUB HoleDatei (Head AS ANY, Felder() AS ANY)
DECLARE SUB SatzAnzeige (FeldAngez%, Nr&, Felder() AS ANY)
DECLARE SUB ZeigeStruktur (FeldFertig%, Struktur() AS ANY)
DECLARE SUB ZeigeVorspann (Head AS ANY)
DIM SHARED Fehler
DIM Kopf AS Header
REM $DYNAMIC
DIM FeldInfo(1) AS SatzStrukt
CALL HoleDatei(Kopf, FeldInfo())
DO
  VIEW PRINT
  LOCATE 24: PRINT "I - Allgemeine DateiInfos  *  S - Struktur der Datenbank  *  D - Datensatznummer"
  LOCATE 25: PRINT "N - N�chster Datensatz * V - Vorheriger Datensatz * A - Andere Datei  * E - Ende";
  DO
    Eingabe$ = UCASE$(INPUT$(1))
  LOOP UNTIL INSTR("ADEINSV ", Eingabe$) <> 0
  LOCATE 22: PRINT STRING$(80, 196);
  IF Eingabe$ <> " " THEN FeldAngez% = 0: FeldFertig% = 1
  SELECT CASE Eingabe$
    CASE "A"
      CALL HoleDatei(Kopf, FeldInfo())
      SatzNummer& = 0
    CASE "E"
      CALL Ende
    CASE "I"
      CALL ZeigeVorspann(Kopf)
    CASE "S"
      CALL ZeigeStruktur(FeldFertig%, FeldInfo())
    CASE "D"
      IF Kopf.AnzSaetze <> 0 THEN
        LOCATE 23: PRINT SPACE$(80);
        DO
          LOCATE 24: PRINT SPACE$(80); : LOCATE 24
          PRINT "Geben Sie eine Datensatznummer zwischen 1 und" + STR$(Kopf.AnzSaetze) + " ein: ";
          LINE INPUT ; "", SatzNr$
          SatzNummer& = VAL(SatzNr$)
          IF SatzNummer& >= 1 AND SatzNummer& <= (Kopf.AnzSaetze) THEN
            EXIT DO
          ELSE
            LOCATE 23: PRINT SPACE$(14) + "EINGEGEBENE DATENSATZNUMMER AUSSERHALB DES BEREICHS!";
          END IF
        LOOP
      END IF
    CASE "N"
      IF SatzNummer& < Kopf.AnzSaetze THEN SatzNummer& = SatzNummer& + 1
    CASE "V"
      IF SatzNummer& > 1 THEN SatzNummer& = SatzNummer& - 1 ELSE SatzNummer& = 1
    CASE " "
      IF FeldAngez% > 0 AND FeldAngez% < UBOUND(FeldInfo) THEN
        SEEK #1, SEEK(1) - ASC(FeldInfo(FeldAngez% + 1).LenFeld)
        CALL SatzAnzeige(FeldAngez%, SatzNummer&, FeldInfo())
      END IF
      IF FeldFertig% > 1 AND FeldFertig% < UBOUND(FeldInfo) THEN
        CALL ZeigeStruktur(FeldFertig%, FeldInfo())
      END IF
  END SELECT
  IF INSTR("DNV", Eingabe$) <> 0 THEN
    IF Kopf.AnzSaetze <> 0 AND Kopf.LenVorspann + (Kopf.LenSatz * SatzNummer&) <= LOF(1) THEN
      SEEK #1, Kopf.LenVorspann + 1 + ((SatzNummer& - 1) * Kopf.LenSatz)
      CALL SatzAnzeige(FeldAngez%, SatzNummer&, FeldInfo())
    ELSE
      VIEW PRINT 5 TO 22
      CLS 2
      LOCATE 12, 5
      IF Kopf.AnzSaetze = 0 THEN
        PRINT "Die Datenbank ist leer!"
      ELSE
        PRINT "Die Angaben im Dateivorspann stimmen nicht mit der Dateigr��e �berein!": LOCATE , 5
        PRINT "Mehr als"; : PRINT (LOF(1) - Kopf.LenVorspann) \ Kopf.LenSatz; : PRINT "Datens�tze passen nicht in die Datei!"
        SatzNummer& = ((LOF(1) - Kopf.LenVorspann) \ Kopf.LenSatz) + 1
      END IF
    END IF
  END IF
LOOP
END
FehlerProz:
LOCATE 13, 15
SELECT CASE ERR
  CASE 55
    CLOSE #1
    RESUME
  CASE 64
    PRINT "Unzul�ssiger Dateiname!"
  CASE 71
    PRINT "Diskette nicht bereit!"
  CASE 76
    PRINT "Pfad nicht gefunden!"
  CASE ELSE
    VIEW PRINT 9 TO 15
    CLS
    ON ERROR GOTO 0
END SELECT
LOCATE , 15: PRINT "Bet�tigen Sie eine beliebige Taste!"
Eing$ = INPUT$(1)
Fehler = WAHR
RESUME NEXT
REM $STATIC
SUB Ende
VIEW PRINT
CLS
CLOSE #1
END
END SUB
SUB HoleDatei (Head AS Header, Felder() AS SatzStrukt) STATIC
DO
  Fehler = FALSCH
  CLS
  PRINT SPACE$(10) + "Informationen �ber dBASE-Datenbankdateien unter QUICK BASIC" + SPACE$(10)
  LOCATE 4: PRINT STRING$(80, 196)
  LOCATE 23: PRINT STRING$(80, 196)
  LOCATE 24, 1: PRINT "Geben Sie [Laufwerk, Pfad] Namen [und Extension] einer dBASE -Datei ein!";
  LOCATE 25, 1: INPUT ; "[<ENTER> allein beendet das Programm]: ", Dateiname$
  IF Dateiname$ = "" THEN CALL Ende
  IF INSTR(Dateiname$, ".") = 0 THEN Dateiname$ = Dateiname$ + ".dbf"
  LOCATE 2, (82 - LEN(Dateiname$)) \ 2: PRINT UCASE$(Dateiname$)
  ON ERROR GOTO FehlerProz
  OPEN Dateiname$ FOR BINARY AS #1
  ON ERROR GOTO 0
  IF NOT Fehler THEN
    IF LOF(1) < 66 THEN
      IF LOF(1) = 0 THEN
        LOCATE 10, 15: PRINT "Die Datei " + Dateiname$
        LOCATE , 15: PRINT "hat eine L�nge von 0 Byte!"
        LOCATE 13, 15: PRINT "Bet�tigen Sie die Taste <J>, um die Datei zu l�schen,"
        LOCATE , 15: PRINT "oder eine beliebige andere Taste!"
        IF UCASE$(INPUT$(1)) = "J" THEN CLOSE #1: KILL Dateiname$
      ELSE
        LOCATE 11, 15: PRINT "Die Datei " + Dateiname$
        LOCATE , 15: PRINT "kann von ihrer L�nge her keine dBASE-Datei sein."
        LOCATE , 15: PRINT "Bet�tigen Sie eine beliebige Taste!": Eing$ = INPUT$(1)
      END IF
      Fehler = WAHR
    ELSE
     GET #1, 1, Head
     IF ASC(Head.Version) MOD 8 <> 3 OR ASC(Head.Jahr) > 99 OR ASC(Head.Monat) = 0 OR ASC(Head.Monat) > 12 OR ASC(Head.Tag) = 0 OR ASC(Head.Tag) > 31 OR Head.AnzSaetze > 1000000000 OR Head.AnzSaetze < 0 THEN Fehler = WAHR
     IF Head.LenVorspann < 65 OR Head.LenVorspann > 8193 OR Head.LenSatz < 2 OR Head.LenSatz > 4000 OR ASC(Head.Transakt) > 1 OR ASC(Head.Kodiert) > 1 OR ASC(Head.Mdx) > 1 THEN Fehler = WAHR
     IF Fehler THEN
       LOCATE 10, 15: PRINT "Die gew�hlte Datei ist keine dBASE-Datei oder"
       LOCATE 11, 15: PRINT "sie enth�lt unzul�ssige Werte im Datei-Vorspann!"
       LOCATE 13, 15: PRINT "Bet�tigen Sie eine beliebige Taste!": Eing$ = INPUT$(1)
      END IF
    END IF
  END IF
LOOP WHILE Fehler
REDIM Felder((Head.LenVorspann - 33) \ 32) AS SatzStrukt
FOR z% = 1 TO UBOUND(Felder)
  GET #1, , Felder(z%)
NEXT z%
CALL ZeigeVorspann(Head)
END SUB
SUB SatzAnzeige (FeldAngez%, Nr&, Felder() AS SatzStrukt) STATIC
VIEW PRINT
SatzNrAnzeige$ = "Anzeige von Datensatz Nummer:" + STR$(Nr&)
LOCATE 3: PRINT SPACE$((80 - LEN(SatzNrAnzeige$)) \ 2) + SatzNrAnzeige$ + SPACE$((80 - LEN(SatzNrAnzeige$)) \ 2)
zeile% = 1
IF FeldAngez% = 0 THEN
  IF INPUT$(1, #1) = "*" THEN
    LOCATE 4, 24: PRINT " DATENSATZ ZUM L�SCHEN MARKIERT! "
  ELSE
    PRINT STRING$(80, 196)
  END IF
END IF
VIEW PRINT 5 TO 22
CLS 2
FOR z% = FeldAngez% + 1 TO UBOUND(Felder)
  zeichenket$ = INPUT$(ASC(Felder(z%).LenFeld), #1)
  PRINT MID$(Felder(z%).Feldname, 1, INSTR(Felder(z%).Feldname, CHR$(0)) - 1); : LOCATE , 11: PRINT ":";
  DO WHILE LEN(zeichenket$) > 0
    IF LEN(zeichenket$) > 65 THEN
      Position% = 65
      DO WHILE MID$(zeichenket$, Position%, 1) <> " "
        Position% = Position% - 1
        IF Position% = 1 THEN Position% = 65: EXIT DO
      LOOP
      LOCATE , 15: PRINT LEFT$(zeichenket$, Position%);
      zeichenket$ = RIGHT$(zeichenket$, LEN(zeichenket$) - Position%)
    ELSE
      LOCATE , 15
      IF Felder(z%).FeldTyp = "D" THEN
        PRINT RIGHT$(zeichenket$, 2) + "." + MID$(zeichenket$, 5, 2) + "." + LEFT$(zeichenket$, 4);
      ELSE
        PRINT zeichenket$;
      END IF
     zeichenket$ = ""
    END IF
    zeile% = zeile% + 1
    IF zeile% = 19 AND (LEN(zeichenket$) > 0 OR z% < UBOUND(Felder)) THEN
      VIEW PRINT
      LOCATE 23, 17: PRINT " Leertaste - Fortsetzung der Anzeige des Satzes ";
      z% = z% - 1
      EXIT FOR
    END IF
    IF zeile% <> 19 THEN PRINT
  LOOP
NEXT z%
FeldAngez% = z%
END SUB
SUB ZeigeStruktur (FeldFertig%, Struktur() AS SatzStrukt) STATIC
VIEW PRINT
LOCATE 3: PRINT SPACE$(20) + "Informationen �ber die Datensatzstruktur" + SPACE$(20)
PRINT STRING$(80, 196)
PRINT "Feldname      Feldtyp        Feldl�nge     Dezimalstellen" + SPACE$(22)
PRINT STRING$(80, "-")
VIEW PRINT 7 TO 22
CLS 2
FOR z% = FeldFertig% TO UBOUND(Struktur)
  SELECT CASE Struktur(z%).FeldTyp
    CASE "C": Typ$ = "Zeichen"
    CASE "N": Typ$ = "Numerisch"
    CASE "D": Typ$ = "Datum"
    CASE "L": Typ$ = "Logisch"
    CASE "F": Typ$ = "Gleitkomma"
    CASE "M": Typ$ = "Memo"
    CASE ELSE: Typ$ = "unbekannt"
  END SELECT
  PRINT MID$(Struktur(z%).Feldname, 1, INSTR(Struktur(z%).Feldname, CHR$(0))), Typ$, ASC(Struktur(z%).LenFeld), ASC(Struktur(z%).LenDezStelle);
  IF z% MOD 16 = 0 AND z% < UBOUND(Struktur) THEN
    VIEW PRINT
    LOCATE 23, 12: PRINT " Leertaste - Fortsetzung der Anzeige der Datensatzstruktur ";
    EXIT FOR
  END IF
  IF z% MOD 16 <> 0 THEN PRINT
NEXT z%
FeldFertig% = z% + 1
END SUB
SUB ZeigeVorspann (Head AS Header) STATIC
VIEW PRINT
LOCATE 3: PRINT SPACE$(25) + "Allgemeine Dateiinformationen" + SPACE$(25)
LOCATE 23: PRINT STRING$(80, 196);
VIEW PRINT 5 TO 22
CLS 2
LOCATE 8: PRINT "Version:"; : LOCATE , 35
SELECT CASE ASC(Head.Version)
  CASE 3: PRINT "dBASE III Plus / dBASE IV"
  CASE 131: PRINT "dBASE III Plus"
  CASE ELSE: PRINT "dBASE IV"
END SELECT
PRINT "Memodatei:"; : LOCATE , 35
IF ASC(Head.Version) > 130 THEN PRINT "vorhanden" ELSE PRINT "nicht vorhanden"
PRINT "Datum der letzten �nderung:"; : LOCATE , 35
PRINT LTRIM$(STR$(ASC(Head.Tag))); "."; LTRIM$(STR$(ASC(Head.Monat))); ".";
IF ASC(Head.Jahr) < 9 THEN PRINT "0";
PRINT LTRIM$(STR$(ASC(Head.Jahr)))
PRINT "Anzahl der Datens�tze:"; : LOCATE , 34: PRINT Head.AnzSaetze
PRINT "Anzahl der Felder:"; : LOCATE , 34: PRINT (Head.LenVorspann - 33) \ 32
PRINT "L�nge der Datens�tze in Byte:"; : LOCATE , 34: PRINT Head.LenSatz; : PRINT "   (incl. L�schkennzeichen)"
PRINT "L�nge des Vorspanns in Byte:"; : LOCATE , 34: PRINT Head.LenVorspann
IF NOT ASC(Head.Version) = 131 THEN
  PRINT "Transaktionsbit:"; : LOCATE , 35
  IF ASC(Head.Transakt) = 0 THEN PRINT "nicht ";
  PRINT "gesetzt"
  PRINT "Datenbank:"; : LOCATE , 35
  IF ASC(Head.Kodiert) = 0 THEN PRINT "nicht ";
  PRINT "kodiert"
  PRINT "MDX-Indexdatei:"; : LOCATE , 35
  IF ASC(Head.Mdx) = 0 THEN PRINT "nicht ";
  PRINT "vorhanden"
END IF
PRINT "Dateil�nge in Byte:"; : LOCATE , 34: PRINT LOF(1)
PRINT
END SUB