LOGICAL*1 FUNCTION USER_CHECK(USERNAME) IMPLICIT NONE C C Module: USERNAME NAME CHECK C C Original: George H. Walrod III C C Purpose: Check Username Name For Correct Syntax and Make Check C Entry into Username Table C C Arguments: C USERNAME : Username Name C C Corrected Modification: C None C Notes: C None C * INCLUDE 'WATCHUSER.INC' ! Username Common INCLUDE 'WATCHREC.INC' ! Record Common * PARAMETER + WILDCARD = '*' ! Wild Card Character LOGICAL*1 + FOUND_WILDCARD ! Wild Card Indicator CHARACTER + USERNAME*(*), ! Username Name + NEW_USERNAME*(MAX_USERNAME_LEN) ! New Username Name INTEGER*2 + USER_PTR, ! Username String PTR + NEWUSER_PTR ! New Username String PTR 800 FORMAT(' ERROR ON LINE ',I5,' ',A,A) * C C Initialize Pointers and Strings C FOUND_WILDCARD = .false. USER_CHECK = .false. USER_PTR = 1 NEWUSER_PTR = 1 NEW_USERNAME = ' ' C C Check for the Maximum Length of Username Name C IF (LEN(USERNAME) .gt. MAX_USERNAME_LEN) THEN WRITE (6,800) LINE, + 'USERNAME NAME IS TO LONG ', USERNAME GOTO 999 END IF C C Check For Username Names of Wildcard C IF ((LEN(USERNAME) .eq. 1) .and. + (USERNAME(1:1) .eq. WILDCARD)) THEN WRITE (6,800) LINE, + 'USERNAME NAME CAN NOT JUST BE WILDCARD ', USERNAME GOTO 999 END IF C C Move the Username Name or Any Part of It, Til to Wildcard or EOSTR C DO WHILE ((USERNAME(USER_PTR:USER_PTR) .ne. WILDCARD) .and. + (USER_PTR .le. LEN(USERNAME))) NEW_USERNAME(NEWUSER_PTR:NEWUSER_PTR) = + USERNAME(USER_PTR:USER_PTR) NEWUSER_PTR = NEWUSER_PTR + 1 USER_PTR = USER_PTR + 1 END DO C C Wild Cards are Only Permitted for in the Front or End of Username Name C IF ((USERNAME(USER_PTR:USER_PTR) .eq. WILDCARD) .and. + ((USER_PTR .gt. 1) .and. (USER_PTR .lt. LEN(USERNAME)))) THEN WRITE (6,800) LINE, + 'WILD CARDS ARE NOT PERMITTED IN '// + 'THE MIDDLE OF USERNAME NAMES ', + USERNAME GOTO 999 END IF C C Previously Found a Wildcard first so Move Rest of String C IF (USER_PTR .eq. 1) THEN FOUND_WILDCARD = .true. NEW_USERNAME(1:LEN(USERNAME)-1) = USERNAME(2:LEN(USERNAME)) NEWUSER_PTR = -1 * (LEN(USERNAME) - 1) END IF C C Previously Found a Wildcard at End so Just Set Length C IF (USERNAME(USER_PTR:USER_PTR) .eq. WILDCARD) THEN FOUND_WILDCARD = .true. NEWUSER_PTR = LEN(USERNAME) - 1 END IF C C Make Sure There is Room For Another Username Entry in Table C IF (MAX_USERNAME+1 .gt. MAX_NO_USERNAME) THEN WRITE (6,800) LINE, + 'MAXIMUM NUMBERS OF USERNAME RESTRICTIONS EXCEEDED',' ' GOTO 999 ELSE MAX_USERNAME = MAX_USERNAME + 1 END IF C C Set Wildcard Flag if Necessary C USERNAME_LIST(MAX_USERNAME).WILDCARD = .false. IF (FOUND_WILDCARD) THEN USERNAME_LIST(MAX_USERNAME).WILDCARD = .true. END IF C C Store Length and Name C IF (NEWUSER_PTR .lt. 0) THEN USERNAME_LIST(MAX_USERNAME).NAME = NEW_USERNAME(1:NEWUSER_PTR*-1) ELSE USERNAME_LIST(MAX_USERNAME).NAME = NEW_USERNAME(1:NEWUSER_PTR) END IF USERNAME_LIST(MAX_USERNAME).LENGTH = NEWUSER_PTR USER_CHECK = .true. 999 CONTINUE RETURN END