C C ********************** C * [311,77]UPPASS.FTN * C ********************** C C------- CHANGE A PASSWORD TO A NULL BYTE NAME(12),PASS(6),BREC(64) C DIMENSION IREC(32),INAME(4) C EQUIVALENCE (IREC,BREC) C C------- OPEN UPF FILE OPEN (UNIT=1,NAME='LB0:[1,100]PDSUPF.DAT',TYPE='OLD', 1 ACCESS='DIRECT',SHARED) 100 TYPE 200 200 FORMAT('$What is the user name? ') READ(5,300,END=9000)NC,NAME 300 FORMAT(Q,12A1) IF (NC .EQ. 0) CALL EXIT C C------- CONVERT USER NAME TO RAD50 CALL IRAD50 (12,NAME,INAME) LUN = 1 C C------- READ FIRST RECORD FOR COUNTS READ (LUN'1) IF,IL C C------- COMPUTE LAST INDEX RECORD C NL = (IL+4) / 8 + 1 NL = (IL - IF + 8) / 8 + 1 C C------- SET RECORD POINTER NREC = IF - 1 C C------- LOOP THRU INDEX RECORDS DO 1000 I=2,NL C READ (LUN'I) IREC C C------- CHECK INDEX RECORDS DO 500 J=1,32,4 NREC = NREC + 1 IF(NREC .GT. IL) GO TO 1010 DO 400 K=1,4 IF (INAME(K) .NE. IREC(K+J-1)) GO TO 500 400 CONTINUE C C------- FOUND MATCH GO TO 2000 500 CONTINUE 1000 CONTINUE C C------- NO MATCH 1010 TYPE 1020 1020 FORMAT(' User name not authorized') GO TO 100 C C------- MATCH 2000 MATCH = 1 C C------- READ RECORD READ (LUN'NREC) IREC C C------- ZERO INTERACTIVE PASSWORD IREC(6) = 0 IREC(7) = 0 C C------- ZERO BATCH PASSWORD IREC(24) = 0 IREC(25) = 0 WRITE(LUN'NREC) IREC GO TO 100 C 9000 CALL EXIT C END