* Использовать для проверки по объектам, имеющим не более 10 полей!
FUNCTION z_f_auth_check.
*"----------------------------------------------------------------------
*"*"Локальный интерфейс:
*"  IMPORTING
*"     VALUE(I_UNAME) TYPE  SYUNAME DEFAULT SY-UNAME
*"  EXPORTING
*"     VALUE(E_AUTHORITY) TYPE  SYSUBRC
*"  TABLES
*"      T_AUTHCHK TYPE  ZTAUTHCHK OPTIONAL
*"  EXCEPTIONS
*"      AUTHORITY_CHECK_PROCEDURE_ERR
*"----------------------------------------------------------------------

  DATA: lt_auth_val TYPE TABLE OF ts_auth_val WITH HEADER LINE,
        lf_form_name TYPE string,
        lt_pool_tab TYPE STANDARD TABLE OF string,
        lf_prog_name TYPE string,
        lf_mess TYPE string,
        lf_sid  TYPE string,
        lf_count1 TYPE i,
        lf_count2 TYPE i,
        lf_count_n(5) TYPE n,
*        lf_auth_failed type sy-subrc,
        lf_text1 TYPE string,
        lf_text2 TYPE string,
        ls_authval TYPE zsauthval,
        lc_exc_ref TYPE REF TO cx_sy_generate_subpool_full.

  DATA: id1(72),
        id2(72),
        id3(72),
        id4(72),
        id5(72),
        id6(72),
        id7(72),
        id8(72),
        id9(72),
        id10(72),
        value1(72),
        value2(72),
        value3(72),
        value4(72),
        value5(72),
        value6(72),
        value7(72),
        value8(72),
        value9(72),
        value10(72).


  CLEAR: e_authority.

  lf_form_name = 'CHECK_AUTH_DYN'.

* определяем максимальное число параметров объектов полномочий
  CLEAR: lf_count1, lf_count2.

  LOOP AT t_authchk.
    DESCRIBE TABLE t_authchk-authval LINES lf_count2.
    IF lf_count2 GT lf_count1.
      lf_count1 = lf_count2.
    ENDIF.
  ENDLOOP.

* если для проверки переданы какие-либо объекты
* и параметры к ним - создаем динамический код
* проверки и вызываем его

  IF t_authchk[] IS NOT INITIAL AND
     lf_count1 GT 0.

* создаем вызовы проверок объектов полномочий по t_authchk
    CLEAR: lf_count1,
           lf_count2.
    e_authority = 0.
    LOOP AT t_authchk.


      CLEAR: lf_count2.
      LOOP AT t_authchk-authval INTO ls_authval.
        lf_count2 = lf_count2 + 1.
        CASE sy-tabix.
          WHEN 1.
            id1 = ls_authval-id.
            value1 = ls_authval-value.
          WHEN 2.
            id2 = ls_authval-id.
            value2 = ls_authval-value.
          WHEN 3.
            id3 = ls_authval-id.
            value3 = ls_authval-value.
          WHEN 4.
            id4 = ls_authval-id.
            value4 = ls_authval-value.
          WHEN 5.
            id5 = ls_authval-id.
            value5 = ls_authval-value.
          WHEN 6.
            id6 = ls_authval-id.
            value6 = ls_authval-value.
          WHEN 7.
            id7 = ls_authval-id.
            value7 = ls_authval-value.
          WHEN 8.
            id8 = ls_authval-id.
            value8 = ls_authval-value.
          WHEN 9.
            id9 = ls_authval-id.
            value9 = ls_authval-value.
          WHEN 10.
            id10 = ls_authval-id.
            value10 = ls_authval-value.
          WHEN OTHERS.
            lf_count2 = lf_count2 - 1.
            EXIT.
        ENDCASE.
      ENDLOOP.

      CASE lf_count2.
        WHEN 1.
          AUTHORITY-CHECK OBJECT t_authchk-object
                   ID id1 FIELD value1.
        WHEN 2.
          AUTHORITY-CHECK OBJECT t_authchk-object
                   ID id1 FIELD value1
                   ID id2 FIELD value2.
        WHEN 3.
          AUTHORITY-CHECK OBJECT t_authchk-object
                   ID id1 FIELD value1
                   ID id2 FIELD value2
                   ID id3 FIELD value3.
        WHEN 4.
          AUTHORITY-CHECK OBJECT t_authchk-object
                   ID id1 FIELD value1
                   ID id2 FIELD value2
                   ID id3 FIELD value3
                   ID id4 FIELD value4.
        WHEN 5.
          AUTHORITY-CHECK OBJECT t_authchk-object
                   ID id1 FIELD value1
                   ID id2 FIELD value2
                   ID id3 FIELD value3
                   ID id4 FIELD value4
                   ID id5 FIELD value5.
        WHEN 6.
          AUTHORITY-CHECK OBJECT t_authchk-object
                   ID id1 FIELD value1
                   ID id2 FIELD value2
                   ID id3 FIELD value3
                   ID id4 FIELD value4
                   ID id5 FIELD value5
                   ID id6 FIELD value6.
        WHEN 7.
          AUTHORITY-CHECK OBJECT t_authchk-object
                   ID id1 FIELD value1
                   ID id2 FIELD value2
                   ID id3 FIELD value3
                   ID id4 FIELD value4
                   ID id5 FIELD value5
                   ID id6 FIELD value6
                   ID id7 FIELD value7.
        WHEN 8.
          AUTHORITY-CHECK OBJECT t_authchk-object
                   ID id1 FIELD value1
                   ID id2 FIELD value2
                   ID id3 FIELD value3
                   ID id4 FIELD value4
                   ID id5 FIELD value5
                   ID id6 FIELD value6
                   ID id7 FIELD value7
                   ID id8 FIELD value8.
        WHEN 9.
          AUTHORITY-CHECK OBJECT t_authchk-object
                   ID id1 FIELD value1
                   ID id2 FIELD value2
                   ID id3 FIELD value3
                   ID id4 FIELD value4
                   ID id5 FIELD value5
                   ID id6 FIELD value6
                   ID id7 FIELD value7
                   ID id8 FIELD value8
                   ID id9 FIELD value9.
        WHEN 10.
          AUTHORITY-CHECK OBJECT t_authchk-object
                   ID id1 FIELD value1
                   ID id2 FIELD value2
                   ID id3 FIELD value3
                   ID id4 FIELD value4
                   ID id5 FIELD value5
                   ID id6 FIELD value6
                   ID id7 FIELD value7
                   ID id8 FIELD value8
                   ID id9 FIELD value9
                   ID id10 FIELD value10.
      ENDCASE.

      IF sy-subrc NE 0.
        e_authority = sy-subrc.
        EXIT.
      ENDIF.
    ENDLOOP.

  ENDIF.

ENDFUNCTION.

FUNCTION z_f_auth_profile_add.
*"----------------------------------------------------------------------
*"*"Локальный интерфейс:
*"  IMPORTING
*"     VALUE(I_UNAME) TYPE  SYUNAME DEFAULT SY-UNAME
*"     VALUE(I_DO_AUTH_CHECK) TYPE  XFELD DEFAULT 'X'
*"  EXPORTING
*"     VALUE(E_RESULT) TYPE  XFELD
*"  TABLES
*"      T_AUTHCHK TYPE  ZTAUTHCHK OPTIONAL
*"      T_PROFILES TYPE  USTYP_T_PROFILES OPTIONAL
*"  EXCEPTIONS
*"      AUTHORITY_CHECK_ERROR
*"      ADDING_PROFILE_ERROR
*"----------------------------------------------------------------------

  DATA: lf_authority TYPE sy-subrc,
        lt_user_profiles TYPE ustyp_t_profiles,
        ls_user_profiles LIKE LINE OF lt_user_profiles,
        lt_return TYPE bapirettab.

  CLEAR: e_result,
         lf_authority.

  IF i_do_auth_check IS NOT INITIAL.
    CALL FUNCTION 'Z_F_AUTH_CHECK'
      EXPORTING
        i_uname                       = i_uname
      IMPORTING
        e_authority                   = lf_authority
      TABLES
        t_authchk                     = t_authchk
      EXCEPTIONS
        authority_check_procedure_err = 1
        OTHERS                        = 2.

    IF lf_authority GT 4 or sy-subrc ne 0.
      RAISE authority_check_error.
    ENDIF.

*   если проверка полномочий прошла успешно - выходим,
*   профиль добавлять ни к чему
    IF lf_authority EQ 0.
      RETURN.
    ENDIF.
  ENDIF.

* если проверка полномочий не прошла, добавляем профили
* полномочий пользователю

  IF t_profiles[] IS INITIAL.
    RETURN.
  ENDIF.

  LOOP AT t_profiles.
*   получение списка профилей пользователя
    REFRESH lt_user_profiles.
    CALL FUNCTION 'SUSR_USER_PROFS_PROFILES_GET'
      EXPORTING
        user_name           = i_uname
      TABLES
        user_profiles       = lt_user_profiles
      EXCEPTIONS
        user_name_not_exist = 1
        OTHERS              = 2.
    IF sy-subrc NE 0.
      ROLLBACK WORK.
      RAISE adding_profile_error.
    ENDIF.

    READ TABLE lt_user_profiles INTO ls_user_profiles
               WITH KEY profile = t_profiles-profile.
    IF sy-subrc EQ 0.
      CONTINUE.
    ENDIF.

    CALL FUNCTION 'SUSR_USER_PROFS_RELATE_ONE'
      EXPORTING
        user_name           = i_uname
        profile             = t_profiles-profile
      EXCEPTIONS
        user_name_not_exist = 1
        OTHERS              = 2.
    IF sy-subrc NE 0.
      ROLLBACK WORK.
      RAISE adding_profile_error.
    ENDIF.

    CALL FUNCTION 'SUSR_USER_PROFS_BUFFER_SAVECHK'
      EXPORTING
        username               = i_uname
*     USE_MESSAGE_TYPE       = 'E'
      CHANGING
        return                 = lt_return
              .
    LOOP AT lt_return TRANSPORTING NO FIELDS WHERE type = 'E'.
      EXIT.
    ENDLOOP.
    IF sy-subrc EQ 0.
      ROLLBACK WORK.
      RAISE adding_profile_error.
    ENDIF.

    CALL FUNCTION 'SUSR_USER_PROFS_BUFFER_TO_DB'
      EXCEPTIONS
        too_many_profiles = 1
        internal_error    = 2
        OTHERS            = 3.
    IF sy-subrc NE 0.
      ROLLBACK WORK.
      RAISE adding_profile_error.
    ENDIF.

  ENDLOOP.

  COMMIT WORK AND WAIT.
  IF sy-subrc EQ 0.
    e_result = cc_x.
  ELSE.
    ROLLBACK WORK.
    RAISE adding_profile_error.
  ENDIF.
  PERFORM wait_vb(zwaitvbe) USING sy-mandt sy-uname.

ENDFUNCTION.

FUNCTION z_f_auth_profile_remove.
*"----------------------------------------------------------------------
*"*"Локальный интерфейс:
*"  IMPORTING
*"     VALUE(I_UNAME) TYPE  SYUNAME DEFAULT SY-UNAME
*"  TABLES
*"      T_PROFILES TYPE  USTYP_T_PROFILES OPTIONAL
*"  EXCEPTIONS
*"      REMOVING_PROFILE_ERROR
*"----------------------------------------------------------------------

  DATA:
      lt_user_profiles TYPE ustyp_t_profiles,
      ls_user_profiles LIKE LINE OF lt_user_profiles,
      lt_return TYPE bapirettab.

  LOOP AT t_profiles.

*   получение списка профилей пользователя
    REFRESH lt_user_profiles.
    CALL FUNCTION 'SUSR_USER_PROFS_PROFILES_GET'
      EXPORTING
        user_name           = i_uname
      TABLES
        user_profiles       = lt_user_profiles
      EXCEPTIONS
        user_name_not_exist = 1
        OTHERS              = 2.
    IF sy-subrc NE 0.
      ROLLBACK WORK.
      RAISE removing_profile_error.
    ENDIF.

    READ TABLE lt_user_profiles INTO ls_user_profiles
               WITH KEY profile = t_profiles-profile.
    IF sy-subrc NE 0.
      CONTINUE.
    ENDIF.

    CALL FUNCTION 'SUSR_USER_PROFS_REMOVE_ONE'
      EXPORTING
        user_name           = i_uname
        profile             = t_profiles-profile
      EXCEPTIONS
        user_name_not_exist = 1
        OTHERS              = 2.
    IF sy-subrc NE 0.
      ROLLBACK WORK.
      RAISE removing_profile_error.
    ENDIF.

    CALL FUNCTION 'SUSR_USER_PROFS_BUFFER_SAVECHK'
      EXPORTING
        username               = sy-uname
*     USE_MESSAGE_TYPE       = 'E'
      CHANGING
        return                 = lt_return
              .
    LOOP AT lt_return TRANSPORTING NO FIELDS WHERE type = 'E'.
      EXIT.
    ENDLOOP.
    IF sy-subrc EQ 0.
      ROLLBACK WORK.
      RAISE removing_profile_error.
    ENDIF.

    CALL FUNCTION 'SUSR_USER_PROFS_BUFFER_TO_DB'
      EXCEPTIONS
        too_many_profiles = 1
        internal_error    = 2
        OTHERS            = 3.
    IF sy-subrc NE 0.
      ROLLBACK WORK.
      RAISE removing_profile_error.
    ENDIF.

  ENDLOOP.

  COMMIT WORK AND WAIT.
  PERFORM wait_vb(zwaitvbe) USING sy-mandt sy-uname.
  IF sy-subrc EQ 0.
*    e_result = cc_x.
  ELSE.
    ROLLBACK WORK.
    RAISE removing_profile_error.
  ENDIF.

ENDFUNCTION.

*&---------------------------------------------------------------------*
*& Report  ZWAITVBE
*&
*&---------------------------------------------------------------------*
*&
*&
*&---------------------------------------------------------------------*

report zwaitvbe .

include tskhincl.

constants: c_waittime(4) type n value 30.

parameters: p_mandt like sy-mandt,
            p_uname like sy-uname,
            p_cycle(4) type n.

initialization.

  if p_mandt is initial.
    p_mandt = sy-mandt.
  endif.
  if p_uname is initial.
    p_uname = sy-uname.
  endif.
  if p_cycle is initial.
    p_cycle = c_waittime.
  endif.

start-of-selection.

  message s208(00) with text-001.
  perform wait_vb using p_mandt p_uname.
  message s208(00) with text-002.

*&---------------------------------------------------------------------*
*&      Form  WAIT_VB
*&---------------------------------------------------------------------*
*       text
*----------------------------------------------------------------------*
form wait_vb using p_mandt like sy-mandt
                   p_uname like sy-uname.

  data xvbhdr like table of vbhdr initial size 0 with header line.

  data: xmandt like vbselect-vbmandt,
        xbname like vbselect-vbbname,
        xsname like vbselect-vbsname,
        xbzeit like vbselect-vbzeit,
        locdate(14),
        lb(3),
        hb(3) type p,
        xcount like sy-tabix,
        xrandm,
        xrandn like datatype-integer2.

  xmandt = p_mandt.
  xbname = p_uname.
  lb = 0.
  hb = 255.
  locdate = sy-datum.
  clear xbzeit.
  locdate+8 = xbzeit.
  xsname = '%'.

  if p_cycle is initial.
    p_cycle = c_waittime.
  endif.

  if p_cycle eq c_waittime.
    xrandm = 'X'.
  endif.

  do.

    clear: xvbhdr, xvbhdr[].

    select *
      into table xvbhdr
      from vbhdr
     where ( vbmandt like xmandt )
       and ( vbusr like xbname )
       and ( vbrc between lb and hb )
       and ( vbdate >= locdate )
       and ( vbname like xsname ).

    clear xcount.

    loop at xvbhdr.

      case xvbhdr-vbrc.
        when vb_ok or
             vb_v1_ok or
             vb_v2_ok or
             vb_executed or
             vb_restart_v1 or
             vb_restart_v2 or
             vb_run_v1 or
             vb_run_v2 or
             vb_autodelete or
             vb_delete or
             vb_autodiaexec or
             vb_autosysexec or
             vb_notexecuted or
             vb_external_prepared or
             vb_run_col.

          add 1 to xcount.

      endcase.

    endloop.

    if xcount eq 0.
      exit.
    endif.

    if xrandm ne space.

      call function 'RANDOM_I2'
           exporting
                rnd_min   = 1
                rnd_max   = 7
           importing
                rnd_value = xrandn
           exceptions
                others    = 1.

      p_cycle = xrandn.

    endif.

    wait up to p_cycle seconds.

  enddo.

endform.                               " WAIT_VB