* Program | SCAN * Date | 10 Sep 2004 * Author | Adrian Overs * Copyright | Citysoft Pty Ltd (c) 2004 * Function | To search programs and data for a nominated string or * | match pattern. ************************************************************************ * 15 Nov 2007 | Adrian Overs | Changed end condition for Parse process * | | to LEN(RESULT<1>) to allow for extra * | | spaces in the command line. * 19 Aug 2009 | Adrian Overs | Added check for Object code ************************************************************************ $OPTIONS INFORMATION $INCLUDE INSERTS PARSER.COM $INCLUDE INSERTS KW$EQS EQU TRUE TO 1, FALSE TO 0, OTHERWISE TO 1, BELL TO CHAR(7), MARGIN TO 4, VERSION TO "2.61", SEPERATOR TO ":", UV.OBJ.STR TO CHAR(172):CHAR(224):CHAR(161):@VM: CHAR(172):CHAR(225):CHAR(161) ;* ACE0A1 or ACE1A1 ERR.TXT = "" FILE.COUNT = 0 DIM FILES.ARR(1024,2) MAT FILES.ARR = "" DIM R.RECORD(9999) MATCH.STRING = "" RESULT = "" LIKE$F = FALSE NO.PAGE$F = FALSE LPTR$F = FALSE NOCASE$F = FALSE RECUR = 0 SENTENCE = TRIMF(TRIMB(@SENTENCE)) CALL @PARSER(RESULT,SENTENCE,RECUR) IF @USER.RETURN.CODE EQ 1 THEN GOSUB SYNTAX END ELSE GOSUB MAINLINE END RETURN ; * Exit program MAINLINE: GOSUB PARSE.RESULT IF ERR.TXT THEN GOSUB FATAL.ERROR END ELSE GOSUB PROCESS.RESULT END RETURN PROCESS.RESULT: IF LPTR$F THEN PRINTER ON WIDTH = @LPTRWIDE END ELSE WIDTH = @CRTWIDE END IF NO.PAGE$F THEN NO.PAGE = @(0,0) END ELSE CALL !BPIOCP END FOUND = "" @USER.RETURN.CODE = 0 FOR FILE.COUNTER = 1 TO FILE.COUNT IF ID.LIST THEN FORMLIST ID.LIST END ELSE SSELECT FILES.ARR(FILE.COUNTER,2) END HEADER = "SCAN of ": FILES.ARR(FILE.COUNTER,1):" for ":CONVERT(@VM,",",MATCH.STRING):"'g'Page 'pl'" HEADING HEADER LOOP READNEXT K.RECORD ELSE K.RECORD = @FM UNTIL K.RECORD EQ @FM MAT R.RECORD = "" MATREAD R.RECORD FROM FILES.ARR(FILE.COUNTER,2), K.RECORD THEN IF R.RECORD(1)[1,3] MATCHES UV.OBJ.STR THEN * Ignore Object code CONTINUE END LINE.PRINTED$F = FALSE IF DICT$F THEN MAXLINES = 7 END ELSE MAXLINES = INMAT() END FOR LINE = 1 TO MAXLINES IF LIKE$F THEN * Use match string IF NOCASE$F THEN IF UPCASE(R.RECORD(LINE)) MATCHES UPCASE(MATCH.STRING) THEN GOSUB PROCESS.MATCH END END ELSE IF R.RECORD(LINE) MATCHES MATCH.STRING THEN GOSUB PROCESS.MATCH END END END ELSE * Line must equal string IF NOCASE$F THEN IF UPCASE(R.RECORD(LINE)) EQ UPCASE(MATCH.STRING) THEN GOSUB PROCESS.MATCH END END ELSE IF R.RECORD(LINE) EQ MATCH.STRING THEN GOSUB PROCESS.MATCH END END END NEXT LINE IF LINE.PRINTED$F THEN FOUND = K.RECORD END END ; * MATREAD REPEAT NEXT FILE.COUNTER IF LPTR$F THEN PRINTER OFF PRINTER CLOSE END FOR FILE.COUNTER = 1 TO FILE.COUNT KEY.LIST = RAISE(FOUND) IF KEY.LIST NE "" THEN FORMLIST KEY.LIST TO (FILE.COUNTER-1) END NEXT FILE.COUNTER CALL !BPIOCP RETURN PROCESS.MATCH: IF LINE.PRINTED$F THEN TEXT = TRIMF(R.RECORD(LINE)) CALL NICE.PRINT((TEXT),(WIDTH),LINE,MARGIN,SEPERATOR) END ELSE PRINT PRINT FILES.ARR(FILE.COUNTER,1), K.RECORD TEXT = TRIMF(R.RECORD(LINE)) CALL NICE.PRINT((TEXT),(WIDTH),LINE,MARGIN,SEPERATOR) LINE.PRINTED$F = TRUE END @USER.RETURN.CODE += 1 RETURN PARSE.RESULT: READ R.NOCASE FROM VOC.FV,'NOCASE' ELSE R.NOCASE = "K" R.NOCASE<2> = 1000 WRITE R.NOCASE TO VOC.FV,'NOCASE' END DICT$F = FALSE * Get rid of the Program name and V DEL RESULT<1,1> DEL RESULT<2,1> LOOP WHILE LEN(RESULT<1>) WORD = RESULT<1,1> TYPE = RESULT<2,1> DEL RESULT<1,1> DEL RESULT<2,1> BEGIN CASE CASE TRIM(WORD) EQ "" CASE TYPE MATCHES "F":@VM:"Q" * File pointer IF DICT$F THEN OPEN "DICT", WORD TO FILE.FV THEN FILE.COUNT += 1 FILES.ARR(FILE.COUNT,1) = "DICT, ":WORD FILES.ARR(FILE.COUNT,2) = FILE.FV END ELSE ERR.TXT<-1> = "Can't open the DICT of the ":WORD:" file" END END ELSE OPEN WORD TO FILE.FV THEN FILE.COUNT += 1 FILES.ARR(FILE.COUNT,1) = WORD FILES.ARR(FILE.COUNT,2) = FILE.FV END ELSE ERR.TXT<-1> = "Can't open the ":WORD:" file" END END CASE TYPE EQ KW$AND * Ignore and pass on. CASE TYPE EQ KW$OR * Ignore and pass on. CASE TYPE EQ KW$EQ LIKE$F = FALSE CASE TYPE EQ KW$NO.PAGE NO.PAGE$F = TRUE CASE TYPE EQ KW$DICT DICT$F = TRUE CASE TYPE EQ KW$LIKE LIKE$F = TRUE CASE TYPE EQ "G" * Literal String MATCH.STRING<1,-1> = WORD CASE TYPE EQ KW$LPTR LPTR$F = TRUE CASE TYPE EQ 1000 ; * NOCASE NOCASE$F = TRUE CASE OTHERWISE ERR.TXT<-1> = "Unknown keyword ->":WORD END CASE REPEAT READLIST ID.LIST THEN SELECTED$F = FALSE END ELSE ID.LIST = "" SELECTED$F = TRUE END RETURN SYNTAX: CRT CRT "Copyright - Citysoft Pty Ltd (c) 2004" CRT "[SCAN Version ":VERSION:" 19 Aug 2009]" CRT CRT "Full Syntax" CRT CRT "SCAN [DICT] FileName [AND FileName] LIKE/EQ MatchString/Literal" CRT " [OR MatchString/Literal]" CRT " [LPTR]" CRT " [NOCASE]" CRT " [NO.PAGE]" CRT CRT "NB - SCAN will leave an active select liet of matched @IDs" CRT RETURN FATAL.ERROR: PRINTERR LOOP REMOVE TEXT FROM ERR.TXT SETTING MORE PRINT BELL:TEXT WHILE MORE REPEAT RETURN END