home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / pascal / library / dos / database / unitdb / db_box.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1993-07-27  |  12.4 KB  |  326 lines
  1. (* ------------------------------------------------------ *)
  2. (*                      dB_BOX.PAS                        *)
  3. (*    objektorientierte dBase III / IV - Schnittstelle    *)
  4. (*                (c) 1992 Helmut Klüber                  *)
  5. (* ------------------------------------------------------ *)
  6.  
  7. {$N+} {$E+}
  8.  
  9. {$IFDEF VER60}
  10. UNIT dB_BOX60;
  11. {$ELSE}
  12. UNIT dB_BOX55;
  13. {$ENDIF}
  14.  
  15. INTERFACE
  16.  
  17. USES Dos, CRT;
  18.  
  19. CONST
  20.   FeldNrMax             = 128;   (* max. Anzahl der       *)
  21.                                  (* Felder in einer Datei *)
  22.   MaxDatabases          = 15;    (* max. Anzahl geöff-    *)
  23.                                  (* neter Datenbanken     *)
  24.   dBok                  = 0;     (* d.h. kein Fehler      *)
  25.   PufferLaenge: Word = $FFFE;    (* max. Pufferlänge      *)
  26.   CarryOn:      Boolean = FALSE; (* Default-Wert          *)
  27.   DeletedOn:    Boolean = FALSE; (* Default-Wert          *)
  28.   FieldsOn:     Boolean = FALSE; (* Default-Wert          *)
  29.   ExactOn:      Boolean = FALSE; (* Default-Wert          *)
  30.   Kontrolle:    Word    = 0;     (* I/O-Kontrolle, bisher *)
  31.                                  (* nicht abgefragt       *)
  32.   Error:        Integer = dBok;  (* FehlerCode            *)
  33.  
  34. (* Error:  Bedeutung:                                     *)
  35. (* ------------------------------------------------------ *)
  36. (*    0    kein Fehler  (dBok = 0)                        *)
  37. (*   -1    Feld mit dem angegebenen Namen existiert nicht *)
  38. (*   -2    Feld mit der angegebenen Nr. existiert nicht   *)
  39. (*   -3    dBase-Datei enthält keine Datensätze           *)
  40. (*   -4    dBase-Datei enthält keine Felder               *)
  41. (*   -5    Datensatz-Nummer nicht im gültigen Bereich     *)
  42. (*   -6    Datei nicht leer bei Hinzufügen von Feldern    *)
  43. (*   -7    keine dBase-Datei, dBase-Kennung falsch        *)
  44. (*   -8    keine dBase-Datei, mehr als FeldNrMax Felder   *)
  45. (*   -9    keine dBase-Datei,                             *)
  46. (*         Header-Ende-Kennung $0D fehlt                  *)
  47. (*  -10    Feld mit dem angegebenen Namen existiert nicht *)
  48. (*  -11    zu viele Datenbanken geöffnet                  *)
  49. (*  -12    Datenbank bereits geschlossen                  *)
  50. (*  -13    Datenbank war nicht geöffnet oder ist bereits  *)
  51. (*         wieder geschlossen                             *)
  52. (*  -14    Datenfeld nicht vom Typ "N" oder "F"           *)
  53. (*  -15    Datenbankname fehlt                            *)
  54. (*  -16    Indexdatei wurde nicht gefunden                *)
  55.  
  56. TYPE
  57.  
  58.   String8  = String[8];
  59.   String10 = String[10];
  60.   CharPtr  = ^Char;
  61.  
  62.   Header = RECORD
  63.     Version:     Byte;
  64.     Jahr:        Byte;
  65.     Monat:       Byte;
  66.     Tag:         Byte;
  67.     AnzSaetze:   LongInt;
  68.     LenVorspann: Word;
  69.     LenSatz:     Word;
  70.     Dummy1:      Array[13..14] of Byte;
  71.     Transaktion: Boolean;
  72.     Schluessel:  Boolean;
  73.     Dummy2:      Array[17..28] of Byte;
  74.     Mdx:         Boolean;
  75.     Dummy3:      Array[30..32] of Byte;
  76.   END;
  77.  
  78.   FeldInfo = RECORD
  79.     FeldName:    Array[1..10] of Char;
  80.                           (* bei <10 Zeichen Ende mit $00 *)
  81.     Dummy1:      Byte;    (* immer = $00 als Stringende   *)
  82.     FeldTyp:     Char;
  83.     Adresse:     Pointer; (* Zeiger auf Feld im Speicher  *)
  84.     LenFeld:     Byte;
  85.     AnzDez:      Byte;    (* Anzahl Dezimalstellen        *)
  86.     Dummy2:      Array[19..20] of Byte;
  87.     ArbBerID:    Byte;    (* Nr. des Arbeitsbereiches     *)
  88.     Dummy3:      Array[22..23] of Byte;
  89.     SetFieldsID: Boolean; (* mit SetFields gesetztes Flag *)
  90.     Dummy4:      Array[25..31] of Byte;
  91.     MDXFlag:     Boolean; (* Flag für Mehrfachindices     *)
  92.     FeldName1:   String[10];(* wie FeldName,aber als String *)
  93.   END;
  94.  
  95.   Puffer = Array[$0000..$FFFE] OF Char;
  96.  
  97.   dB = object
  98.     AnzFelder:         Byte;
  99.                     (* Anzahl der Felder je Datensatz     *)
  100.     dB3:               Boolean;
  101.                     (* lesbar durch dBase III ?           *)
  102.     dB4:               Boolean;
  103.                     (* lesbar durch dBase III ?           *)
  104.     ContainsMemo:      Boolean;
  105.                     (* Memodatei vorhanden ?              *)
  106.     h:                 ^Header;
  107.                     (* Datei-Header                       *)
  108.     f:                 Array[1..FeldNrMax] of ^FeldInfo;
  109.                     (* enthält Zeiger auf                 *)
  110.                     (* Feldbeschreibungen                 *)
  111.     Deleted:           Boolean;
  112.                     (* aktueller Datensatz als gelöscht   *)
  113.                     (* markiert ?                         *)
  114.  
  115.     FUNCTION  FieldNo(Name:String): Byte;
  116.                     (* liefert lfd. Nr. zum Feld Name     *)
  117.  
  118.     FUNCTION  GetbyNr(Nr: Byte): String;
  119.                     (* liefert Inhalt des Feldes Nr. Nr   *)
  120.  
  121.     PROCEDURE GetbyNrT(Nr: Byte; Var x);
  122.                     (* liefert Inhalt des Feldes Nr. Nr   *)
  123.                     (* im Turbo-Pascal-Format             *)
  124.  
  125.     PROCEDURE ReplacebyNr(Nr: Byte; Eingabe: String);
  126.                     (* ändert Inhalt des Feldes Nr. Nr    *)
  127.  
  128.     PROCEDURE ReplacebyNrT(Nr: Byte; VAR Eingabe);
  129.                     (* ändert Inhalt des Feldes Nr. Nr,   *)
  130.                     (* Eingabe im Turbo-Pascal-Format     *)
  131.  
  132.     PROCEDURE Next; (* zum nächsten Datensatz gehen       *)
  133.  
  134.     PROCEDURE Prev; (* zum vorhergehenden Datensatz       *)
  135.                     (* gehen                              *)
  136.  
  137.     FUNCTION  EoF: Boolean;
  138.                     (* TRUE, wenn Dateiende erreicht      *)
  139.  
  140.     FUNCTION  BoF: Boolean;
  141.                     (* TRUE, wenn vor 1. Datensatz        *)
  142.  
  143.     PROCEDURE Skip(Anzahl: LongInt);
  144.                     (* um Anzahl Datensätze weitergehen   *)
  145.  
  146.     PROCEDURE GoTop;
  147.                     (* zum 1. Datensatz gehen             *)
  148.  
  149.     PROCEDURE GoBottom;
  150.                     (* zum letzten Datensatz gehen        *)
  151.  
  152.     PROCEDURE Go(RecNr:LongInt);
  153.                     (* zu Datensatz mit der Nr. RecNr     *)
  154.                     (* gehen                              *)
  155.  
  156.     PROCEDURE Use(DName: PathStr);
  157.                     (* Datei öffnen                       *)
  158.  
  159.     PROCEDURE CloseDbf;
  160.                     (* Datei schliessen                   *)
  161.  
  162.     PROCEDURE Delete;
  163.                     (* aktuellen Datensatz als gelöscht   *)
  164.                     (* markieren                          *)
  165.  
  166.     PROCEDURE Recall;
  167.                     (* Löschmarkierung bei aktuellem      *)
  168.                     (* Datensatz entfernen                *)
  169.  
  170.     PROCEDURE RecallAll;
  171.                     (* Löschmarkierung bei allen Daten-   *)
  172.                     (* sätzen entfernen                   *)
  173.  
  174.     PROCEDURE AppendBlank;
  175.                     (* einen Datensatz am Ende der Datei  *)
  176.                     (* anfügen                            *)
  177.  
  178.     PROCEDURE Create(DName: PathStr);
  179.                     (* leere Datei, ohne Datenfelder      *)
  180.                     (* anlegen                            *)
  181.  
  182.     PROCEDURE AddField(FName: String; FTyp: Char;
  183.                       FLen, FDec: Byte);
  184.                     (* Ein Datenfeld zu leerer Datei      *)
  185.                     (* hinzufügen                         *)
  186.  
  187.     PROCEDURE Flush;
  188.                     (* Puffer sichern                     *)
  189.  
  190.     FUNCTION  RecNo: LongInt;
  191.                     (* liefert aktuelle Datensatz-Nummer  *)
  192.  
  193.     FUNCTION  RecSize: LongInt;
  194.                     (* bestimmt die Länge eines Daten-    *)
  195.                     (* satzes, incl. Löschkennzeichen     *)
  196.  
  197.     FUNCTION  RecCount: LongInt;
  198.                     (* liefert Anzahl der Datensätze,     *)
  199.                     (* incl. der gelöschten Datensätze    *)
  200.  
  201.     FUNCTION  Dbf: PathStr;
  202.                     (* liefert den Dateinamen             *)
  203.  
  204.     FUNCTION  FieldName(Nr: Byte): String10;
  205.                     (* liefert den Namen des Datenfeldes  *)
  206.                     (* Nummer Nr                          *)
  207.  
  208.     PROCEDURE Replace(Name: String; Eingabe: String);
  209.                     (* ersetzt den Inhalt des Datenfeldes *)
  210.                     (* Name durch den String Eingabe      *)
  211.  
  212.     PROCEDURE ReplaceT(Name: String; VAR Eingabe);
  213.                     (* ersetzt den Inhalt des Datenfeldes *)
  214.                     (* Name durch den String Eingabe      *)
  215.  
  216.     FUNCTION  Get(Name: String): String;
  217.                     (* liefert Inhalt des Feldes Name     *)
  218.  
  219.     PROCEDURE GetT(Name: String; Var x);
  220.                     (* liefert Inhalt des Feldes Name     *)
  221.                     (* im Turbo-Pascal-Format             *)
  222.  
  223.     FUNCTION  Count: LongInt;
  224.                     (* liefert die Anzahl der nicht       *)
  225.                     (* gelöschten Datensätze              *)
  226.  
  227.     FUNCTION  Sum(FNr: Byte): Real;
  228.                     (* summiert numerische Felder         *)
  229.  
  230.     PROCEDURE Zap;  (* markierte Sätze löschen            *)
  231.  
  232.     PROCEDURE Pack; (* löscht alle markierten Sätze       *)
  233.  
  234.     PROCEDURE CopyStruExteTo(DName: PathStr);
  235.                     (* legt eine Datei mit den Struktur-  *)
  236.                     (* informationen der Datenbank an,    *)
  237.                     (* funktioniert wie der dBase-Befehl  *)
  238.                     (* Copy Structure Extended            *)
  239.  
  240.     PROCEDURE CopyStruTo(DName: PathStr);
  241.                     (* legt eine leere Datei mit der      *)
  242.                     (* gleichen Struktur wie die Daten-   *)
  243.                     (* bank an, funktioniert wie der      *)
  244.                     (* dBase-Befehl Copy Structure        *)
  245.  
  246.     PROCEDURE CopyTo(DName: PathStr);
  247.                     (* kopiert eine Datei, funktioniert   *)
  248.                     (* wie der dBase-Befehl Copy          *)
  249.  
  250.     FUNCTION FileSizeDbf: LongInt;
  251.                     (* bestimmt die Anzahl der Sätze in   *)
  252.                     (* der Datei                          *)
  253.  
  254.     PROCEDURE FieldInform(FeldName: String; VAR LfdNr: Byte;
  255.                           VAR FTyp: Char;
  256.                           VAR Laenge, Stellen: Byte);
  257.                     (* ermittelt Informationen zum Daten- *)
  258.                     (* feld FeldName                      *)
  259.  
  260.     PROCEDURE Inform(VAR FileName: PathStr; VAR MaxFieldNo: Byte;
  261.                      VAR SatzLaenge: Word; VAR Datum: String8);
  262.                     (* ermittelt wichtige Informationen   *)
  263.                     (* über die Datei                     *)
  264.  
  265.     FUNCTION Locate(FeldName: String; VAR Schluessel): Boolean;
  266.                     (* sucht ab der aktuellen Position    *)
  267.                     (* den Satz, bei dem der Schlüssel    *)
  268.                     (* mit dem Inhalt des Feldes FeldName *)
  269.                     (* übereinstimmt                      *)
  270.  
  271.     PROCEDURE CopybyNDX(NDXName, ToName: Pathstr);
  272.                     (* kopiert den Inhalt der Datenbank   *)
  273.                     (* in die Datei ToName unter Berück-  *)
  274.                     (* sichtigung der Sortierung gemäß    *)
  275.                     (* der dBase-Index-Datei NDX-Name und *)
  276.                     (* unter Beachtung von DeletedOn      *)
  277.  
  278.     PROCEDURE CopybyNTX(NTXName, ToName: PathStr);
  279.                     (* kopiert den Inhalt der Datenbank   *)
  280.                     (* in die Datei ToName unter Berück-  *)
  281.                     (* sichtigung der Sortierung gemäß    *)
  282.                     (* der Clipper-Index-Datei NDX-Name   *)
  283.                     (* und unter Beachtung von DeletedOn  *)
  284.  
  285.   END;
  286.  
  287.   PROCEDURE SetBuf(Size: Word);
  288.                     (* setzt die aktuelle Größe des       *)
  289.                     (* internen Ein-/Ausgabepuffers       *)
  290.  
  291.   FUNCTION GetBuf: Word;
  292.                     (* emittelt die aktuelle Größe des    *)
  293.                     (* internen Ein-/Ausgabepuffers       *)
  294.  
  295.   FUNCTION IIF(Ausdruck: Boolean; Stri1, Stri2: String)
  296.               : String;
  297.  
  298.   FUNCTION Left(s: String; N: Integer): String;
  299.  
  300.   FUNCTION Len(s: String): Integer;
  301.  
  302.   FUNCTION Log(x: Real): Real;
  303.  
  304.   FUNCTION LTrim(s: String): String;
  305.  
  306.   FUNCTION Right(s: String; N: Integer): String;
  307.  
  308.   FUNCTION RTrim(s: String): String;
  309.  
  310.   FUNCTION Trim(s: String): String;
  311.  
  312.   FUNCTION Space(N: Byte): String;
  313.                     (* liefert einen String mit N Blanks  *)
  314.  
  315.   FUNCTION Exists(DateiName : PathStr) : Boolean;
  316.  
  317.   FUNCTION GetKeyNDX(NDXName: PathStr): String;
  318.  
  319.   FUNCTION GetKeyNTX(NTXName: PathStr): String;
  320.  
  321.   FUNCTION ErrorText: String;
  322.                     (* Ermittelt Fehlernachricht          *)
  323.  
  324. IMPLEMENTATION
  325.  
  326. END.