home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / 1987 / 10 / telefon / telefon.pas < prev   
Encoding:
Pascal/Delphi Source File  |  1987-07-30  |  10.5 KB  |  268 lines
  1. (*$P512*)  (* Fuer MS-DOS I/O gepufferter System-I/O ueber *)
  2.            (* ANSI-Treiber. Siehe Bildschirm-Steuerzeichen *)
  3. (*------------------------------------------------------------*)
  4. (*                      TELEFON.PAS                           *)
  5. (*            Telefon-Datei-Verwaltung mit                    *)
  6. (*          Datenorganisation ueber B-Baeume                  *)
  7. (*------------------------------------------------------------*)
  8.  
  9. PROGRAM Telefon(Input,Output,Datei,Bbaum,FreiSaetze,FreiSeiten);
  10.  
  11. (* In diesem Programm werden die Vorteile einer B-Baum       *)
  12. (* Datenorganisation anhand dem Beispiel einer Telefondatei  *)
  13. (* aufgezeigt.                                               *)
  14. (* Das Programm ist auf allen Pascal-Systemen lauffähig, die *)
  15. (* STRING-Verarbeitung bieten (siehe auch PASCAL 11/87) und  *)
  16. (* weiterhin indizierten Zugriff auf Diskettendateien er-    *)
  17. (* moeglichen. Eventuell muessen die System-spezifischen     *)
  18. (* Routine angepasst werden (seek, filepos, filesize). Das   *)
  19. (* verwendete System beginnt die Zaehlung der Indizes bei 0. *)
  20.  
  21. {$V-} (* Strenge String-Typpruefung VAR-Parametern abschalten *)
  22. {$A+} (* Nichtrekursiver, absoluter Object-Code *)
  23. {$U+} (* Benutzerunterbrechnung erlauben *)
  24.  
  25. CONST phys_datei      = 'telefon.dat'; (* Name Hauptdatei *)
  26.       phys_freisaetze = 'datei.fre';   (* Name freie Daten *)
  27.       phys_bbaum      = 'index.bb';    (* Name Indexdatei *)
  28.       phys_freiseiten = 'index.fre';   (* Name freie Seiten *)
  29.       bt_order = 4;                    (* Ordnungszahl B-Baum *)
  30.       maxanz = 8;                      (* 2*Ordnungszahl *)
  31.       maxanz_1 = 9;                    (* 2*Ordnungzahl+1 *)
  32.       cache_anz = 9;                   (* Groesse des Cache -1 *)
  33.       line_up = #27'[1A';   (* Steuerzeichen "Zeile rauf"   *)
  34.       line_dn = #10;        (* Steuerzeichen "Zeile runter" *)
  35.  
  36. TYPE fileindex = INTEGER;        (* Indextyp,z.B. MS-DOS:REAL *)
  37.      str016 = STRING[016];
  38.      str025 = STRING[025];
  39.      str079 = STRING[079];
  40.      key = str016;               (* Schluessel fuer Indexdatei *)
  41.      ref = RECORD
  42.              stw: key;           (* Verweiszeile in Indexdatei *)
  43.              zeiger: fileindex
  44.             END;
  45.      (* Seite im Bayer-Baum *)
  46.      Page = RECORD
  47.               vg: fileindex;               (* Vorgaenger *)
  48.               anz: INTEGER;                (* belegte Anzahl *)
  49.               info: ARRAY[1..maxanz]OF ref;(* Verweise *)
  50.               nf: ARRAY[0..maxanz] OF fileindex;
  51.             END;                           (* Folgeseiten *)
  52.      (* Ueberlaufseite *)
  53.      bigpage = RECORD
  54.                  vg: fileindex;
  55.                  info: ARRAY[1..maxanz_1] OF ref;
  56.                  nf: ARRAY[0..maxanz_1]OF fileindex
  57.                END;
  58.      (* Datensatz der Hauptdatei *)
  59.      rec = RECORD
  60.              stw: key;
  61.              Name,Vorname,Tel: str079
  62.            END;
  63.      indexfile = FILE OF fileindex;
  64.      (* >> Typ fuer das Bayer-Baum-Modul << *)
  65.      delta = -1..1;
  66.  
  67. VAR Datei: FILE OF rec;               (* Hauptdatei *)
  68.     Bbaum: FILE OF Page;              (* Indexdatei als B-Baum *)
  69.     FreiSaetze, FreiSeiten: indexfile;(* Freie Datensaetze *)
  70.     Wahl: CHAR;
  71.     Name, NrStr : str079;
  72.     datensatz: rec;
  73.     vorhanden: BOOLEAN;
  74.     (* >> Variable fuer das Cache-Modul << *)
  75.     cache: ARRAY[0..cache_anz] OF RECORD
  76.                                     snr, stat: INTEGER;
  77.                                     seite: Page;
  78.                                     update: BOOLEAN
  79.                                   END;
  80. (*------------------------------------------------------------*)
  81. (*                    Fehlermeldung ausgeben                  *)
  82. PROCEDURE fehler(erkl: str079);
  83. BEGIN
  84.   WriteLn;  WriteLn('Fehler: ', erkl)
  85. END;
  86. (*------------------------------------------------------------*)
  87. (*                    Auf RETURN warten                       *)
  88. PROCEDURE WaitKey;
  89. BEGIN
  90.   Write(' ! <RETURN> druecken ! '); ReadLn;
  91. END;
  92. (*------------------------------------------------------------*)
  93. (*       Gibt Zeichenkette OHNE erstes Zeichen zurueck        *)
  94. FUNCTION butfirst(zk: str079): str079;
  95. BEGIN
  96.   IF Length(zk)>1 THEN butfirst := Copy(zk, 2, Pred(Length(zk)))
  97.   ELSE butfirst := ''
  98. END;
  99. (*-------------------------------------------------------------------------*)
  100. (*            Ausgabe eines Hauptdatensatzes auf dem Bildschirm,           *)
  101. (*                        an Datenform anpassen!                           *)
  102. PROCEDURE write_rec(VAR datensatz: rec);
  103. BEGIN
  104.   WriteLn;
  105.   WriteLn('========================================================');
  106.   WriteLn;  WriteLn(' Schluessel: ', datensatz.stw);
  107.   WriteLn(' ------------------------------------------------------ ');
  108.   WriteLn('       Name: ',datensatz.Name);
  109.   WriteLn('    Vorname: ',datensatz.Vorname);
  110.   WriteLn(' Telef.-Nr.: ',datensatz.Tel);
  111.   WriteLn('========================================================');
  112.   WriteLn;
  113. END;
  114. (*-------------------------------------------------------------*)
  115. (*    Einlesen eines Hauptdatensatzes von der Console, an      *)
  116. (*                  Datenform anpassen!                        *)
  117. PROCEDURE read_rec(VAR datensatz: rec);
  118. BEGIN
  119.   WITH datensatz DO BEGIN
  120.     Name := '';
  121.     REPEAT
  122.       Write('       Name: '); ReadLn(Name)
  123.     UNTIL Length(Name) <> 0;
  124.     Write('    Vorname: '); ReadLn(Vorname);
  125.     Write(' Telef.-Nr.: '); ReadLn(Tel);
  126.     datensatz.stw := Name;
  127.   END
  128. END;
  129.  
  130. (*$I cache.inc  *)  (* Cache-Modul fuer Modul Bayer-Baum laden *)
  131. (*$I bbacc.inc  *)  (* Bayer-Baum Modul laden *)
  132.  
  133. (*-------------------------------------------------------------*)
  134. (* Ausgabe einer Seite des Bayer-Baumes. So kann der inter-    *)
  135. (* essierte Benutzer die Vorgaenge beim Speichern und Loeschen *)
  136. (*                       verfolgen.                            *)
  137. PROCEDURE zeige_seite(seiten_nr_str: str016);
  138.  
  139. VAR seite: Page;
  140.     seiten_nr: fileindex;
  141.     dummy: INTEGER;
  142.  
  143. BEGIN
  144.   Val(seiten_nr_str, seiten_nr, dummy);
  145.   IF (abs(seiten_nr)<FileSize(Bbaum)) AND (dummy=0) THEN BEGIN
  146.     get_page(seiten_nr, seite);
  147.     write_page(seiten_nr, seite)
  148.   END
  149.   ELSE IF (dummy>0) OR (seiten_nr<0) THEN
  150.          fehler(seiten_nr_str+' ist keine Zahl')
  151.   ELSE fehler('Seite existiert nicht')
  152. END;
  153.  
  154. BEGIN  (* Hauptprogramm *)
  155.   ClrScr; (* Bildschirm loeschen, Cursor nach links oben *)
  156.   WriteLn('              >>>> TELEFON-DAT <<<<');
  157.   WriteLn;
  158.   WriteLn('                 ***         ***');
  159.   WriteLn('               ******************* ');
  160.   WriteLn('              **********************');
  161.   WriteLn('             *****   **    **   *****');
  162.   WriteLn('                     **    **        ');
  163.   WriteLn('                   ************      ');
  164.   WriteLn('                 ******* ********    ');
  165.   WriteLn('               ****** 0561/ *******  ');
  166.   WriteLn('              ******  8702   ******* ');
  167.   WriteLn('             ********       ********* ');
  168.   WriteLn('            *** Dienstag 17-20 Uhr ***');
  169.   WriteLn('            **************************');
  170.   WriteLn('            ***  PASCAL - HOTLINE  ***');
  171.   WriteLn; WriteLn; WriteLn;
  172.   Write(' Schnelle Telefondatei mit ');
  173.   WriteLn('B-Baum-strukturierter Indexdatei ');
  174.   WriteLn;
  175.   Write(' (C) Copyright 1987 by ');
  176.   WriteLn('PASCAL INTERNATIONAL & Michael Hoennig');
  177.   WriteLn; WriteLn;
  178.   Write('Schon vorhandene Telefon-Datei erweitern ? (j,n): ');
  179.   REPEAT ReadLn(Wahl) UNTIL Wahl IN ['j','J','n','N'];
  180.   Assign(Datei, phys_datei);
  181.   Assign(FreiSaetze, phys_freisaetze);
  182.   Assign(Bbaum, phys_bbaum);
  183.   Assign(FreiSeiten, phys_freiseiten);
  184.   IF Wahl IN ['n','N'] THEN create;
  185.   access(TRUE);
  186.   REPEAT
  187.     ClrScr;  (* Bildschirm loeschen, Cursor nach links oben *);
  188.     WriteLn('        ************  DAS HAUPTMENUE  ***************');
  189.     WriteLn; WriteLn; WriteLn;
  190.     WriteLn(' Datensatz einfuegen ............... + '); WriteLn;
  191.     WriteLn(' Datensatz loeschen ................ - '); WriteLn;
  192.     WriteLn(' Datensatz suchen .................. ? '); WriteLn;
  193.     WriteLn(' Datensatz aendern ................. / '); WriteLn;
  194.     WriteLn(' Ende & Abspeichern ................ * '); WriteLn;
  195.     WriteLn;
  196.     WriteLn('Sonderfunktion Seitenanzeige ....... # '); WriteLn;
  197.     WriteLn; WriteLn;
  198.     Write(' Ihre Wahl: ');
  199.     ReadLn(Wahl);
  200.     CASE Wahl OF
  201.       '+': BEGIN
  202.              ClrScr;
  203.              WriteLn('##### Datensatz Eingeben #####');
  204.              WriteLn;  WriteLn;  WriteLn;
  205.              read_rec(datensatz);
  206.              insert_rec(datensatz, vorhanden);
  207.              IF vorhanden THEN BEGIN
  208.                fehler('Schluessel ist schon vorhanden');
  209.                WriteLn; WaitKey;
  210.              END;
  211.            END;
  212.       '-': BEGIN
  213.              ClrScr;
  214.              WriteLn('###### Datensatz Loeschen ######');
  215.              WriteLn;  WriteLn;  WriteLn;
  216.              Write(' Name: ');  ReadLn(Name);  WriteLn;
  217.              delete_rec(Name, vorhanden);  WriteLn;
  218.              IF NOT(vorhanden) THEN
  219.                fehler('Schluessel ist nicht vorhanden');
  220.              WriteLn; WaitKey;
  221.            END;
  222.       '?': BEGIN
  223.              ClrScr;
  224.              WriteLn('###### Datensatz Suchen ######');
  225.              WriteLn;  WriteLn;  WriteLn;
  226.              Write(' Name: ');  ReadLn(Name);  WriteLn;
  227.              search_rec(Name, vorhanden); WriteLn; WriteLn;
  228.              IF NOT(vorhanden) THEN
  229.                fehler('Schluessel ist nicht vorhanden');
  230.              WriteLn; WaitKey;
  231.            END;
  232.       '/': BEGIN
  233.              ClrScr;
  234.              WriteLn('###### Datensatz Aendern ######');
  235.              WriteLn;  WriteLn;  WriteLn;
  236.              Write(' Name: ');  ReadLn(Name);
  237.              search_rec(Name, vorhanden);
  238.              IF NOT(vorhanden) THEN BEGIN
  239.                fehler('Schluessel ist nicht vorhanden');
  240.                WriteLn; WaitKey;
  241.              END
  242.              ELSE BEGIN
  243.                WriteLn('---- Geaenderten Satz eintragen ----');
  244.                WriteLn;
  245.                read_rec(datensatz);
  246.                delete_rec(Name,vorhanden);
  247.                insert_rec(datensatz,vorhanden);
  248.              END;
  249.            END;
  250.       '#': BEGIN
  251.              ClrScr;
  252.              WriteLn('##### SONDERFUNKTION: Seite Anzeigen #####');
  253.              WriteLn;  WriteLn;  WriteLn;
  254.              Write(' Seiten-Nr.: ');  ReadLn(NrStr);
  255.              zeige_seite(NrStr);  WriteLn;  WriteLn;
  256.              WaitKey;
  257.            END;
  258.       '*': ;
  259.        ELSE ; (* Leeres Statement f. 'sauberen' Programmablauf *)
  260.     END;
  261.   UNTIL Wahl='*';
  262.   access(FALSE)
  263. END.
  264.  
  265.  
  266.  
  267.  
  268.