LOGICAL*1 FUNCTION IMAG_CHECK(IMAGE) IMPLICIT NONE C C Module: IMAGE NAME CHECK C C Original: George H. Walrod III C C Purpose: Check Image Name For Correct Syntax and Make Check C Entry into Image Table C C Arguments: C IMAGE : Image Name C C Corrected Modification: C None C Notes: C None C * INCLUDE 'WATCHIMAG.INC' ! Image Common INCLUDE 'WATCHREC.INC' ! Record Common * PARAMETER + DEFAULT_EXT = '.EXE', ! Default Extention + PERIOD = '.', ! Extention Start + WILDCARD = '*' ! Wild Card Character CHARACTER + IMAGE*(*), ! Image Name + NEW_IMAGE*(MAX_IMAGE_LEN) ! New Image Name INTEGER*2 + IMAG_PTR, ! Image String PTR + NEWIMAG_PTR ! New Image String PTR 800 FORMAT(' ERROR ON LINE ',I5,' ',A,A) * C C Initialize Pointers and Strings C IMAG_CHECK = .false. IMAG_PTR = 1 NEWIMAG_PTR = 1 NEW_IMAGE = ' ' C C Check for the Maximum Length of Image Name C IF (LEN(IMAGE) .gt. MAX_IMAGE_LEN) THEN WRITE (6,800) LINE, + 'IMAGE NAME IS TO LONG ', IMAGE GOTO 999 END IF C C Move the Image Name or Any Part of It, Til to Wildcard or EOSTR C DO WHILE (((IMAGE(IMAG_PTR:IMAG_PTR) .ne. WILDCARD) .and. + (IMAGE(IMAG_PTR:IMAG_PTR) .ne. PERIOD)) .and. + (IMAG_PTR .le. LEN(IMAGE))) NEW_IMAGE(NEWIMAG_PTR:NEWIMAG_PTR) = + IMAGE(IMAG_PTR:IMAG_PTR) NEWIMAG_PTR = NEWIMAG_PTR + 1 IMAG_PTR = IMAG_PTR + 1 END DO C C No Wildcards are Allowed on Image Name or Extentions C IF ((IMAGE(IMAG_PTR:IMAG_PTR) .eq. WILDCARD) .or. + (IMAGE(IMAG_PTR:IMAG_PTR) .eq. PERIOD)) THEN WRITE (6,800) LINE, + 'WILDCARDS OR EXTENTION ARE NOT PERMITTED IN IMAGE NAME', + IMAGE GOTO 999 END IF C C Make Sure There is Room For Another Image Entry in Table C IF (MAX_IMAGE+1 .gt. MAX_NO_IMAGE) THEN WRITE (6,800) LINE, + 'MAXIMUM NUMBERS OF IMAGE RESTRICTIONS EXCEEDED',' ' GOTO 999 ELSE MAX_IMAGE = MAX_IMAGE + 1 END IF C C Store Length and Name C NEWIMAG_PTR = NEWIMAG_PTR - 1 IMAGE_LIST(MAX_IMAGE).NAME(1:NEWIMAG_PTR+4) = + NEW_IMAGE(1:NEWIMAG_PTR) // DEFAULT_EXT IMAGE_LIST(MAX_IMAGE).LENGTH = NEWIMAG_PTR IMAG_CHECK = .true. 999 CONTINUE RETURN END