home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / 1991 / 03 / titel / list_386.pas
Encoding:
Pascal/Delphi Source File  |  1990-12-13  |  4.2 KB  |  107 lines
  1. -- MetaWare Professional Pascal 386
  2. -- (c) Ronald Fischer & toolbox 1991
  3. -- SUCHE: Suchen von Strings in einer Datei.
  4. -- Dieses Programm dient der Demonstration der Spracherweite-
  5. -- rungen von Professional Pascal. Die Datei wird komplett in
  6. -- ein hinreichend großes Array kopiert, alle Suchoperationen
  7. -- finden im Speicher statt. Die Suchausdrücke werden von
  8. -- INPUT gelesen. Aufruf des gebundenen Programmes:
  9. -- SUCHE dateiname
  10.  
  11. WITH LOOPHOLES : [RETYPE,SIZEOF];
  12. PRAGMA INCLUDE('heap.pf');
  13. WITH HEAP : [MALLOC];
  14. PROGRAM suche(datei);
  15.  
  16. CONST max_line= 120;             -- Größte Länge Eingabezeile
  17. CONST max_datei_len = 1000000;   -- Max. Dateilänge
  18. CONST newline= CHR(12);          -- Interner Zeilentrenner
  19. TYPE textzeile  = STRING(max_line);
  20. TYPE mdateipuff =
  21.        PACKED ARRAY [1..max_datei_len] OF CHAR;
  22. TYPE mdatei =             -- "Memory-Datei" - Kopie der Datei
  23.        RECORD                             -- im Hauptspeicher
  24.          len  : CARDINAL;                 -- Dateilänge
  25.          data : mdateipuff                -- Dateiinhalt
  26.        END;
  27. VAR datei : TEXT;               -- Die zu durchsuchende Datei
  28. VAR m : ^mdatei;                -- Die Datei im Speicher
  29.  
  30. PROCEDURE einlesen(VAR mem : mdatei; VAR fil : TEXT);
  31.             -- Liest die Datei fil auf die Variable mem.
  32.             -- Zeilenenden werden dabei durch newline ersetzt
  33. BEGIN ------------------ einlesen ---------------
  34.   WITH mem DO BEGIN
  35.     len := 0;
  36.     WHILE NOT EOF(fil) DO
  37.     DECLARE VAR zeile : textzeile; i : 1..max_line
  38.     BEGIN
  39.       READLN(fil, zeile);
  40.       FOR i := 1 TO LENGTH(zeile) DO
  41.         data[len := len+1] := zeile[i];
  42.       data[len := len+1] := newline
  43.     END
  44.   END
  45. END; ------------------- einlesen ---------------
  46.  
  47. ITERATOR wortsuch -------------------------------
  48.   (CONST wort : textzeile; CONST m : mdatei)
  49.   :(zeilennr  : CARDINAL; zeile : textzeile);
  50.  
  51.   TYPE position =                 -- Suchposition ind in m
  52.        RECORD                     -- Zeile znr beginnt bei zp
  53.          znr,ind,zp : CARDINAL;
  54.          erfolg     : BOOLEAN     -- FALSE wenn Ende
  55.        END;
  56.   FUNCTION wcomp(CONST wort : textzeile; --------
  57.      p1 : CARDINAL; CONST m : mdatei;
  58.      p2 : CARDINAL) :BOOLEAN;
  59.                               -- Ist wort gleich m[pos..] ???
  60.      BEGIN -------------- wcomp -----------------
  61.        IF wort[p1] <> m.data[p2] THEN   RETURN(FALSE);
  62.        IF p1 = LENGTH(wort) THEN        RETURN (TRUE);
  63.        IF p2 = m.len THEN               RETURN (FALSE);
  64.        RETURN (wcomp(wort,p1+1,m,p2+1))
  65.     END; --------------- wcomp ------------------
  66.   FUNCTION next(CONST wort: textzeile; --------
  67.       CONST m : mdatei; CONST prev: position)
  68.       : POSITION;             -- Position des nächsten Wortes
  69.     BEGIN -------------- next -------------------
  70.       next := prev;
  71.       WHILE TRUE DO WITH next DO BEGIN
  72.         erfolg := FALSE; INC(ind);
  73.         IF m.data[ind] = newline THEN BEGIN
  74.            zp := ind := ind + 1; INC(znr)
  75.         END          { Zeilenschaltung! } ;
  76.         IF ind >= m.len THEN RETURN;                 -- FALSE
  77.         IF erfolg := wcomp(wort,1,m,ind) THEN RETURN; -- TRUE
  78.       END
  79.     END; --------------- next -------------------
  80.   FUNCTION zeile_ab(CONST m: mdatei; p: CARDINAL): textzeile;
  81.     BEGIN -------------- zeile_ab ---------------
  82.         zeile_ab := '';
  83.         REPEAT
  84.           zeile_ab := zeile_ab || m.data[p]
  85.         UNTIL m.data[p := SUCC(p)] = newline;
  86.     END; --------------- zeile_ab ---------------
  87.     VAR control: position;
  88. BEGIN ------------------ wortsuch ---------------
  89.   control.znr := control.zp := 1; control.ind := 0;
  90.   WHILE (control := next(wort, m, control)).erfolg
  91.   DO yield(control.znr, zeile_ab(m, control.zp))
  92. END; ------------------- wortsuch ---------------
  93. BEGIN ------------- Hauptprogramm ---------------
  94.   RESET(datei);
  95.   m := MALLOC(SIZEOF(mdatei)) %RETYPE TYPEOF(m);
  96.   IF m = NIL THEN WRITELN('MALLOC ERROR')
  97.   ELSE  DECLARE VAR sw: textzeile; BEGIN
  98.     einlesen(m^,datei);
  99.     writeln(m^.len,' Zeichen gelesen');
  100.     REPEAT
  101.         WRITELN('Suchwort?'); READLN(sw);
  102.         FOR nr,z IN sw %wortsuch m^ DO
  103.             WRITELN(nr,':',z);
  104.     UNTIL LENGTH(sw)=0
  105.   END
  106. END.
  107.