home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Phoenix CD 2.0
/
Phoenix_CD.cdr
/
15a
/
murutil.zip
/
SEARCH.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1986-12-02
|
6KB
|
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.