Programmer 7500/MAX_PROGRAMMERS.iso/INFO/TURBOPAS/MURUTIL.ZIP/SEARCH.PAS

Pascal/Delphi Source File | 1986-12-02 | 6.2 KB | 222 lines

PROGRAM SEARCH;

{  This Turbo Pascal program searches the  input  file,  INP,  for  all
   occurrences of user-specified strings.  Upper/Lower case differences
   are ignored.

   The program ends when the user enters a null or all-blank string.

   A search string of "P+" or "+P" enables  printing.
   A search string of "P-" or "-P" disables printing.

   Program by Harry M. Murphy,  24 May 1986.

   Updated for printout control on 27 July 1986.  }

  CONST
        LENSPEC = 65;
        LENSRCH = 40;
        LINELEN = 132;

  TYPE
       FILESPEC = STRING[LENSPEC];
       SRCHLINE = STRING[LENSRCH];
       TEXTLINE = STRING[LINELEN];

  VAR
      FF:      CHAR;
      HARD:    BOOLEAN;
      HARDOUT: BOOLEAN;
      HIT:     BOOLEAN;
      INP:     TEXT[2048];
      INPNAME: FILESPEC;
      LINENO:  INTEGER;
      LSRCH:   1..LENSRCH;
      SRCH:    SRCHLINE;


PROCEDURE GETINPFIL(VAR INPNAME: FILESPEC);

{  This file gets an input file, either as the first parameter on the
   command line or by requesting it from the user.

   Procedure by Harry M. Murphy,  22 February 1986.  }

  VAR
      L: 1..LENSPEC;

  BEGIN
    IF PARAMCOUNT = 0
      THEN
        BEGIN
          WRITE('Input  file: ');
          READLN(INPNAME)
        END
      ELSE
        INPNAME := PARAMSTR(1);
    FOR L:=1 TO LENGTH(INPNAME) DO INPNAME[L] := UPCASE(INPNAME[L]);
    ASSIGN(INP,INPNAME);
    {$I-} RESET(INP); {$I+}
    IF IORESULT <> 0
      THEN
        BEGIN
          CLOSE(INP);
          WRITELN('ERROR!  Can''t find file ',INPNAME,'!');
          HALT
        END;
  END {Procedure GETINPFIL};

  PROCEDURE GETSRCH;

  { This procedure asks for and gets the search strings.  If the search
    string is "P+", "+P", "P-" or "-P",  it sets or clears the hardcopy
    flag, HARD, and asks again for the search string. }

  VAR
        L: 1..LENSRCH;

    FUNCTION NOKEY: BOOLEAN;

    { This function is internal to GETSRCH.   It returns TRUE if the
      search string, SRCH, is NOT a printer keyword  "P+", "+P", "P-"
      or "-P";  otherwise, it sets or clears the hardcopy flag, HARD,
      outputs the current printer status and returns FALSE. }

      VAR
          K:  0..4;
          PX: STRING[2];

      BEGIN
        IF LENGTH(SRCH) <> 2
          THEN
            NOKEY := TRUE
          ELSE
            BEGIN
              PX := SRCH;
              K := POS(PX,'P+P-P');
              CASE K OF
                  0: NOKEY := TRUE;
                1,2: BEGIN
                        NORMVIDEO;
                        WRITELN('Printer enabled.');
                        LOWVIDEO;
                        HARD := TRUE;
                        NOKEY := FALSE
                      END;
                3,4: BEGIN
                        NORMVIDEO;
                        WRITELN('Printer disabled.');
                        LOWVIDEO;
                        HARD := FALSE;
                        NOKEY := FALSE
                      END
              END { CASE }
            END
      END {Function NOKEY};


  BEGIN { Procedure GETSRCH }
    REPEAT
      WRITELN;
      WRITE('Search string? >');
      READLN(SRCH);
      LSRCH := LENGTH(SRCH);
      IF LSRCH > 0
        THEN
          BEGIN
            FOR L:=1 TO LSRCH DO SRCH[L] := UPCASE(SRCH[L]);
            WHILE (SRCH[L] = ' ') AND (LSRCH > 0) DO LSRCH := LSRCH-1
          END;
      SRCH[0] := CHR(LSRCH);
    UNTIL NOKEY
  END {Procedure GETSRCH};

  PROCEDURE SCANLINE;

  { This procedure reads and scans an input line for an occurrence  of
    the search string, SRCH.   If the string is found, it displays the
    line,  highlighting the portion containing the search string,  and
    sets the flag HIT to TRUE.

    If the hardcopy flag, HARD, is set, SCANLINE sends the line to the
    printer and sets the hardcopy output flag,  HARDOUT, to true.   If
    this is the first hardcopy output, SCANLINE precedes the line with
    the name of the file being searched.   If this is the  first  hit,
    SCANLINE precedes the line with the search line. }

  VAR
      L,LS,LT,LZ: 1..LINELEN;
      LINE:       TEXTLINE;
      LINES:      TEXTLINE;

  BEGIN
    READLN(INP,LINE);
    LINENO := LINENO+1;
    LS := LENGTH(LINE);
    IF LS >= LSRCH
      THEN
        BEGIN
          LINES := LINE;
          FOR L:=1 TO LS DO LINES[L] := UPCASE(LINES[L]);
          LT := POS(SRCH,LINES);
          IF LT > 0
            THEN
              BEGIN
                WRITE(LINENO:5,' > ');
                IF LT > 1 THEN FOR L:=1 TO LT-1 DO WRITE(LINE[L]);
                LZ := LT+LSRCH-1;
                NORMVIDEO;
                FOR L:=LT TO LZ DO WRITE(LINE[L]);
                LOWVIDEO;
                IF LZ < LS THEN FOR L:=LZ+1 TO LS DO WRITE(LINE[L]);
                WRITELN;
                IF HARD
                  THEN
                    BEGIN
                      IF NOT HARDOUT
                        THEN
                          BEGIN
                            WRITELN(LST,'SEARCH of ',INPNAME,':');
                            WRITELN(LST);
                            HARDOUT := TRUE
                          END;
                      IF NOT HIT
                        THEN
                          BEGIN
                            WRITELN(LST,'Records containing "',SRCH,'":');
                            WRITELN(LST)
                          END;
                      WRITE(LST,LINENO:5,' > ');
                      FOR L:=1 TO LS DO WRITE(LST,LINE[L]);
                      WRITELN(LST)
                    END;
                HIT := TRUE;
              END
        END
  END {Procedure SCANLINE};


  BEGIN {Program SEARCH};
    FF := CHR(12);
    HARD := FALSE;
    HARDOUT := FALSE;
    LOWVIDEO;
    GETINPFIL(INPNAME);
    GETSRCH;
    WHILE LSRCH > 0 DO
      BEGIN
        RESET(INP);
        HIT := FALSE;
        LINENO := 0;
        WHILE NOT EOF(INP) DO SCANLINE;
        IF NOT HIT
          THEN
            WRITELN('                Not found.')
          ELSE
            IF HARD THEN WRITELN(LST);
        GETSRCH
      END;
    IF HARDOUT THEN WRITELN(LST,FF);
    CLOSE(INP)
END.