home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / 1987 / 11 / zugriff / hashdat.pas next >
Encoding:
Pascal/Delphi Source File  |  1987-10-06  |  5.3 KB  |  149 lines
  1. {---------------------------------------------------------------------------}
  2. { Programm Hash: Beispielprogramm zur Verwendung einer Hash-Funktion.
  3.                  Diese Funktion verwendet die alphabethische Reihenfolge
  4.                  der Zeichen, um einen Speicherplatz zu finden.
  5.   Pascal-System: Pascal ST+ / Atari ST                                      }
  6.  
  7. PROGRAM Hash;
  8.  
  9. CONST   max_sort = 26;                       { Feldbegrenzung               }
  10.  
  11. TYPE    str10 = STRING[10];                  { max Laenge des Eintrages     }
  12.         feld  = ARRAY[1..max_sort] OF str10; { Feld der Namen               }
  13.  
  14. VAR     wahl    : CHAR;                      { Menuewahl                    }
  15.         ende    : BOOLEAN;                   { Programmende ?               }
  16.         namen   : feld;                      { hier stehen die Namen        }
  17.         name    : str10;                     { Puffer fuer den Namen        }
  18.  
  19. {---------------------------------------------------------------------------}
  20. {                  schreibt in alle Namenfelder 'FREI':                     }
  21.  
  22. PROCEDURE Init;
  23.  
  24. VAR i: INTEGER;
  25.  
  26. BEGIN
  27.   FOR i := 1 TO max_sort DO namen[i] := '---FREI---';
  28. END;
  29.  
  30. {---------------------------------------------------------------------------}
  31. {               wandelt Buchstaben in Alphabethreihenfolge:                 }
  32.  
  33. FUNCTION zeichenwert (zeichen: CHAR): INTEGER;
  34.  
  35. BEGIN
  36.   zeichenwert := Ord(zeichen)-Ord('A')+1;
  37. END;
  38.  
  39. {---------------------------------------------------------------------------}
  40. {               speichert unter der Adresse das Wort ab:                    }
  41.  
  42. PROCEDURE speicher (adresse: INTEGER; VAR name: str10);
  43.  
  44. BEGIN
  45.   namen[adresse] := name;
  46. END;
  47.  
  48. {---------------------------------------------------------------------------}
  49. {               holt den Inhalt des adressierten Eintrages:                 }
  50.  
  51. PROCEDURE lese (adresse: INTEGER; VAR inhalt: str10);
  52.  
  53. BEGIN
  54.   inhalt := namen[adresse];
  55. END;
  56.  
  57. {---------------------------------------------------------------------------}
  58. {                    hier werden die Namen eingegeben:                      }
  59.  
  60. PROCEDURE eingeben;
  61.  
  62. VAR      zugriff      : BOOLEAN;        { freier Speicherplatz ?            }
  63.          wert,                          { Wert des ASCII Zeichens           }
  64.          i,                             { Zaehlvariabele                    }
  65.          speicherzahl,                  { in diesem Platz wird abgelegt     }
  66.          zeiger_wort  :INTEGER;         { zeigt auf aktuellen Wortbuchstaben}
  67.          zeichen      :CHAR;
  68.          inhalt       :str10;           { Inhalt d. adressierten Namenfeldes}
  69.  
  70. BEGIN
  71.   speicherzahl := 0;
  72.   zeiger_wort := 1;
  73.   zugriff := FALSE;                     { kein freier Speicherplatz         }
  74.   Write('Bitte den Namen eingeben: ');
  75.   ReadLn(name);
  76.   REPEAT                          { hole solange Ordnungszahl bis freier... }
  77.                                   { Speicherplatz gefunden ist              }
  78.     IF Length(name) >= zeiger_wort THEN
  79.     BEGIN
  80.       FOR i := 1 TO zeiger_wort DO
  81.       BEGIN
  82.         zeichen := name[i];               { hole zu berechnenden Buchstaben }
  83.         wert := zeichenwert(zeichen);
  84.         WriteLn('Der ', i, '.Buchstabe von ', name, ' ist ', zeichen,
  85.                 ' und hat den Wert:', wert);
  86.         speicherzahl := speicherzahl + wert;
  87.         IF speicherzahl > max_sort THEN
  88.           speicherzahl := speicherzahl - max_sort;
  89.                  { Ist ein Feldueberlauf eingetreten, so fange von vorne an }
  90.       END;
  91.       WriteLn(name, ' soll auf Platz ', speicherzahl,
  92.               ' gesetzt werden');
  93.       lese(speicherzahl, inhalt);
  94.       IF inhalt = '---FREI---' THEN
  95.       BEGIN            { Das Feld ist frei und es kann abgespeichert werden }
  96.         WriteLn;
  97.         WriteLn('Name in Feld:', speicherzahl, ' gespeichert');
  98.         speicher(speicherzahl,name);
  99.         zugriff := TRUE;
  100.       END
  101.       ELSE        { Der Platz ist besetzt und der Zeiger, welcher die zu
  102.                     berechnende Wortlaenge darstellt, wird um eins erhoeht. }
  103.         WriteLn('Platz bereits besetzt');
  104.       zeiger_wort := Succ(zeiger_wort);
  105.       speicherzahl := 0;
  106.       END
  107.     ELSE
  108.     BEGIN
  109.             { der Name muss nach einem anderen Verfahren gespeichert werden
  110.                z.B. es wird der Name im ersten freien Feld abgelegt         }
  111.       WriteLn('Abspeichern nach Hash-Funktion nicht moeglich');
  112.       zugriff := TRUE;                             { Fertig mit Abspeichern }
  113.     END;
  114.   UNTIL zugriff;
  115. END;
  116.  
  117. {---------------------------------------------------------------------------}
  118. {                         gibt das ganze Feld aus:                          }
  119.  
  120. PROCEDURE ausgeben;
  121.  
  122. VAR i: INTEGER;
  123.  
  124. BEGIN
  125.   FOR i := 1 TO Trunc(max_sort/2) DO WriteLn(i:2, ' = ', namen[i]);
  126.   Write(' Taste druecken'); Read(wahl); WriteLn;
  127.   FOR i := Trunc(max_sort/2)+1 TO max_sort DO WriteLn(i:2, ' = ', namen[i]);
  128. END;
  129.  
  130. {----------------------------------- MAIN ----------------------------------}
  131.  
  132. BEGIN
  133.   Init;
  134.   ende := FALSE;
  135.   REPEAT
  136.     WriteLn;
  137.     WriteLn('Auswahlmenue');
  138.     WriteLn('1 -- Namen eingeben');
  139.     WriteLn('2 -- Namen ausgeben');
  140.     WriteLn('3 -- Ende');
  141.     Read(wahl); WriteLn;
  142.     CASE wahl OF
  143.       '1': eingeben;
  144.       '2': ausgeben;
  145.       '3': ende := TRUE;
  146.     END;  { OF CASE }
  147.   UNTIL ende;
  148. END.
  149.