! This is "Freeware". The program is published for everyone to look
! at and try. If you like it and can use it PLEASE send $5.00 to:
! DAVID W. BARROW III
! 1894 Elm Drive
! West Bend, WI 53095
! If you have questions or problems with this program you may call
! (414) 375-AMOS evenings and weekends
!
! UTBASD.BAS - UTility BASic Directory
!
! This program takes a directory file produced by
! DIR/F BASIC.DIR=ALL:*.BAS[] and will then go thru those source
! files and get the top few lines and print the information out
! to UTBASD.LST. If you want to change the scope of the search
! just change the DIR specifications to limit to a DSK or a P,PN
!
! To run this under control of Task Manager set up the following
! .CTL file and submit it
! $; UTBASD.CTL - Submits the UTility BASic Directory
! $; Log into the system
! LOG SYS:
! $; Generate the system directory
! DIR/F BASIC.DIR=ALL:*.BAS[]
! $; Yes I do want to run this program
! Y
! $; No I don't want a screen counter
! N
! $; Were all done
! LOGOFF
!
! Copyright @1985 by David W. Barrow III
!
! Date Who S What
!-------- --- - ---------------------------------------------------
!04-21-85 DWB A Original Coding
!04-27-85 DWB B Cleanup, standardize
!
MAP1 VERSION,S,9,"VER042785"
PROGRAM BASDIR,85.04B(27)
MAP1 MISC'FP'MAPS
MAP2 COUNTER,F,6,0 ! Loop counter
MAP2 END'POS,F,6,0 ! INSTR ending position
MAP2 EXIST,F,6,0 ! answer from lookup
MAP2 NAME'LEN,F,6,0 ! Length of program name
MAP2 ST'POS,F,6,0 ! INSTR starting position
MAP1 MISC'STR'MAPS
MAP2 CONTINUE,S,1,"N" ! Answer to continue
MAP2 LOGICAL$,S,2,SPACE$(2) ! STR$ of Logical# (##)
MAP2 P$,S,3,SPACE$(3) ! STR$ of project# (###)
MAP2 PN$,S,3,SPACE$(3) ! STR$ of programmer# (###)
MAP2 SCR'CNTR,S,1,"N" ! Screen counter?
MAP2 SOURCE'LINE,S,132, SPACE$(132) ! Line from source program
MAP2 TGT'FILESPEC,S,26,SPACE$(26) ! DSK??:XXXXXX.XXX[XXX,XXX]
! HOUSEKEEPING:
! Standard Error Routine
ON ERROR GOTO ERR'ROUTINE
! Announce program
PRINT TAB(-1,0) ! Clear the screen
PRINT TAB(03,17); "UTBASD.BAS - UTility BASic Directory"
PRINT TAB(05,01); "This program takes a directory file " &
"produced by DIR/F BASIC.DIR=ALL:*.BAS[]"
PRINT TAB(06,01); "and will then go thru those source files "; &
"and get the top few lines"
PRINT TAB(07,01); "and print the information out to UTBASD.LST"
! Check to see if this is the right program to run
PRINT TAB(09,10); "Do you really want to run THIS program (Y/N) ";
INPUT CONTINUE
IF ( CONTINUE # "Y" ) &
THEN GOTO NO'RUN'EXIT
PRINT TAB(11,10); "Do you want a screen counter (Y/N) ";
INPUT SCR'CNTR
LOOKUP "BASIC.DIR", EXIST
IF ( EXIST = 0 ) &
THEN PRINT TAB(10,15); "Directory file doesn't exist" &
: GOTO EXIT
OPEN #1, "BASIC.DIR", INPUT
OPEN #2, "UTBASD.LST", OUTPUT
! MAINLINE:
FOR COUNTER = 1 TO 1000
! Blank directory record to avoid carryover
DIRECTORY'RECORD = SPACE$(80)
! Get another .BAS file from the directory
INPUT LINE #1, DIRECTORY'RECORD
! Check for end of file
IF ( EOF(1) = 1 ) &
THEN COUNTER = 1000 &
: GOTO NEXT'RECORD
! Screen counter every 5 files
IF ( SCR'CNTR = "Y" ) &
AND INT(COUNTER/5) = (COUNTER/5) &
THEN PRINT TAB(15,35); COUNTER
! take care of the blank lines between the ppns
IF ( DIRECTORY'RECORD[1,20] = SPACE$(20) ) &
THEN GOTO NEXT'RECORD
! Take care of the total lines
IF ( DIRECTORY'RECORD[1,5] = "Total" ) &
THEN PRINT #2, DIRECTORY'RECORD &
: PRINT #2 &
: GOTO NEXT'RECORD
! Grand total line says we're finished
IF ( DIRECTORY'RECORD[1,5] = "Grand" ) &
THEN PRINT #2, DIRECTORY'RECORD &
: PRINT #2 &
: COUNTER = 1000 &
: GOTO NEXT'RECORD
PRINT #2, DIRECTORY'RECORD
CALL FIX'FILESPEC
IF ( TGT'FILESPEC[7,7] ="." ) &
THEN GOTO NEXT'RECORD
! Open the file, get the wanted info, close it
OPEN #3, TGT'FILESPEC, INPUT
CALL DIR'LINE
CLOSE #3
NEXT'RECORD:
! put a line between entries
PRINT #2
NEXT COUNTER
EXIT:
CLOSE #1
! We won't need the system directory any more
! LOOKUP "BASIC.DIR", EXIST
! IF ( EXIST # 0 ) &
! THEN KILL "BASIC.DIR"
CLOSE #2
XCALL SPOOL, "UTBASD.LST", "",17
NO'RUN'EXIT:
END
!!!!!!!!!!!!!!!!!!!!!!!
! PROGRAM SUBROUTINES !
!!!!!!!!!!!!!!!!!!!!!!!
DIR'LINE:
! Get a line of the source program
INPUT LINE #3, SOURCE'LINE
! Check to see if we have run out of comments
IF ( SOURCE'LINE[1,1] # "!" ) &
THEN RETURN
! Output the line from the .BAS file to the listing
PRINT #2, SOURCE'LINE
GOTO DIR'LINE
! this is the end of DIR'LINE subroutine
FIX'FILESPEC: ! Gets full filespecification into a form I can use
! Program name - get right length to avoid spaces
! Don't have to get a starting position starts in col. 1
END'POS = INSTR(1,DIRECTORY'RECORD," ")
DR'NAME = DIRECTORY'RECORD[1,(END'POS-1)]
! see if log info on this line - if not default to prev. info
IF ( DIRECTORY'RECORD[65,65] = " " ) &
THEN GOTO ASSEMBLE'FILESPEC
! Logical surface number - won't work if logical isn't XXK
ST'POS = INSTR(63,DIRECTORY'RECORD,"K")
END'POS = INSTR(63,DIRECTORY'RECORD,":")
LOGICAL$ = VAL(DIRECTORY'RECORD[(ST'POS+1),(END'POS-1)]) USING "#Z"
! Project number
ST'POS = INSTR(63,DIRECTORY'RECORD,"[")
END'POS = INSTR(63,DIRECTORY'RECORD,",")
P$ = VAL(DIRECTORY'RECORD[(ST'POS+1),(END'POS-1)]) USING "#ZZ"
! Programmer number
ST'POS = INSTR(1,DIRECTORY'RECORD,",")
END'POS = INSTR(1,DIRECTORY'RECORD,"]")
PN$ = VAL(DIRECTORY'RECORD[(ST'POS+1),(END'POS-1)]) USING "#ZZ"
