home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / 1990 / 09 / tricks / isamdemo.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1990-06-15  |  4.7 KB  |  184 lines
  1. (* ------------------------------------------------------ *)
  2. (*                     ISAMDEMO.PAS                       *)
  3. (*               Demoprogramm zur ISAM-Unit               *)
  4. (*           (c) 1990 Karlheinz Büker & TOOLBOX           *)
  5. (* ------------------------------------------------------ *)
  6. PROGRAM IsamTree_Demo;
  7.  
  8. USES  Crt, IsamTree;
  9.  
  10. CONST Ende : BOOLEAN = FALSE;
  11.  
  12. VAR   D : DataType;
  13.  
  14. {-----------------------------------------}
  15. PROCEDURE Maske(Name : STRING);
  16. BEGIN
  17.   ClrScr; GotoXY(20, 1); WriteLn(Name);
  18.   WriteLn;
  19.   WriteLn('    Name         : ');
  20.   WriteLn('    Vorname      : ');
  21.   WriteLn('    Postleitzahl : ');
  22.   WriteLn('    Ort          : ');
  23.   WriteLn('    Strasse      : ');
  24. END;
  25. {-----------------------------------------}
  26. PROCEDURE GetOB;
  27. BEGIN
  28.   REPEAT
  29.     GotoXY(20, 3); ReadLn(D.OB);
  30.   UNTIL D.OB <> '';
  31. END;
  32. {-----------------------------------------}
  33. PROCEDURE anlegen;
  34. BEGIN
  35.   Maske('Satz erfassen');
  36.   GetOB;
  37.   REPEAT
  38.     GotoXY(20, 4); ReadLn(D.Vorname);
  39.   UNTIL D.Vorname <> '';
  40.   REPEAT
  41.     GotoXY(20, 5); ReadLn(D.Plz);
  42.     UNTIL (D.Plz>=1000) AND (D.Plz<9000);
  43.   REPEAT
  44.     GotoXY(20, 6); ReadLn(D.Ort);
  45.   UNTIL D.Ort <> '';
  46.   REPEAT
  47.     GotoXY(20, 7); ReadLn(D.Str);
  48.   UNTIL D.Str <> '';
  49.   AddRecord(D);
  50. END;
  51. {-----------------------------------------}
  52. PROCEDURE aendern;
  53. VAR YN  : CHAR;
  54.     Ref : WORD;
  55. BEGIN
  56.   Maske('Satz aendern');
  57.   GetOB; GetRecord(D.OB, D, Ref);
  58.   IF IsamError <> 0 THEN
  59.   BEGIN
  60.     GotoXY(10, 25);
  61.     Write('Satz nicht gefunden'#7);
  62.     Delay(1000); Exit;
  63.   END;
  64.   GotoXY(20, 4); Write(D.Vorname); ClrEol;
  65.   GotoXY(20, 5); Write(D.Plz); ClrEol;
  66.   GotoXY(20, 6); Write(D.Ort); ClrEol;
  67.   GotoXY(20, 7); Write(D.Str); ClrEol;
  68.   REPEAT
  69.     GotoXY(20, 20);
  70.     Write('Diesen Satz ändern? (J/N) ');
  71.     ReadLn(YN);
  72.   UNTIL (UpCase(YN)='J')OR(UpCase(YN)='N');
  73.   IF UpCase(YN) = 'N' THEN Exit;
  74.   DelRecord(D.OB, Ref);
  75.   GetOB;
  76.   REPEAT
  77.     GotoXY(20, 4); ReadLn(D.Vorname);
  78.   UNTIL D.Vorname <> '';
  79.   REPEAT
  80.     GotoXY(20, 5); ReadLn(D.Plz);
  81.     UNTIL (D.PLZ>=1000) AND (D.PLZ<9000);
  82.   REPEAT
  83.     GotoXY(20, 6); ReadLn(D.ort);
  84.   UNTIL D.Ort <> '';
  85.   REPEAT
  86.     GotoXY(20, 7); ReadLn(D.Str);
  87.   UNTIL D.Str <> '';
  88.   AddRecord(D);
  89. END;
  90. {-----------------------------------------}
  91. PROCEDURE Loeschen;
  92. VAR YN  : CHAR;
  93.     Ref : WORD;
  94. BEGIN
  95.   Maske ('Satz löschen');
  96.   GetOB; GetRecord(D.OB, D, Ref);
  97.   IF IsamError <> 0 THEN
  98.   BEGIN
  99.     GotoXY(10, 25);
  100.     Write('Satz nicht gefunden'#7#7#7);
  101.     Delay(1000); Exit;
  102.   END;
  103.   GotoXY(20, 4); Write(D.Vorname); ClrEol;
  104.   GotoXY(20, 5); Write(D.Plz); ClrEol;
  105.   GotoXY(20, 6); Write(D.ort); ClrEol;
  106.   GotoXY(20, 7); Write(D.Str); ClrEol;
  107.   REPEAT
  108.     GotoXY(20, 20);
  109.     Write('Diesen Satz löschen ? (J/N) ');
  110.     ReadLn(YN);
  111.   UNTIL(UpCase(YN)='J')OR(UpCase(YN)='N');
  112.   IF UpCase(YN) = 'N' THEN Exit;
  113.   DelRecord(D.OB, Ref);
  114. END;
  115. {-----------------------------------------}
  116. PROCEDURE anzeigen;
  117. LABEL Weiter;
  118. VAR   ch : CHAR;
  119.       Ref : WORD;
  120.  
  121. BEGIN
  122.   Maske ('Satz anzeigen');
  123.   GetOB; GetRecord (D.OB, D, Ref);
  124. Weiter:
  125.   IF IsamError <> 0 THEN
  126.   BEGIN
  127.     GotoXY(10, 25);
  128.     Write(' Satz nicht gefunden'#7#7#7);
  129.     Delay(1000); Exit;
  130.   END;
  131.   GotoXY(20, 3); Write(D.OB); ClrEol;
  132.   GotoXY(20, 4); Write(D.Vorname); ClrEol;
  133.   GotoXY(20, 5); Write(D.Plz); ClrEol;
  134.   GotoXY(20, 6); Write(D.Ort); ClrEol;
  135.   GotoXY(20, 7); Write(D.Str); ClrEol;
  136.   GotoXY(20, 10);
  137.   Write('B = Blättern / andere Taste = Anzeigen Ende');
  138.   ReadLn(ch);
  139.   IF (CH='B') OR (CH = 'b') THEN
  140.   BEGIN
  141.     GetNextRecord(D, Ref); GOTO Weiter;
  142.   END;
  143. END;
  144. {-----------------------------------------}
  145. PROCEDURE Menue;
  146. VAR Wahl : BYTE;
  147. BEGIN
  148.   ClrScr;
  149.   WriteLn('      ISAM-Demonstration  -  Menü');
  150.   WriteLn('      ===========================');
  151.   WriteLn;
  152.   WriteLn('      1 .... Datensatz anlegen');
  153.   WriteLn('      2 .... Datensatz ändern');
  154.   WriteLn('      3 .... Datensatz löschen');
  155.   WriteLn('      4 .... Datensatz anzeigen');
  156.   WriteLn('      5 .... Datendatei reorganisieren');
  157.   WriteLn('      6 .... Schlüsseldatei rekonstruieren');
  158.   WriteLn;
  159.   WriteLn('      9 .... Programmende');
  160.   WriteLn; WriteLn;
  161.   REPEAT
  162.     GotoXY(14, 16); Write('Bitte wählen : ');
  163.     {$I-} ReadLn (Wahl); {$I+}
  164.   UNTIL ((Wahl > 0) AND (Wahl < 7)) OR (Wahl = 9);
  165.   CASE Wahl OF
  166.     1 : anlegen;
  167.     2 : aendern;
  168.     3 : loeschen;
  169.     4 : anzeigen;
  170.     5 : ReorgDataFile;
  171.     6 : Reko (FALSE);
  172.     9 : Ende := TRUE;
  173.     ELSE Write (#7);
  174.   END;
  175. END;
  176. {-----------------------------------------}
  177. BEGIN
  178.   IF NOT ExistFile(Data)  THEN CreateFile(Data);
  179.   IF NOT ExistFile(Index) THEN CreateFile(Index);
  180.   OpenDataBase;
  181.   REPEAT Menue UNTIL Ende;
  182.   CloseDataBase;
  183. END.
  184.