C
C
C	This is the remove account subroutine of the Account 
C	Management Program.  The purpose of this routine is to 
C	read from a specified file the output of a search on the 
C	SysUaf.lis file in Sys$System.  The routine will create 
C	three files,
C		1]  RemDir.com	To tree delete their sys$login
C				directory.
C		2]  RemQuo.com	To remove their quotas from the 
C				system.
C		3]  RemAct.com	To remove their accounts from the
C				system UAF file.
C	These file will be activated in a batch job; so as to free
C	the user to perform other meaningless tasks.
C
C

	Subroutine Remove(CommandIn)

	Character*20 CommandIn
	Character*60 file
	Character*132 line
	Integer      Count
	Integer      length
	Character*12 UserName
	Character*11 Uic
	Character*35 Directory
	Character*15 disk
	Logical*1    Confirm
	Character    Answer
	Integer      len
	Integer      error
	Logical*1    In_Progress

	external lib$do_command

	Parameter ( screen=1,InFile=2 )

C	Check to see if a MAKALL is in Progress
	inquire (file='MAKACT_WORK:REMOVE_IN_PROGRESS.TEMP',
     +	exist=In_Progress)
	if (In_Progress) then
		write (screen,1)
1		format (1x,'%%%%% REMALL Currently in the',
     +		' Batch Queue.',/,1x,'%%%%% REMOVE NOT permitted')
		goto 999
	end if

	Confirm=.false.
C	Check For Confirm
	call str$upcase(CommandIn,CommandIn)
	if(index(CommandIn,'/CONFIRM') .ne. 0) then
		confirm=.true.
	end if
	Count=0
	

409	write (screen,410)
410	format (1x,'File    = ',$)
	read (screen,411,err=999) length,file
411	format (Q,A)
	if (length .eq. 0) goto 409

	Open (unit=InFile,file=file(1:length),readonly,
     +	status='old',form='formatted',carriagecontrol='list',
     +  err=490)

420	read (InFile,421,end=480) length,line
421	format (Q,A)


	if (Parse(line,length,Directory,disk,Uic,Username) .ge. 1) goto 488

	if ( Confirm ) then
		write(screen,423) Username,Uic,Directory
423		format (5x,'Username',7x,'Uic',33x,'Directory',
     +		/,5x,'--------',7x,'---',33x,'---------',
     +		/,1x,1A12,5x,1A11,1x,1A35)
		write (screen,425)
425		format (1x,'Continue [N] ? ',$)
		read (screen,427,err=1001) len,Answer
427		format (Q,A)
		Call str$upcase(Answer,Answer)
		if (len .eq. 0) goto 420
		if (Answer(1:1) .ne. 'Y') goto 420
	end if
	if (Count .eq. 0) call OpenAll
	call WriteAll(Directory,disk,Uic,Username)
	Count=Count+1

	goto 420

480	close (InFile)
	if (Count .ne. 0) then
		call CloseAll
		write (screen,479)
479		format (1x,'%%%%% Batch Job Submitted')
		call lib$do_command('@MAKACT_WORK:REMALL.COM')
	end if
	Return

488	if (Count .ge. 1) call CloseAll
	write (screen,489) file,line
489	format (1x,'%%%%% ERROR in Processing File ',1A30,/,
     +	1x,'%%%%% On Line ',/,
     +	1x,1A132,/,
     +	1x,'%%%%% Batch Job NOT Submitted',/)
	close (InFile)
	Return

1001	if (Count .ge. 1) call CloseAll
	Return
	

490	write (screen,491) file
491	format (1x,'%%%%% ERROR in Opening File Name ',1A30,/,
     +	'%%%%%% Or Associated Files')
	close (InFile)
	goto 409

999	end

C This is a routine to close all the open files used by remove
C it also writes out the closing statements for the .COM files.

	Subroutine CloseAll

	Parameter ( RemDir=3,RemQuo=4,RemAct=6 )

C	Close the files
	write (RemAct,10)
10	format ('LIST')
	write (RemQuo,11)
	write (RemAct,11)
11	format ('EXIT')
	write (RemDir,12)
	write (RemQuo,12)
	write (RemAct,12)
12	format ('$ SET DEFAULT ''SAVE_DEFAULT''',/,'$ EXIT')
	close (RemAct)
	close (RemQuo)
	close (RemDir)

	Return
	end

C This routine opens all the files and initializes them
C for their mission in life.

	Subroutine OpenAll

	Character*9 TheDate
	Character*8 TheTime

	Parameter ( RemDir=3,RemQuo=4,RemAct=6 )

	Open (unit=RemAct,file='MAKACT_WORK:REMACT.COM',
     +	status='new',form='formatted',carriagecontrol='list')
	Open (unit=RemQuo,file='MAKACT_WORK:REMQUO.COM',
     +	status='new',form='formatted',carriagecontrol='list')
	Open (unit=RemDir,file='MAKACT_WORK:REMDIR.COM',
     +	status='new',form='formatted',carriagecontrol='list')

	Call Date(TheDate)
	Call Time(TheTime)

C	Init the Files
	write (RemDir,21) TheDate,TheTime
	write (RemAct,21) TheDate,TheTime
	write (RemQuo,21) TheDate,TheTime
21	format ('$! Procedure generated to delete users from the system.'
     +	,/,'$! Generated on ',1A9,' at ',1A8,/,
     +	'$ SAVE_DEFAULT:=''F$LOGICAL("SYS$DISK")''''F$DIRECTORY()'' ')
	write (RemQuo,22)
22	format ('$ SET DEFAULT SYS$SYSTEM',/,'$ RUN DISKQUOTA')
	write (RemAct,23)
23	format ('$ SET DEFAULT SYS$SYSTEM',/,'$ SET UIC [1,4]',/,
     +  '$ RUN AUTHORIZE')

	Return
	end

C This routine writes out all the information to the individual files
C such as the disk name to the RemQuo file.
	Subroutine WriteAll(Directory,disk,Uic,Username)

	Character*35 Directory
	Character*15 disk
	Character*12 Uic,Username

	Parameter ( RemDir=3,RemQuo=4,RemAct=6 )

	write (RemDir,1) Directory
1	format ('$ @MAKACT_WORK:TREEDEL ',1A35)
	write (RemQuo,2) disk,Uic
2	format ('USE ',1A15,/,'REMOVE ',1A12)
	write (RemAct,3) Username
3	format ('REMOVE ',1A12)

	Return
	end

C The purpose of this routine is to parse the read line into
C the proper components such as Uic, directory, ect. also this
C will pass back an integer value greater than 0 if there is an 
C error in processing the file

	Function Parse(line,length,Directory,disk,Uic,Username)

	Character*132 line
	Integer      length
	Character*12 UserName
	Character*11 Uic
	Character*35 Directory
	Character*15 disk
	Integer      position

	Parse=0

	Directory(1:35)='                                   '
	Username(1:12)='            '
	Uic(1:11)='           '
	disk(1:15)='               '

C	Get the Default Directory
	position=35
	Do while (line(length:length) .ne. ' ')
		Directory(position:position)=line(length:length)
		position=position-1
		length=length-1
	end Do

C	Get the Default Disk
	position=15
	length=index(Directory,':')
	Do while (Directory(length:length) .ne. ' ')
		if (position .eq. 0) Parse=1		! Error Check
		Disk(position:position)=Directory(length:length)
		position=position-1
		length=length-1
	end Do

C	Get the Uic
	position=index(line,'[')
	if (position .eq. 0) Parse=1			! Error Check
	if (index(line,']') .gt. position+12) Parse=1	! Error Check
	if (index(line,',') .eq. 0) Parse=1		! Error Check
	Uic(1:11)=line(position:position+11)

C	Get the Username
	position= position-1
	Do while (line(position:position) .eq. ' ')
		position=position-1
	end Do
	Username(1:12)=line(position-11:position+1)

	Return
	end

C
C	This is the routine to remove the users input from an
C	interactive session.
C
	Subroutine RemoveSing

	Parameter (screen=1)

	External Lib$Do_Command

	Logical*1	GetInfo
	Character*35	dir
	Character*15	disk
	Character*12	user
	Character*12	uic
	Integer*2	length
	Integer*2	count
	Logical*1	In_Progress

C	Check to see if a REMALL is in Progress
	inquire (file='MAKACT_WORK:REMOVE_IN_PROGRESS.TEMP',
     +	exist=In_Progress)
	if (In_Progress) then
		write (screen,131)
131		format (1x,'%%%%% REMALL Currently in the',
     +		' Batch Queue.',/,1x,'%%%%% REMOVE NOT permitted')
		goto 12000
	end if


	count=0
	call OpenAll

10	user='            '
	write (screen,1)
1	format (1x,'Username> ',$)
	read (screen,2,err=999) length,user
2	format (Q,A)
	if (length .eq. 0) goto 10

	if (GetInfo(user,uic,dir,disk)) then
		call WriteAll(dir,disk,uic,user)
		count=count+1
		else
		write (screen,30)
30		format (1x,'%%%%% Error in finding user')
	end if

	goto 10

999	call CloseAll
	if (count .ge. 1) then
		write (screen,1000)
1000		format (1x,'%%%%% Batch Job Submitted')
		call Lib$Do_Command ('@MAKACT_WORK:REMALL.COM')
	end if

12000	end

C
C	The purpose of this routine is to look up a given username
C	in the UAF and get the default directory and the uic from
C	that particular entry.  If there is a error, for example
C	if that entry doesn't exist or there is a problem in the 
C	UAF then the function returns a FALSE and if nothing went 
C	wrong a true will be returned.
C

	Logical*1 Function GetInfo(username,OutUic,dir,disk)

	Parameter	Rec_len=184
	Parameter	screen=1
	Parameter	Uaf=5
	Parameter	UAF$L_UIC='24'X+1
	Parameter	UAF$T_DEFDEV='74'X+2
	Parameter	UAF$T_DEFDIR='94'X+2

	Character*1	Record(Rec_len)
	Character*12	username
	Character*35	dir
	Character*15	disk
	Character*32	device
	Character*64	TempDir
	Character*12	OutUic
	Character*4	g,m
	Integer*2	uic(2)
	Integer*2	IO_err
	Integer*2	length
	Integer		j,x

	Equivalence (Record(UAF$L_UIC),Uic)
	Equivalence (Record(UAF$T_DEFDEV),device)
	Equivalence (Record(UAF$T_DEFDIR),TempDir)

C	Init the vars
	disk='               '
	dir='                                   '
	OutUic='            '
	g='    '
	m='    '

	call str$upcase(username,username)
	Open(	unit=Uaf, File='sys$system:sysuaf.dat', readonly,
     +		status='old', shared, organization='indexed',
     +		access='keyed', recordtype='variable',
     +		form='unformatted',err=99)

	Read(Uaf, key=username, IOstat=IO_err) Record
	close (Uaf)

C	Check to see if the account exists
	if (IO_err .eq. 36) goto 1000	! Nope it doesn't
	if (IO_err .gt. 0) then		! There was an error in accessing 
99		write (screen,100)	! the Uaf
100		format (1x,'%%%%% Problem with the UAF access !!!')
		GetInfo=.FALSE.		! Return the error code
		Return
	end if

C	Got the Record now build the directory and the UIC
	GetInfo=.TRUE.
	disk=device(1:len(disk))
	dir=device
	j=index(dir,':')
	j=j+1
	dir(j:len(dir))=TempDir(1:len(dir)-j)

	write (unit=m,fmt='(1O4)') uic(1)
	write (unit=g,fmt='(1O4)') uic(2)

	j=1
	Do while (m(j:j) .eq. ' ')
		m(j:j)='0'
		j=j+1
	end do

	j=1
	Do while (g(j:j) .eq. ' ')
		g(j:j)='0'
		j=j+1
	end do

	OutUic(1:1)='['
	OutUic(2:5)=g
	OutUic(6:6)=','
	OutUic(7:10)=m
	OutUic(11:11)=']'

	Return

C	No user account in the UAF
1000	write (screen,1001) username
1001	format (1x,'%%%%% Error in Account ',1A12,' not found in UAF')
	GetInfo=.FALSE.			! No Account Error 

	Return 

	end

