* Name - CALL.USED * Called By - T.C.L. * Description - * Version - 25 Nov 2000 - INTERNET * Written - Nine Elms Solutions Ltd * *<----------------------------------- COPYRIGHT NOTICE -----------------------------------> * Copyright 2000 - code@nineelms.com * * THIS HEADER MUST REMAIN INTACT IN THIS AND ANY CHANGED VERSION OF THIS ROUTINE * * CALL.USED may be used and modified free of charge by anyone so long as this * copyright notice and comments above remain intact. By using this code you * agree to indemnify Nine Elms Solutions Ltd from any liability that may arise from its use. * * Selling the code for this program without prior written consent is * expressly forbidden. In other words, please ask first before you try and * make money off my program. * * Obtain permission before redistributing this software over the Internet or * in any other medium. In all cases copyright and the header must remain intact * *<------------------------------------------------------------------------------------------> * PROMPT "" * EQU TILDE TO CHAR(126) EQU BUZ TO CHAR(7), SVM TO CHAR(252), VM TO CHAR(253), AM TO CHAR(254) REVON = '' ;* Set to your own Preference REVOFF = '' ;* Set to your own Preference EOL = @(-4) EOS = @(-3) ESC = CHAR(27) TODAY = OCONV(DATE(),'D2') DIM CCB(20) * * Open Files Used * NEWFILE = 0 OPEN "WHERE.USED" TO WHERE.USED ELSE STMNT = "CREATE-FILE WHERE.USED 1 11" EXECUTE STMNT OPEN "WHERE.USED" TO WHERE.USED ELSE X = "WHERE.USED" ;GOTO 9101 NEWFILE = 1 END OPEN 'DICT',"WHERE.USED" TO DSL ELSE X = "DICT WHERE.USED" ;GOTO 9101 IF NEWFILE THEN GOSUB CREATE.DICT.IDS END * * Initaialise Variables * ULINE = "=========================================================" * * Enter your Program Filenames to be processed * * FILES = "PROGFILE1":VM:"PROGFILE2":VM:"PROGFILE3":VM:"PROGFILE4":VM:"PROGFILE5" FILES = '' NO.OF.FILES = DCOUNT(FILES<1>,VM) * * Enter any Program Names to be excluded or leave as NULL * * EXCLUDE = 'RKEYS':VM:'FKEYS':VM * EXCLUDE = '' EXCLUDE = '=':VM:'THEN' ;* Leave this line in * * Main Routine * 3 CRT CHAR(12) CRT @(21,2):"PROGRAM WHERE USED BUILDER": IF FILES EQ '' THEN 5 CRT @(1,23):"Program File Name ( to Quit) ":SPACE(40):@(40,23): INPUT PLIB,30: NO.OF.FILES = 1 FILES = PLIB IF PLIB = "" THEN GOTO END.OF.JOB END CLEARFILE WHERE.USED WRITE '' ON DSL,'INDEX' * FOR JJ = 1 TO NO.OF.FILES PLIB = FILES<1,JJ> OPEN PLIB TO CCB(JJ) ELSE CRT @(5,21):"File name '":PLIB:"' entered is not Valid - Press RTN ":;INPUT TX,2 CRT @(5,21):SPACE(79) GOTO 5 END CRT @(5,10):'Processing File ':PLIB 'L#30': * STMNT = 'SSELECT ':PLIB:" GT '1'" EXECUTE STMNT * PERFORM STMNT RTNLIST ; * MDIS CNT = 0 FINISHED = 0 LOOP READNEXT ID ELSE FINISHED = 1 UNTIL FINISHED DO READ PROGREC FROM CCB(JJ),ID THEN * * Build up Program Information * DESCTEXT = '' COMPLETED = 0 * * Pick up Prog details and Informative Text * FOR TLINE = 1 TO 50 UNTIL COMPLETED IF PROGREC[1,1] = '*' THEN DESCTEXT<1,-1> = PROGREC[2,99] END ELSE IF TLINE = 1 THEN IF COUNT(PROGREC,'SUBROUTINE') THEN DESCTEXT<1,-1> = PROGREC END ELSE IF TLINE GT 3 THEN COMPLETED = 1 ;* Allows for 3 lines of Subroutine Parameters END END END NEXT TLINE * CNT = CNT + 1 CRT @(5,14):'Records Processed : ':CNT 'R#4' FILESTRING = "" WRITEVSTRING = '' WRITESTRING = '' READVSTRING = '' READSTRING = '' SORTSTRING = '' LISTSTRING = '' SELECTSTRING = '' WRITEVFLAG = COUNT(PROGREC,'WRITEV ') WRITEFLAG = COUNT(PROGREC,'WRITE ') READVFLAG = COUNT(PROGREC,'READV ') READFLAG = COUNT(PROGREC,'READ ') SORT.FLAG = COUNT(PROGREC,'SORT ') LIST.FLAG = COUNT(PROGREC,'LIST ') SELECT.FLAG = COUNT(PROGREC,'SELECT ') * CRT @(5,12):'Program Id - ':ID'L#30': READ MAINDET FROM WHERE.USED, ID ELSE MAINDET = '' ** IF COUNT(PROGREC,"CALL ") THEN MAINDET<15> = DESCTEXT NO.OF.LINES = DCOUNT(PROGREC,AM) FOR LINE = 1 TO NO.OF.LINES DET = PROGREC IF TRIM(DET,' ','L')[1,1] NE '*' THEN FNAME = '' * * Look for Files being OPENed * IF COUNT(DET,'OPEN') THEN DET = CONVERT(DET,'"','') DET = CONVERT(DET,"'",'') DET = CONVERT(DET,',','') DET = TRIM(DET) CHK = FIELD(DET,' ',1) IF CHK = 'OPEN' THEN FNAME = FIELD(DET,' ',2) IF FNAME = 'DICT' THEN FNAME = 'D-':FIELD(DET,' ',3) END FILESTRING<1,1,-1> = FNAME END END * * Look for WRITEV's * IF COUNT(DET,'WRITEV ') THEN DET = TRIM(DET) WRITEVSTRING<1,1,-1> = DET WRITEVSTRING<2,1,-1> = LINE END * * Look for WRITE's * IF COUNT(DET,'WRITE ') THEN DET = TRIM(DET) WRITESTRING<1,1,-1> = DET WRITESTRING<2,1,-1> = LINE END * * Look for READV's * IF COUNT(DET,'READV ') THEN DET = TRIM(DET) READVSTRING<1,1,-1> = DET READVSTRING<2,1,-1> = LINE END * * Look for READ's * IF COUNT(DET,'READ ') THEN DET = TRIM(DET) READSTRING<1,1,-1> = DET READSTRING<2,1,-1> = LINE END * * Look for SORT's * IF COUNT(DET,'SORT ') THEN DET = TRIM(DET) SORTSTRING<1,-1> = DET SORTSTRING<2,-1> = LINE END * * Look for LIST's * IF COUNT(DET,'LIST ') THEN DET = TRIM(DET) LISTSTRING<1,-1> = DET LISTSTRING<2,-1> = LINE END * * Look for SELECTS's * IF COUNT(DET,'SELECT ') THEN DET = TRIM(DET) SELECTSTRING<1,-1> = DET SELECTSTRING<2,-1> = LINE END * * Look for Programs being CALLed * IF COUNT(DET,"CALL ") THEN DET = CONVERT(DET,';','(') DET = TRIM(DET) G = LEN(DET) CALL.POS = INDEX(DET,"CALL ",1) DET = DET[CALL.POS,999] CALL.POS = 1 IF CALL.POS = 1 THEN CALLBIT = FIELD(DET,'(',1) PROGNAME = FIELD(CALLBIT,' ',2) LOCATE PROGNAME IN EXCLUDE<1> SETTING POS ELSE * * Uses Update * LOCATE PROGNAME IN MAINDET<4> BY 'AL' SETTING POSN ELSE INS PROGNAME BEFORE MAINDET<4,POSN> INS '' BEFORE MAINDET<5,POSN> END MAINDET<5,POSN,-1> = LINE IF FNAME # "" THEN MAINDET<6,POSN,-1> = FNAME END * * Where Used Update * READ WHEREDET FROM WHERE.USED, PROGNAME ELSE WHEREDET = '' * LOCATE ID IN WHEREDET<2>,1 BY 'AL' SETTING FOUNDIT ELSE INS ID BEFORE WHEREDET<2,FOUNDIT> INS '' BEFORE WHEREDET<3,FOUNDIT> END WHEREDET<3,FOUNDIT,-1> = LINE WRITE WHEREDET ON WHERE.USED, PROGNAME END END END END NEXT LINE * ** IF MAINDET # "" THEN MAINDET<1> = PLIB IF FILESTRING NE '' THEN MAINDET<6,1> = FILESTRING END * * Update WRITE & WRITEV information * IF WRITEVSTRING NE '' THEN MAINDET<7,1> = WRITEVSTRING<1> ;* Code MAINDET<8,1> = WRITEVSTRING<2> END * IF WRITESTRING NE '' THEN MAINDET<9,1> = WRITESTRING<1> ;* Code MAINDET<10,1> = WRITESTRING<2> END * * Update READ & READV information * IF READVSTRING NE '' THEN MAINDET<11,1> = READVSTRING<1> ;* Code MAINDET<12,1> = READVSTRING<2> END * IF READSTRING NE '' THEN MAINDET<13,1> = READSTRING<1> ;* Code MAINDET<14,1> = READSTRING<2> END * * Update LIST & SORT information * IF LISTSTRING NE '' THEN MAINDET<19,1> = LISTSTRING<1> ;* Code MAINDET<20,1> = LISTSTRING<2> END * IF SORTSTRING NE '' THEN MAINDET<21,1> = SORTSTRING<1> ;* Code MAINDET<22,1> = SORTSTRING<2> END * * Update SELECT information * IF SELECTSTRING NE '' THEN MAINDET<23,1> = SELECTSTRING<1> ;* Code MAINDET<24,1> = SELECTSTRING<2> END WRITE MAINDET ON WHERE.USED,ID * * Where File Used Update * NO.OF.ITMS = DCOUNT(FILESTRING<1,1>,SVM) FOR XX = 1 TO NO.OF.ITMS FNAME = FILESTRING<1,1,XX> IF FNAME NE '' THEN READ WHEREDET FROM WHERE.USED, FNAME ELSE WHEREDET = 'FILE' END LOCATE ID IN WHEREDET<2> BY 'AL' SETTING FOUNDIT ELSE INS ID BEFORE WHEREDET<2,FOUNDIT> INS LINE BEFORE WHEREDET<3,FOUNDIT> END WRITE WHEREDET ON WHERE.USED, FNAME END NEXT XX END REPEAT NEXT JJ WRITEV DATE() ON DSL,'LAST.UPDATE',1 * End of Run Procedures * END.OF.JOB: * ---------- PRINT CHAR(12) STOP CREATE.DICT.IDS: * --------------- IDS = "0":VM:"1":VM:"2":VM:"3":VM:"4":VM:"5":VM:"6":VM:"15":VM:"16":VM:"17":VM:"19":VM:"20":VM:"21":VM:"22":VM:"23":VM:"24" DESC = "Id":VM:"Progran File":VM:"Usedin Program":VM:"@ Line":VM:"Program Calls":VM:"@ Line":VM:"Files Open" DESC = DESC : VM:"Program Information":VM:"Calling PROC":VM:"Menu Heading":VM:"LIST Stastements" DESC = DESC : VM:"LIST Line Numbers":VM:"SORT Statements":VM:"SORT Line Numbers":VM:"SELECT Statements":VM:"SELECT Line Numbers" JUST = "L":VM:"L":VM:"L":VM:"R":VM:"L":VM:"R":VM:"L":VM:"L":VM:"L":VM:"L":VM:"L":VM:"L":VM:"L":VM:"L":VM:"L":VM:"L":VM:"L" LGTH = "15":VM:"13":VM:"15":VM:"6":VM:"15":VM:"6":VM:"25":VM:"70":VM:"10":VM:"20":VM:"10":VM:"10":VM:"10":VM:"10":VM:"10":VM:"10" ITMS = DCOUNT(IDS,VM) FOR XX = 1 TO ITMS DET = 'S' DET<2> = IDS<1,XX> DET<3> = DESC<1,XX> DET<9> = JUST<1,XX> DET<10> = LGTH<1,XX> WRITE DET ON DSL,IDS<1,XX> NEXT XX RETURN * 9101 MESS = "Cannot Open File ":X ;GOTO 9999 * * Fatal Error Routines * 9999 CRT @(0,23):EOL:@(5,23):REVON:MESS:REVOFF: INPUT ANS,1: END