home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / extra18 / toolbox / index.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1992-01-21  |  5.4 KB  |  190 lines
  1. (* ------------------------------------------------- *)
  2. (*                   INDEX.PAS                       *)
  3. (*       (c) 1990, 1992 Horst Zein & DMV-Verlag      *)
  4. (* ------------------------------------------------- *)
  5. UNIT Index;
  6.  
  7. INTERFACE
  8.  
  9. CONST
  10.   MaxKeySize = 10;               { natürlich anpassen }
  11.  
  12. TYPE
  13.   sPointer   = ^Schluessel;
  14.  
  15.   Schluessel = RECORD
  16.                  Next  : sPointer;
  17.                  Key   : LONGINT;{ evtl. anpassen     }
  18.                  RecNo : WORD;   { LongInt unpassEND  }
  19.                END;
  20.  
  21. VAR
  22.   HeapTop    : ^INTEGER;         { für Mark, Release  }
  23.   Kette      : FILE OF Schluessel;
  24.   Find       : sPointer;
  25.   s          : Schluessel;
  26.   Root       : ARRAY [1..MaxKeySize] OF sPointer;
  27.  
  28.   PROCEDURE ReadKette;
  29.  
  30.   PROCEDURE WriteKette;
  31.  
  32.   FUNCTION  FindKey (KeyNr : BYTE;
  33.                      Key : LongInt) : BOOLEAN;
  34.  
  35.   FUNCTION  PrevKey (KeyNr : BYTE;
  36.                      stat  : sPointer) : sPointer;
  37.  
  38.   FUNCTION  NextKey (KeyNr : BYTE;
  39.                      stat  : sPointer) : sPointer;
  40.  
  41.   PROCEDURE AddKey  (KeyNr : BYTE;
  42.                      NeuerSatz : Schluessel);
  43.  
  44.   PROCEDURE DelKey  (KeyNr : BYTE; era : sPointer);
  45.  
  46.  
  47. IMPLEMENTATION
  48.  
  49. VAR
  50.   i          : BYTE;
  51.   work, save : sPointer;
  52.  
  53.  
  54.   PROCEDURE ReadKette;
  55.   { Einlesen der Indexstruktur (im Hauptprogramm      }
  56.   { "Assign" nicht vergessen!).                       }
  57.   { Leere Ketten sind mit SatzNummer $FFFF in ersten  }
  58.   { Eintrag gekennzeichnet.                           }
  59.   BEGIN
  60.     FOR i := 1 TO MaxKeySize DO Root[i] := NIL;
  61.     Find := NIL;
  62.     i    := 1;
  63.   {$I-}
  64.     Reset(Kette);
  65.   {$I+}
  66.     WHILE (i <= MaxKeySize) AND (IOResult = 0) DO BEGIN
  67.       IF NOT EoF(Kette) THEN BEGIN
  68.                                  { Init. Kettenanfang }
  69.         New(Find);
  70.         Read(Kette, Find^);
  71.         IF Find^.RecNo <> $FFFF THEN
  72.                                  { keine leere Kette  }
  73.           Root[i] := Find;
  74.       END;
  75.       WHILE (Find^.Next <> NIL) AND
  76.             (Find <> NIL) DO BEGIN
  77.                               { Lesen restliche Sätze }
  78.         New(Work);
  79.         Find^.Next := Work;
  80.         Read(Kette, Work^);
  81.         Find := Work;
  82.       END;
  83.       Inc(i);                         { nächste Kette }
  84.     END;
  85.   END;
  86.  
  87.   PROCEDURE WriteKette;
  88.   { Auslesen der Ketten; leere Strukturen werden mit  }
  89.   { Satznummer $FFFF gekennzeichnet (siehe auch       }
  90.   { ReadKette)                                        }
  91.   BEGIN
  92.     Rewrite(Kette);
  93.     FOR i := 1 TO MaxKeySize DO BEGIN
  94.                               { jeweils eine Struktur }
  95.       IF Root[i] = NIL THEN BEGIN
  96.         s.RecNo := $FFFF;     { für Wiedereinlesen    }
  97.         s.Next  := NIL;
  98.         Write(Kette, s);
  99.       END;
  100.       Find := Root[i];       { auf Anfang und ...     }
  101.       WHILE Find <> NIL DO BEGIN
  102.                              { alle Einträge auslesen }
  103.         Write(Kette, Find^);
  104.         Find := Find^.Next;
  105.       END;
  106.     END;
  107.     Close(Kette);
  108.   END;
  109.  
  110.   FUNCTION  FindKey (KeyNr: BYTE;
  111.                      key: LongInt): BOOLEAN;
  112.   { In der Kette "KeyNr" wird der übergebene Schlüssel}
  113.   { gesucht und im Erfolgsfall TRUE, sonst FALSE      }
  114.   { zurückgegeben.                                    }
  115.   { Die globale Variable "Find" zeigt auf den         }
  116.   { gefundenen Eintrag.                               }
  117.   BEGIN
  118.     Find := Root[KeyNr];
  119.     WHILE (Find <> NIL) AND (Find^.Key <> Key) DO
  120.       Find := Find^.Next;
  121.     FindKey := Find <> NIL;
  122.   END;
  123.  
  124.   FUNCTION  PrevKey (KeyNr : BYTE;
  125.                      stat  : sPointer) : sPointer;
  126.   { Umsetzen des aktuellen Zeigers auf Vorgänger bzw. }
  127.   { aufletzten falls am Kettenanfang                  }
  128.   { (d.h. Ringstruktur)                               }
  129.   BEGIN
  130.     Find := Root[KeyNr];
  131.     WHILE (Find^.Next <> stat) AND
  132.           (Find^.Next <> NIL) DO
  133.       Find := Find^.Next;
  134.     PrevKey := Find;
  135.   END;
  136.  
  137.   FUNCTION  NextKey (KeyNr : BYTE;
  138.                      stat  : sPointer) : sPointer;
  139.   { Umsetzen des aktuellen Zeigers auf Nachfolger bzw.}
  140.   { auf ersten falls am Kettenende (d.h. Ringstruktur)}
  141.   BEGIN
  142.     IF Stat^.Next <> NIL THEN
  143.       NextKey := stat^.Next
  144.     ELSE
  145.       NextKey := Root[KeyNr];
  146.   END;
  147.  
  148.   PROCEDURE AddKey (KeyNr : BYTE;
  149.                     NeuerSatz : Schluessel);
  150.   { Einfügen des übergebenen Schlüssels in bestehende }
  151.     Struktur einschließlich Setzen der Verweise       }
  152.   BEGIN
  153.     New(Work);
  154.     Work^      := NeuerSatz;
  155.     Work^.Next := NIL;
  156.     Find       := Root[KeyNr];
  157.     Save       := NIL;
  158.     WHILE Find <> Work^.Next DO
  159.       IF Find^.Key < Work^.Key THEN BEGIN
  160.                              { Kriterium evtl. ändern }
  161.         Save := Find;
  162.         Find := Find^.Next;
  163.       END ELSE
  164.         Work^.Next := Find;
  165.     IF Save = NIL THEN
  166.       Root[KeyNr] := Work
  167.     ELSE
  168.       Save^.Next := Work;
  169.   END;
  170.  
  171.   PROCEDURE DelKey (KeyNr : BYTE; era : sPointer);
  172.   { Löschen eines Satzes (ohne Freigabe des Speicher- }
  173.   { platzes) durch Umsetzen der Verweise              }
  174.   BEGIN
  175.     Find := Root[KeyNr];
  176.     Save := NIL;
  177.     WHILE Find <> era DO BEGIN
  178.       Save := Find;
  179.       Find := Find^.Next;
  180.     END;
  181.     IF Save = NIL THEN
  182.       Root[KeyNr] := era^.Next
  183.     ELSE
  184.       Save^.Next := era^.Next;
  185.   END;
  186.  
  187. END.
  188. (* ------------------------------------------------- *)
  189. (*               Ende von INDEX.PAS                  *)
  190.