功能： 用户多次输入密码错误后，自动解锁，修改密码并自动发邮件

*&---------------------------------------------------------------------*
*& 
*&功能： 用户多次输入密码错误后，自动解锁，修改密码并自动发邮件
*&---------------------------------------------------------------------*
*&注意需要设置程序RSUSR200中变式 USERLOCK'
*&
*&---------------------------------------------------------------------*
REPORT Z_UNLOCK_USER.


PARAMETERS EX2MAIL(100) DEFAULT 'twttafku@163.com'.
PARAMETERS S2ADMIN AS CHECKBOX.



DATA:ZRETURN TYPE TABLE OF  BAPIRET2 .







FIELD-SYMBOLS:<LT_DATA>      TYPE ANY TABLE,
              <LT_DATA_LINE> TYPE ANY TABLE.
DATA:         LR_DATA      TYPE REF TO DATA,
              LR_DATA_LINE TYPE REF TO DATA.
DATA:         LR_DATA_DESCR      TYPE REF TO CL_ABAP_DATADESCR,
              LR_DATA_DESCR_LINE TYPE REF TO CL_ABAP_DATADESCR.
DATA:          USERNAME   TYPE BAPIBNAME-BAPIBNAME,
               LOGONDATA  LIKE BAPILOGOND,
               LOGONDATAX LIKE BAPILOGONX,
               RETURN     LIKE  BAPIRET2 OCCURS 0 WITH HEADER LINE.

TYPES: BEGIN OF TYP_ITAB,
         BNAME  TYPE XUBNAME,          "用户名
         TRDAT1 TYPE XULDATE_ALV,     "最后一次登录日期
         USTYP  TYPE XUUSTYP,
       END OF TYP_ITAB.

DATA:GT_ITAB TYPE STANDARD TABLE OF TYP_ITAB,
     GS_ITAB TYPE TYP_ITAB.

DATA:LV_FLAG TYPE CHAR1.
*  Important to set display = abap_false so the standard program won’t display the ALV
CL_SALV_BS_RUNTIME_INFO=>SET(
  EXPORTING DISPLAY  = ABAP_FALSE
            METADATA = ABAP_FALSE
            DATA     = ABAP_TRUE ).

* Submit standard program with selection table
SUBMIT RSUSR200
  USING SELECTION-SET 'USERLOCK'
        EXPORTING LIST TO MEMORY
       AND RETURN.

CLEAR:LV_FLAG.
TRY."因ALV输出有header，list 所以要有2个参数
    CL_SALV_BS_RUNTIME_INFO=>GET_DATA_REF(
         IMPORTING R_DATA_DESCR      = LR_DATA_DESCR
                   R_DATA_LINE_DESCR = LR_DATA_DESCR_LINE ).

    CREATE DATA LR_DATA TYPE HANDLE LR_DATA_DESCR.
    CREATE DATA LR_DATA_LINE TYPE HANDLE LR_DATA_DESCR_LINE.

    ASSIGN LR_DATA->* TO <LT_DATA>.
    ASSIGN LR_DATA_LINE->* TO <LT_DATA_LINE>.

    CL_SALV_BS_RUNTIME_INFO=>GET_DATA(
      IMPORTING
        T_DATA      =      <LT_DATA>
*        T_DATA_LINE      =      <LT_DATA_LINE>
           ).

  CATCH CX_SALV_BS_SC_RUNTIME_INFO.
    WRITE `Unable to retrieve ALV data` .
    LV_FLAG = 'X'.
  CATCH CX_SY_REF_IS_INITIAL.
    WRITE 'NO DATA'.
    LV_FLAG = 'X'.
ENDTRY.

CL_SALV_BS_RUNTIME_INFO=>CLEAR_ALL( ).
CHECK LV_FLAG IS INITIAL .
IF <LT_DATA>  IS NOT ASSIGNED.
  RETURN.
ENDIF.
MOVE-CORRESPONDING <LT_DATA> TO GT_ITAB.



DATA: L_EMAIL TYPE AD_SMTPADR.

DATA: STRINGPWD TYPE  STRING.
DATA: BAPIPWD TYPE  BAPIPWD.



LOOP AT GT_ITAB INTO GS_ITAB.


  CLEAR L_EMAIL.

  SELECT SINGLE SMTP_ADDR INTO L_EMAIL FROM ADR6
    WHERE EXISTS ( SELECT BNAME FROM USR21
    WHERE ADDRNUMBER = ADR6~ADDRNUMBER
    AND PERSNUMBER = ADR6~PERSNUMBER
    AND BNAME = GS_ITAB-BNAME     ).

*  READ TABLE t_p0105 WITH KEY subty = '0010' endda = '99991231'."读取有效的Email地址
*  l_email = t_p0105-usrid_long.



  IF S2ADMIN = 'X' OR L_EMAIL IS INITIAL.
    L_EMAIL = EX2MAIL.
  ENDIF.


  CHECK L_EMAIL IS NOT INITIAL.  "没有邮件地址的不解锁？

  CLEAR BAPIPWD.
  CLEAR STRINGPWD.


  DATA: GT_RETURN LIKE  BAPIRET2 OCCURS 0 WITH HEADER LINE.

  CALL FUNCTION 'BAPI_USER_UNLOCK'
    EXPORTING
      USERNAME = GS_ITAB-BNAME
    TABLES
      RETURN   = GT_RETURN.




  IF GS_ITAB-USTYP = 'S'.

    STRINGPWD = '(******)'.

  ELSE.

    CALL FUNCTION 'GENERAL_GET_RANDOM_PWD'
      EXPORTING
        NUMBER_CHARS = '8'
      IMPORTING
        RANDOM_PWD   = STRINGPWD.

    BAPIPWD = STRINGPWD.


    CALL FUNCTION 'BAPI_USER_CHANGE'
      EXPORTING
        USERNAME  = GS_ITAB-BNAME
        PASSWORD  = BAPIPWD
        PASSWORDX = 'X'
      TABLES
        RETURN    = GT_RETURN.
  ENDIF.

*****发送解锁邮件



  DATA:P_MAILFROM LIKE  ADR6-SMTP_ADDR,
       LV_SUBJECT TYPE SO_OBJ_DES,
       LV_BODY    TYPE STRING.

  CLEAR: P_MAILFROM, LV_SUBJECT, LV_BODY.
  P_MAILFROM = L_EMAIL.

*  sy-SYSID

  CONCATENATE 'SAP' SY-SYSID '解锁及重置密码-SAP ERP UNLOCK AND RESET PASSWORD' INTO  LV_SUBJECT SEPARATED BY SPACE.




  DATA: CR_LF.

  CR_LF =   CL_ABAP_CHAR_UTILITIES=>CR_LF.


  CONCATENATE '您的账号'  GS_ITAB-BNAME  '因输入密码错误次数过多被锁定，现已自动解锁'    INTO  LV_BODY  .
  IF GS_ITAB-USTYP = 'S'.
    CONCATENATE LV_BODY  ', 请重新登陆。'    INTO  LV_BODY  .
  ELSE.
    CONCATENATE LV_BODY  ' ，密码重置为' STRINGPWD  '，请使用新密码登陆。'    INTO  LV_BODY  .
  ENDIF.

  CONCATENATE  LV_BODY CR_LF 'YOUR ACCOUNT'  GS_ITAB-BNAME  'HAS BEEN LOCKED DUE TO TOO MANY INCORRECT PASSWORDS. THE PASSWORD IS RESET TO ' STRINGPWD '.'     INTO  LV_BODY SEPARATED BY SPACE.
  PERFORM SEND_MAIL USING P_MAILFROM LV_SUBJECT LV_BODY  P_MAILFROM.



ENDLOOP.





CONSTANTS: CON_TAB    TYPE C VALUE CL_ABAP_CHAR_UTILITIES=>HORIZONTAL_TAB,
           CON_CRET   TYPE C VALUE CL_ABAP_CHAR_UTILITIES=>CR_LF,
           C_MIMETYPE TYPE CHAR64
                  VALUE 'APPLICATION/MSEXCEL;charset=utf-16le'.
"发送表单数据内容
DATA:BEGIN OF GT_MSG OCCURS 0,
*     MSGSTATE LIKE SXMSMSGLST-MSGSTATE,
       ZWFID(10)  ,
       ERRLABELTXT LIKE SXMSAGGERRLBLTXT-ERRLABELTXT,
*     INITDATE TYPE SXMSMSGDSP-INITDATE,
*     INITTIME TYPE  SXMSMSGDSP-INITTIME,
       EXEDATE     TYPE SXMSMSGDSP-EXEDATE,
*     EXETIME TYPE SXMSMSGDSP-EXETIME,
*     OB_SYSTEM LIKE SXMSMSGLST-OB_SYSTEM,
*     OB_NS LIKE SXMSMSGLST-OB_NS,
*     OB_NAME LIKE SXMSMSGLST-OB_NAME,
     END OF GT_MSG.


FORM SEND_MAIL USING P_MAILFROM TYPE AD_SMTPADR
                       P_SUBJECT TYPE SO_OBJ_DES
                      P_BODY TYPE STRING
                      P_MAILTO TYPE AD_SMTPADR.
  TYPE-POOLS: TRUXS.
  TYPES T_XLS_TABLE_TYPE TYPE REF TO DATA .
  DATA:LV_STRING  TYPE STRING,
       LV_XSTRING TYPE XSTRING,
       WA_FIELD   TYPE STRING.

  DATA: X_MAILTEXT TYPE SOLI_TAB,
        X_EXCELX   TYPE SOLIX_TAB.
  DATA: LO_SEND_REQUEST   TYPE REF TO CL_BCS,
        I_XLS_TABLE       TYPE TABLE OF T_XLS_TABLE_TYPE,
        LO_SENDER_SMTP    TYPE REF TO IF_SENDER_BCS,
        LO_SENDER         TYPE REF TO CL_SAPUSER_BCS,
        LO_BCS_EXCEPTION  TYPE REF TO CX_BCS,
        LI_RECIPIENT_SMTP TYPE REF TO IF_RECIPIENT_BCS.
  DATA: LO_DOCUMENT    TYPE REF TO CL_DOCUMENT_BCS,
        LR_DATA        TYPE REF TO DATA,
        LR_STRUCTDESCR TYPE REF TO CL_ABAP_STRUCTDESCR,
        LX_COMP        TYPE ABAP_COMPONENT_TAB.
  FIELD-SYMBOLS:
    <DYN_WA>    TYPE ANY,
    <FS_FIELD>  TYPE ANY,     <FS_TABLE>  
TYPE ANY TABLE,     <FS_DD_TAB> 
TYPE X031L,     <FS_DD_FLE> 
TYPE DFIES,     <FS_COMP>   
TYPE ABAP_COMPONENTDESCR.   
TRY.       LO_SEND_REQUEST 
= CL_BCS=>CREATE_PERSISTENT( ).       

IF NOT P_BODY IS INITIAL.         
CALL FUNCTION 'SCMS_STRING_TO_FTEXT'           
EXPORTING             
TEXT      = P_BODY           
TABLES             FTEXT_TAB 
= X_MAILTEXT.       
ENDIF.       

IF GT_MSG[] IS INITIAL.         LO_DOCUMENT 
= CL_DOCUMENT_BCS=>CREATE_FROM_TEXT(            I_TEXT 
= X_MAILTEXT            I_SUBJECT 
= P_SUBJECT ).       
ELSE.         
ASSIGN GT_MSG[] TO <FS_TABLE>.         
CREATE DATA LR_DATA LIKE LINE OF <FS_TABLE>.


*Get the table structure         LR_STRUCTDESCR ?= CL_ABAP_STRUCTDESCR


=>DESCRIBE_BY_DATA_REF(          LR_DATA 
).         LX_COMP 
= LR_STRUCTDESCR->GET_COMPONENTS( ).         

LOOP AT LX_COMP ASSIGNING <FS_COMP>.           
CONCATENATE LV_STRING <FS_COMP>-NAME WA_FIELD CON_TAB                      
INTO LV_STRING.         
ENDLOOP.         
CONCATENATE LV_STRING CON_CRET INTO LV_STRING.


*Then, add contents of table into final string         


LOOP AT <FS_TABLE> ASSIGNING <DYN_WA>.           
LOOP AT LX_COMP ASSIGNING <FS_COMP>.             
IF NOT <FS_COMP> IS INITIAL.               
ASSIGN COMPONENT <FS_COMP>-NAME OF STRUCTURE <DYN_WA>               
TO <FS_FIELD>.               
IF <FS_FIELD> IS ASSIGNED.                 
MOVE <FS_FIELD> TO WA_FIELD.                 
CONCATENATE LV_STRING WA_FIELD CON_TAB INTO LV_STRING.               
ENDIF.             
ENDIF.           
ENDLOOP.           
CONCATENATE LV_STRING CON_CRET INTO LV_STRING.         
ENDLOOP.



*   Convert the string into xstring         
CALL FUNCTION 'SCMS_STRING_TO_XSTRING'           
EXPORTING             
TEXT     = LV_STRING             MIMETYPE 
= C_MIMETYPE           
IMPORTING             
BUFFER   = LV_XSTRING           
EXCEPTIONS             FAILED   
= 1             
OTHERS   = 2.         

IF SY-SUBRC = 0.           
CONCATENATE CL_ABAP_CHAR_UTILITIES=>BYTE_ORDER_MARK_LITTLE                        LV_XSTRING 
INTO LV_XSTRING IN BYTE MODE.


*   Convert the string into binary table           

CALL FUNCTION 'SCMS_XSTRING_TO_BINARY'             
EXPORTING               
BUFFER     = LV_XSTRING             
TABLES               BINARY_TAB 
= X_EXCELX.         
ELSE.           
MESSAGE ID SY-MSGID TYPE SY-MSGTY NUMBER SY-MSGNO                   
WITH SY-MSGV1 SY-MSGV2 SY-MSGV3 SY-MSGV4.         
ENDIF.         LO_DOCUMENT 

= CL_DOCUMENT_BCS=>CREATE_DOCUMENT(           I_TYPE 
= 'RAW'           I_TEXT 
= X_MAILTEXT           I_SUBJECT 
= P_SUBJECT ).



*   add attachment to document         LO_DOCUMENT


->ADD_ATTACHMENT(               I_ATTACHMENT_TYPE    
= 'XLS'               I_ATTACHMENT_SUBJECT 
= P_SUBJECT               I_ATT_CONTENT_HEX    
= X_EXCELX ).       
ENDIF.



* Set special mail attributes (these are optional)       


CALL METHOD LO_SEND_REQUEST->SET_STATUS_ATTRIBUTES         
EXPORTING           I_REQUESTED_STATUS 
= 'E'           I_STATUS_MAIL      
= 'E'.


*Set the sender of the mail       LO_SEND_REQUEST


->SET_DOCUMENT( LO_DOCUMENT ).       LO_SENDER_SMTP 
=         CL_CAM_ADDRESS_BCS
=>CREATE_INTERNET_ADDRESS(          I_ADDRESS_STRING 

= P_MAILFROM          I_ADDRESS_NAME   
= 'SAP ERP'          


).       LO_SEND_REQUEST
->SET_SENDER( LO_SENDER_SMTP ).       
"调整一次发送一人       LI_RECIPIENT_SMTP 
= CL_CAM_ADDRESS_BCS
=>CREATE_INTERNET_ADDRESS( P_MAILTO ).       LO_SEND_REQUEST
->ADD_RECIPIENT(               I_RECIPIENT 
= LI_RECIPIENT_SMTP ).
*
*      LOOP AT MAILTO   . "调整一次发送一人
*        LI_RECIPIENT_SMTP =
*          CL_CAM_ADDRESS_BCS=>CREATE_INTERNET_ADDRESS( MAILTO-LOW ).
*       CL_CAM_ADDRESS_BCS=>CREATE_INTERNET_ADDRESS( p_MAILTO ).
*        LO_SEND_REQUEST->ADD_RECIPIENT(
*                I_RECIPIENT = LI_RECIPIENT_SMTP ).
*      ENDLOOP.



*Finally: send the mail!       LO_SEND_REQUEST


->SET_SEND_IMMEDIATELY( 'X' ).       LO_SEND_REQUEST
->SEND( ).       
COMMIT WORK.


*Catch any nasty exceptions...     


CATCH CX_ADDRESS_BCS.       
WRITE:/1 'Address Exceptions'.     
CATCH CX_SEND_REQ_BCS.       
WRITE:/1 'Send Request Exceptions'.     
CATCH CX_DOCUMENT_BCS.       
WRITE:/1 'Document Exceptions'.     
CATCH CX_BCS INTO LO_BCS_EXCEPTION.       
WRITE:/1 'BCS: General Exceptions'.   

ENDTRY.
ENDFORM. " SEND_MAIL