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