home *** CD-ROM | disk | FTP | other *** search
/ Programming Tool Box / SIMS_2.iso / bp_3_94 / vbdos / abfrage.bas next >
BASIC Source File  |  1994-05-25  |  7KB  |  233 lines
  1. DECLARE SUB Baum_New (Zeiger AS INTEGER)
  2. DECLARE FUNCTION BedingungPasst (Daten AS ANY, Zeiger AS INTEGER) AS INTEGER
  3. DECLARE SUB ErstelleBlatt (Wort AS STRING, Zeiger AS INTEGER)
  4. DECLARE SUB Parse (Ausdruck AS STRING, Zeiger AS INTEGER)
  5. DECLARE FUNCTION Passt (Daten AS ANY, Zeiger AS INTEGER) AS INTEGER
  6. DECLARE SUB TeileWoerter (Zeile AS STRING, Wort() AS STRING)
  7. CONST True = -1, False = 0
  8.  
  9. TYPE AdressenTyp
  10.    Name AS STRING * 40
  11.    Strasse AS STRING * 40
  12.    Ort AS STRING * 40
  13.    Bestellungen AS INTEGER
  14. END TYPE
  15.  
  16. TYPE BaumTyp
  17.    Operator AS STRING * 40
  18.    LinkerNachf AS INTEGER
  19.    RechterNachf AS INTEGER
  20. END TYPE
  21.  
  22. COMMON SHARED Baum() AS BaumTyp
  23.  
  24. REDIM Baum(0 TO 0) AS BaumTyp
  25.  
  26. ' hier beginnt der Test-Teil
  27.  
  28. DIM A AS AdressenTyp, Such AS STRING
  29. DIM BaumStart AS INTEGER
  30. CLS : PRINT "---- Baum-Suche Testprogramm ----"
  31. LINE INPUT "Suchausdruck: ", Such
  32.  
  33. Parse Such, BaumStart ' Baum erzeugen
  34.  
  35. DO
  36.    PRINT "-------------------"
  37.    INPUT "Dateneingabe Name: ", A.Name
  38.    INPUT "           Straße: ", A.Strasse
  39.    INPUT "              Ort: ", A.Ort
  40.    INPUT "     Bestellungen: ", A.Bestellungen
  41.  
  42.    IF Passt(A, BaumStart) THEN
  43.       PRINT "Datensatz paßt auf Suchausdruck"
  44.    ELSE
  45.       PRINT "Datensatz paßt nicht auf Suchausdruck"
  46.    END IF
  47. LOOP
  48.  
  49. ' Neues Element im Baum anlegen
  50. SUB Baum_New (Zeiger AS INTEGER)
  51.  
  52.    Zeiger = UBOUND(Baum) + 1
  53.    REDIM PRESERVE Baum(0 TO Zeiger) AS BaumTyp
  54.  
  55. END SUB
  56.  
  57. ' Prüfen, ob eine Bedingung auf einen geg. Datentyp zutrifft
  58. FUNCTION BedingungPasst (Daten AS AdressenTyp, Zeiger AS INTEGER) AS INTEGER
  59.  
  60.    DIM Var AS STRING, Konst AS STRING, VarInhalt AS STRING
  61.    DIM Numerisch AS INTEGER
  62.  
  63.    ' Jeder Baumknoten, der an diese Funktion übergeben
  64.    ' wird, zeigt mit LinkerNachf auf einen Variablennamen,
  65.    ' mit RechterNachf auf eine Konstante, von der wir ggf. die
  66.    ' Anführungszeichen abschneiden:
  67.    Konst = RTRIM$(Baum(Baum(Zeiger).RechterNachf).Operator)
  68.    IF LEFT$(Konst, 1) = CHR$(34) THEN
  69.       Konst = MID$(Konst, 2, LEN(Konst) - 2)
  70.    END IF
  71.    Var = UCASE$(RTRIM$(Baum(Baum(Zeiger).LinkerNachf).Operator))
  72.  
  73.    ' Jetzt wissen wir zwar, wie die Variable heißt, aber an den
  74.    ' Inhalt müssen wir erst noch herankommen:
  75.    ' Am Ende des Artikels wird eine Alternative hierzu be-
  76.    ' schrieben!
  77.    SELECT CASE Var
  78.    CASE "NAME": VarInhalt = RTRIM$(Daten.Name)
  79.    CASE "STRASSE": VarInhalt = RTRIM$(Daten.Strasse)
  80.    CASE "ORT": VarInhalt = RTRIM$(Daten.Ort)
  81.    CASE "BESTELLUNGEN":
  82.       VarInhalt = LTRIM$(STR$(Daten.Bestellungen))
  83.       Numerisch = True
  84.    END SELECT
  85.  
  86.    ' Nun kann die Prüfung stattfinden
  87.    ' Zur Erinnerung: Die Zeile "x = (behauptung)" führt
  88.    ' dazu, dass x TRUE wird, wenn die "behauptung" stimmt
  89.  
  90.    IF NOT Numerisch THEN
  91.       SELECT CASE RTRIM$(Baum(Zeiger).Operator)
  92.       CASE "ENTHAELT"
  93.          BedingungPasst = (INSTR(VarInhalt, Konst) > 0)
  94.       CASE "BEGINNTMIT"
  95.          BedingungPasst = (LEFT$(VarInhalt, LEN(Konst)) = Konst)
  96.       CASE "=" ' geht nur mit ISAM!
  97.          BedingungPasst = (TEXTCOMP(VarInhalt, Konst) = 0)
  98.       CASE "=="
  99.          BedingungPasst = (VarInhalt = Konst)
  100.       CASE ">"
  101.          BedingungPasst = (VarInhalt > Konst)
  102.       CASE "<"
  103.          BedingungPasst = (VarInhalt < Konst)
  104.       END SELECT
  105.    ELSE
  106.       SELECT CASE RTRIM$(Baum(Zeiger).Operator)
  107.       CASE "=", "=="
  108.          BedingungPasst = VAL(VarInhalt) = VAL(Konst)
  109.       CASE ">"
  110.          BedingungPasst = VAL(VarInhalt) > VAL(Konst)
  111.       CASE "<"
  112.          BedingungPasst = VAL(VarInhalt) < VAL(Konst)
  113.       END SELECT
  114.    END IF
  115.  
  116. END FUNCTION
  117.  
  118. ' Neues Element erstellen und "Wort" als Operator eintragen
  119. SUB ErstelleBlatt (Wort AS STRING, Zeiger AS INTEGER)
  120.  
  121.    Baum_New Zeiger
  122.    Baum(Zeiger).Operator = Wort
  123.    Baum(Zeiger).LinkerNachf = 0
  124.    Baum(Zeiger).RechterNachf = 0
  125.  
  126. END SUB
  127.  
  128. ' Baum aus einem Suchausdruck erstellen
  129. SUB Parse (Ausdruck AS STRING, Zeiger AS INTEGER)
  130.  
  131.    REDIM Wort(0 TO 0) AS STRING
  132.  
  133.    ' Erst die umschliessenden Klammern entfernen und in
  134.    ' Wörter teilen:
  135.    TeileWoerter MID$(Ausdruck, 2, LEN(Ausdruck) - 2), Wort()
  136.  
  137.    ' Ein neues Baum-Element erstellen:
  138.    Baum_New Zeiger
  139.  
  140.    SELECT CASE UBOUND(Wort)
  141.    CASE 2
  142.       ' Zwei Wörter - dann ist das linke der Operator
  143.       ' (bislang gibt es nur NICHT):
  144.       Baum(Zeiger).Operator = UCASE$(Wort(1))
  145.       SELECT CASE UCASE$(Wort(1))
  146.       CASE "NICHT"
  147.          Parse Wort(2), Baum(Zeiger).LinkerNachf
  148.       END SELECT
  149.    CASE 3
  150.       ' Drei Wörter - dann ist das mittlere der Operator
  151.       Baum(Zeiger).Operator = UCASE$(Wort(2))
  152.       SELECT CASE UCASE$(Wort(2))
  153.       CASE "UND", "ODER" ' die logischen Operatoren
  154.          Parse Wort(1), Baum(Zeiger).LinkerNachf
  155.          Parse Wort(3), Baum(Zeiger).RechterNachf
  156.       CASE "ENTHAELT", "BEGINNTMIT", "=", "==", ">", "<"
  157.          ErstelleBlatt Wort(1), Baum(Zeiger).LinkerNachf
  158.          ErstelleBlatt Wort(3), Baum(Zeiger).RechterNachf
  159.       END SELECT
  160.    END SELECT
  161.  
  162. END SUB
  163.  
  164. ' Prüfen, ob Datensatz auf Baum paßt
  165. FUNCTION Passt (Daten AS AdressenTyp, Zeiger AS INTEGER) AS INTEGER
  166.  
  167.    ' Zunächst werden die logischen Operatoren geprüft
  168.    ' und die Funktion rekursiv aufgerufen.
  169.  
  170.    SELECT CASE RTRIM$(Baum(Zeiger).Operator)
  171.    CASE "UND"
  172.       Passt = False
  173.       IF Passt(Daten, Baum(Zeiger).LinkerNachf) THEN
  174.          Passt = Passt(Daten, Baum(Zeiger).RechterNachf)
  175.       END IF
  176.    CASE "ODER"
  177.       Passt = True
  178.       IF NOT Passt(Daten, Baum(Zeiger).LinkerNachf) THEN
  179.          Passt = Passt(Daten, Baum(Zeiger).RechterNachf)
  180.       END IF
  181.    CASE "NICHT"
  182.       Passt = NOT Passt(Daten, Baum(Zeiger).LinkerNachf)
  183.    ' Um den Rest soll sich jemand anders kümmern
  184.    ' (nur der Übersichtlichkeit halber!)
  185.    CASE ELSE
  186.       Passt = BedingungPasst(Daten, Zeiger)
  187.    END SELECT
  188.  
  189. END FUNCTION
  190.  
  191. SUB TeileWoerter (Zeile AS STRING, Wort() AS STRING)
  192.  
  193.    ' Eine Zeile wird in ihre Wörter unterteilt. Als "ein Wort" gilt
  194.    ' dabei alles, was in Anführungszeichen oder Klammern steht.
  195.  
  196.    REDIM Wort(0 TO 1) AS STRING
  197.    DIM Zaehler AS INTEGER, i AS INTEGER, AZModus AS INTEGER
  198.    DIM Zeichen AS STRING * 1, Klammer AS INTEGER
  199.    Zaehler = 1
  200.  
  201.    FOR i = 1 TO LEN(Zeile)
  202.       Zeichen = MID$(Zeile, i, 1)
  203.  
  204.       IF Zeichen = CHR$(34) THEN  ' Anführungszeichen
  205.         AZModus = NOT AZModus
  206.       END IF
  207.  
  208.       IF AZModus THEN
  209.          GOSUB Anhaengen ' Zeichen ungeprüft übernehmen
  210.       ELSE
  211.         IF Zeichen = " " AND Klammer = 0 THEN
  212.            IF LEN(Wort(Zaehler)) THEN
  213.               Zaehler = Zaehler + 1
  214.               REDIM PRESERVE Wort(0 TO Zaehler) AS STRING
  215.            END IF
  216.         ELSE
  217.             GOSUB Anhaengen
  218.             SELECT CASE Zeichen
  219.             CASE "(": Klammer = Klammer + 1
  220.             CASE ")": Klammer = Klammer - 1
  221.             END SELECT
  222.         END IF
  223.       END IF
  224.    NEXT
  225.    EXIT SUB
  226.  
  227. Anhaengen:
  228.    Wort(Zaehler) = Wort(Zaehler) + Zeichen
  229.    RETURN
  230.  
  231. END SUB
  232.  
  233.