!	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	DIRECTORY'RECORD	! Produced by DIR/F BASIC.DIR=ALL:.BAS[]
	MAP2	DR'NAME,S,7,SAPCE$(7)		!0-6   NNNNNN_
	MAP2	DR'EXT,S,4,SPACE$(4)		!7-10  NNN_
	MAP2	DR'CONTIG,S,2,SPACE#(2)		!11-12 C_
	MAP2	DR'BLOCKS,S,6,SPACE$(6)		!13-18 XXXXX_
	MAP2	DR'HASH,S,16,SPACE$(16)		!19-34 XXX-XXX-XXX-XXX
	MAP2	DR'VERSION,S,22,SPACE$(22)	!35-56 XX.XXN(XX)
	MAP2	DR'BASE,S,6,SPACE$(6)		!57-63 XXXXXXX_
	MAP2	DR'LOG,S,16,SPACE$(16)		!64-79 DSK??:[XXX,XXX]

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"

ASSEMBLE'FILESPEC:
	TGT'FILESPEC = DIRECTORY'RECORD[65,67] + LOGICAL$ + ":"		&
			+ DR'NAME + ".BAS"				&
			+ "[" + P$ + "," + PN$ + "]"
	RETURN			! End of FIX'FILESPEC subroutine


			!!!!!!!!!!!!!!!!!!!!!!!!
			! STANDARD SUBROUTINES !
			!!!!!!!!!!!!!!!!!!!!!!!!

ERR'ROUTINE:
	! Check for AlphaBASIC error
		IF	( ERR(0) = 0 )		&
		THEN	GOTO ISAM'ERROR
	! Display Basic error
	PRINT TAB(16,15); "?? Fatal AlphaBASIC Error "; STR$(ERR(0))
		IF	( ERR(1) )				&
		THEN	PRINT " at line "; STR$(ERR(1))
		IF	( ERR(2) )				&
		THEN	PRINT " on Channel "; STR$(ERR(2))
	GOTO ERROR'ABORT

ISAM'ERROR:
!		IF	(

ERROR'ABORT:
	PRINT
	PRINT CHR$(7) : PRINT CHR$(7)
	PRINT "!! Contact System Operator Immediately !!"
	PRINT
	GOTO EXIT
!			*******	END OF UTBASD.SUB *******