!*! Updated on 24-May-95 at 11:59 PM by James A. Jarboe I V; edit time: 0:58:53
!
! 
! d/BASIC example of how to read USER.SYS without knowing the users
! name and use FNDUSR.SBR to do it to return variable information
! properly.
!
! Edit history:
! [100] 24-May-95 designed and implemented by James A. Jarboe IV 
!                 to display reading USER.SYS without knowing user
!                 name and then using the found names to utilize
!                 FNDUSR.SBR because FNDUSR.SBR returns the offsets
!                 information in basic readable Floating point and 
!                 strings so we don't have to do the RAD50 unpacks
!                 and/or binary conversions.
! 
! -NOTES-
!
! COMPIL with COMPIL USRSYS/P to create USRSYS.LIT
!  which will make possible to run as USRSYS from the AMOS dot.
!
!
PROGRAM USRSYS, 1.0(100)
!
! Define AMOS Map for FNDUSR.
!
MAP1 USER'MAP
	MAP2 USER'NAME,         S, 20
	MAP2 USER'FLAGS,        F, 6
	MAP2 USER'ROOT'PPN,     S, 10
	MAP2 USER'ROOT'DEVICE,  S, 10
	MAP2 USER'MAIL'PPN,     S, 10
	MAP2 USER'MAIL'DEVICE,  S, 10
	MAP2 USER'MAIL'CPU,     S, 10
	MAP2 USER'PRIV,         F
	MAP2 USER'CLASS,        F
	MAP2 USER'EXP,          F
	MAP2 USER'CPU'TIME,     F
	MAP2 USER'CONNECT'TIME, F
	MAP2 USER'KRAM,         F
	MAP2 USER'DISK'READS,   F
	MAP2 USER'DISK'WRITES,  F
	MAP2 USER'PAGES'PRINT,  F
	MAP2 USER'DFT'PROTECT,  F
	MAP2 USER'DFT'PRIORITY, F
	MAP2 USER'DFT'LANGUAGE, S, 20
	MAP2 USER'DFT'PROMPT,   S, 20


! Define XCALL FNDUSR.SBR Errors to report.
!
MAP1 XC'ERR(4), S, 36
	XC'ERR(1) = "Insufficient Memory for FNDUSR.SBR"
	XC'ERR(2) = "Read File error in USER.SYS"
	XC'ERR(4) = "Unable to locate user."	

! Define maps for getting user name from USER.SYS
!
MAP1 USER'DATA, X, 512			! Each Block in USER.SYS.
MAP1 USER'REC,@USER'DATA                
	MAP2 USER'NAME(4), X, 128       ! Each Record in a block (4).

MAP1 LOGON, S, 10			! Current logon variable.

! Storage for Found user names.
! (Always make upper case so that sorting will always sort properly.
! We will display what we find which may be Upper/lower case.
!
MAP1 GOOD'USER(1000), S, 22	        ! Room for 1000 records+null
	                                ! Adapt to taste.


! Define misc Floating point numbers we will use.
!
FLOAT FILE1, COUNT, USER'NUM, X, STATUS, X'ERROR, ANYKEY
   

! Report all errors.
!
	on ERROR goto ERR'RPT

! Set file base to 1
!
   FILEBASE 1

! Use d/basic read'only variables to 
! check for logon. Must be logged into OPR to run.
!
   LOGON = .device+"["+.account+"]"

! Report if user not in OPR: in low and high intensity.
!
   when LOGON <> "DSK0:[1,2]"
	 dual.print "%Must be _logged_ in to _OPR:_ to run _USRSYS_"
	 end
   wend


! Open file Exclusive like LOG and MUSER do but only while we are reading
! it then close it to allow others to access it. (Although FNDUSR will
! also lock it exclusively.
!
   open #1,"USER.SYS", random, 512, FILE1

   USER'NUM = 0	  		! Preset user number for storage of found name.
   FILE1 = 1 			! Preset index block of USER.SYS to skip.

! Read through file until we are finished.
!
   do FILE1+=1 until FILE1 = 0

	read #1, USER'DATA
	   COUNT = 0
	   do COUNT+=1 until COUNT > 4

              when USER'NAME(COUNT)[1,4] = null$(4)
                  FILE1 = -1    ! Set so next loop will be 0
                  break         ! break out of this do loop.
	      else
	  	  USER'NUM+=1      
                  GOOD'USER(USER'NUM) = UCS(rtrim(USER'NAME(COUNT)))
	      wend

           enddo
   enddo

! Close data file.
!
   CLOSE #1

! Use d/basic in memory sort if we find more than 1 user.
!
   when COUNT > 1
	 sort.memory USER'NUM records of GOOD'USER(1) using GOOD'USER(1)
   wend
   X=0

! Do the xcall and reporting for all records we found.
!
   do X+=1 until X > USER'NUM

	xcall FNDUSR, GOOD'USER(X), STATUS, USER'MAP
	when STATUS = 0
	     call PRINT'USER
	else
	     call XCALL'ERROR
		when STATUS < 0
			end
		wend
	wend
   enddo
   
FINI:
	? "Finished"
	END

! Print out what or how you want.
!
PRINT'USER:

! Print it in columns.
!
	? ljust(USER'NAME,24); 		! Left justify within 24 chars.
	? rjust(USER'ROOT'DEVICE,10);   ! Right justify within 10 chars.
	? ljust(USER'ROOT'PPN,12);      ! left justify within 12 chars.
	?
	return

! Report XCALL ERROR, Pause and return 
!
XCALL'ERROR:
	X'ERROR = STATUS + 3
	? chr$(7)
	dual.print tab(24,1);"%_XCALL_ Error:_";XC'ERR(X'ERROR);" ";
	? "..Press any key to continue";tab(-1,29);

	reset echo			! Disable terminal input echo
	ANYKEY = getkey(-1) 		! Wait for any key.
	set echo			! Enable terminal input echo.
	? tab(-1,28);			! Turn cursor back on.
	return				! Return to caller.

! Use d/basic's English language error reporting.
!
ERR'RPT:
	dual.print "%_Error_:_";ERRMSG(ERR(0))
	end