home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / qpdemo / beispiel / adresse.pas next >
Encoding:
Pascal/Delphi Source File  |  1989-08-24  |  3.3 KB  |  158 lines
  1.  
  2. PROGRAM Adressdatei;
  3.  
  4. USES Crt;
  5.  
  6. CONST Maxn = 40;
  7.  
  8. TYPE    Setofchar  = SET OF Char;
  9.     Kurzstring = String [20];
  10.     Adresse    = RECORD
  11.        Test : Boolean;
  12.        Name, Vorname, Strasse : Kurzstring;
  13.        PLZ : Integer;
  14.        Ort, Tel :Kurzstring
  15.     END; { Adresse }
  16.     Filetyp    = FILE OF Adresse;
  17.  
  18. VAR   Person     : ARRAY [1..Maxn] OF Adresse;
  19.       Leer       : Kurzstring;
  20.       Datei      : Filetyp;
  21.       Dateiname  : String [15];
  22.       ch         : Char;
  23.       Anzahl, Nr, i, k : Integer;
  24.       J, JN, N   : SET OF Char;
  25.  
  26. FUNCTION Lieszeichen (m : Setofchar) : Char;
  27. VAR ch : Char;
  28.    OK : Boolean;
  29. BEGIN
  30.  REPEAT
  31.   ch:=ReadKey;                         { Lies Zeichen ohne Echo }
  32.    OK := ch IN m;
  33.   IF NOT OK THEN Write (Chr(7))        { Bell }
  34.      ELSE IF ch IN [' '..Chr(126)] { druckbare Zeichen }
  35.            THEN Write (ch)
  36.   UNTIL OK;
  37.  Lieszeichen := ch
  38. END; { von Lieszeichen }
  39.  
  40. PROCEDURE Lesen (N : Integer; VAR Satz : Adresse);
  41. BEGIN
  42.  {folgt noch}
  43. END;
  44.  
  45. PROCEDURE Schreiben (N : Integer; Satz : Adresse);
  46. BEGIN
  47.  {folgt noch}
  48. END;
  49.  
  50. PROCEDURE Veraendern;
  51. BEGIN
  52.  {folgt noch}
  53. END;
  54.  
  55. PROCEDURE Loeschen;
  56. BEGIN
  57.  {folgt noch}
  58. END;
  59.  
  60. PROCEDURE Alphasort;
  61. BEGIN
  62.  {folgt noch}
  63. END;
  64.  
  65. PROCEDURE Drucken;
  66.  BEGIN
  67.  { Übung }
  68.  END;
  69.  
  70. PROCEDURE Suchen;
  71.  BEGIN
  72.  { Übung }
  73.  END;
  74.  
  75.  
  76. PROCEDURE Menu;
  77. VAR Frage : Char;
  78. BEGIN
  79.  REPEAT
  80.       ClrScr;
  81.       Writeln; Writeln;
  82.       Writeln ('Die Datei hat ', Anzahl:3);
  83.       Writeln ('tatsächliche Elemente.');
  84.       Writeln; Writeln ('Wählen Sie:');
  85.   Writeln; Writeln;
  86.   Writeln ('  V (erändern von Daten  ');
  87.   Writeln ('  L (öschen von Daten    ');
  88.   Writeln ('  A (lphabetisch Ordnen   ');
  89.   Writeln ('  D (rucken der Datei     ');
  90.   Writeln ('  S (uchen nach Kriterien ');
  91.   Writeln;
  92.   Writeln ('  Z (um Schluss           ');
  93.  Frage:=Lieszeichen(['V','v','L','l','A','a','D','d',
  94.          'S','s','Z','z']);
  95.   CASE Frage OF
  96.    'V','v' : Veraendern;
  97.    'L','l' : Loeschen;
  98.    'A','a' : Alphasort;
  99.    'D','d' : Drucken;
  100.    'S','s' : Suchen
  101.   END { case }
  102.  UNTIL Frage IN ['Z','z']
  103. END; { von Menu }
  104.  
  105. PROCEDURE Start;
  106. LABEL Exit1;
  107. VAR Satz : Adresse;
  108.  
  109. PROCEDURE Neu;
  110.  BEGIN   { von Neu }
  111.   Leer:='                    ';      { 20 mal Leer }
  112.   Assign(Datei,Dateiname);
  113.   Rewrite (Datei);
  114.   FOR i:=1 TO Maxn DO BEGIN
  115.    WITH Person [i] DO BEGIN          { leere Datei erzeugen }
  116.    Test := False; Name := Leer; Vorname := Leer;
  117.    Ort := Leer; PLZ := 0; Strasse := Leer; Tel := Leer
  118.    END; { With }
  119.    Write(Datei,Person [i]);
  120.   END; { for }
  121.   Close (Datei)
  122.  END; { von Neu }
  123.  
  124. BEGIN  { von Start }
  125.  Anzahl := 0;  { noch keine Datei }
  126.  Writeln; Writeln;
  127.  Write ('Eingabe des Dateinamens: '); Readln (Dateiname);
  128.  Assign(Datei, Dateiname);
  129.  {$I-}Reset(Datei); {$I+}
  130.  IF IOResult <> 0 THEN BEGIN
  131.   Writeln ('Datei existiert nicht! ');
  132.   Write ('Wollen Sie eine neue Datei (J/N) ?');
  133.   ch := Lieszeichen (JN);
  134.   IF ch IN J THEN Neu ELSE GOTO Exit1
  135.  END; { von if }
  136. Reset(Datei);
  137.  FOR i:=0 TO Maxn-1 DO BEGIN
  138.   Seek(Datei,i);
  139.   Read(Datei,Satz);
  140.   IF Satz.Test THEN Anzahl := Anzahl +1
  141.  END; { von for }
  142.  Menu;
  143.  Close (Datei);
  144.  Exit1:
  145. END; { von Start }
  146.  
  147.  
  148. BEGIN { Hauptprogramm }
  149.  J  := ['J','j'];
  150.  N  := ['N','n'];
  151.  JN := ['J','j','N','n'];
  152.  ClrScr;
  153.  Start;
  154.  ClrScr;
  155.  Writeln ('Das wars...')
  156. END.
  157.  
  158.