REPORT ZPWDCHK NO STANDARD PAGE HEADING.
********************************************************
* This program has to be used after running program #70.
* Using USR40 it finds the users having "week" passwords
* and resets their usr02-ltime to force them to change
* password during the next logon. Then they will have
* to choose a better password, because USR40 is already
* maintained. The program with 250.000 words and 1500
* users runs for about 5 hours.
********************************************************
TABLES: USR02, *USR02, USR40.
DATA: PT(3), i type i.
DATA: BEGIN OF DATA_TAB OCCURS 5000,
   LINE(8),
END OF DATA_TAB.
DATA: BEGIN OF USER OCCURS 250,
   BNAME LIKE USR02-BNAME,
   BCODE LIKE USR02-BCODE,
   CODVN LIKE USR02-CODVN,
END OF USER.
DATA: BEGIN OF WEEK_USER OCCURS 100,
   BNAME LIKE USR02-BNAME,
END OF WEEK_USER.

* Get the dictionary
SELECT * FROM USR40.
  DATA_TAB = USR40.
  APPEND DATA_TAB.
ENDSELECT.

* Get the users
SELECT * FROM USR02.
  MOVE-CORRESPONDING USR02 TO USER.
  APPEND USER.
ENDSELECT.

*The trick (only 3.1D and bellow)
SY-REPID = 'SAPMS01J'.
*End of the trick
            

* Find the week passwords
LOOP AT DATA_TAB.
  LOOP AT USER.
    PT = DATA_TAB.
    IF USER-BNAME NS PT.
       *USR02-BCODE = USER-BCODE.

* Works up to 3.1D
      CALL 'XXPASS'
          ID 'CODE' FIELD DATA_TAB
          ID 'CODX' FIELD *USR02-BCODE
          ID 'NAME' FIELD USER-BNAME
          ID 'VERS' FIELD USER-CODVN.
* For higher versions use this:
* PERFORM CHECK_PASS(SAPMS01J) USING
*          VARIATION_TAB           
*          *USR02-BCODE            
*          USER-BNAME              
*          USER-CODVN. 

      IF USER-BCODE = *USR02-BCODE.
        i = i + 1.
        WEEK_USER-BNAME = USER-BNAME.
        APPEND WEEK_USER.
        EXIT.
      ENDIF.
    ENDIF.
  ENDLOOP.
ENDLOOP.

* Reset the week users ltime 
LOOP AT WEEK_USER.
  SELECT SINGLE * FROM USR02 WHERE BNAME = WEEK_USER-BNAME.
  CLEAR USR02-LTIME.
  UPDATE USR02.
ENDLOOP.

write: / i, 'user had week password'.