LINE-COUNT 65.
*----------------------------------------------------------------------*
* Maintain Table dynamicly (Table name is entered on Selection Screen)
* Very powerfull program. Please maintain authorisation access and
* restrict maintenance to Z-tables
* Version 6.20 and up
* (can be used in 4.6C with some modifications to block try - endtry
* and classes)
*----------------------------------------------------------------------*
* Enhanced functionality with dynamic selection screen
*----------------------------------------------------------------------*
TABLES: sscrfields. "Fields on selection screens
TYPE-POOLS rsds.
DATA ds_clauses TYPE rsds_where.
DATA: BEGIN OF ifield OCCURS 0,
fieldname LIKE dd03l-fieldname,
position LIKE dd03l-position,
keyflag LIKE dd03l-keyflag,
datatype LIKE dd03l-datatype.
DATA: END OF ifield.
DATA: sl_step LIKE sy-tabix,
ss_step LIKE sy-subrc,
ss_act(1) TYPE c,
sl_lines LIKE sy-tfill,
sl_status LIKE sy-subrc,
sl_subrc LIKE sy-subrc,
sl_update(1) TYPE c,
sl_mandt(1) TYPE c,
len(6) TYPE n,
f_value(255) TYPE c,
sl_datum LIKE sy-datum,
sl_uzeit LIKE sy-uzeit,
price1(15) TYPE c,
price2(15) TYPE c,
mess(60) TYPE c,
d_stat LIKE sy-subrc,
m_stat LIKE sy-subrc,
slchar(6) TYPE c.
DATA: ref_ptr TYPE REF TO cx_root. "Root class more common
DATA: text TYPE string.
DATA: sl_index LIKE sy-tabix.
DATA: zauth LIKE dd02l-tabname.
DATA: num TYPE i,
max_len TYPE i,
check_len TYPE i,
sl_sel(1) TYPE c.
TYPE-POOLS: icon.
*----------------------------------------------------------------*
* SELECTION-SCREEN.
*----------------------------------------------------------------*
SELECTION-SCREEN BEGIN OF LINE.
* text-012 - 'Table Name'
SELECTION-SCREEN COMMENT 1(25) text-012.
PARAMETERS: tabname LIKE dd02l-tabname DEFAULT 'ZSCARE'.
* text-003 - 'Selection'
SELECTION-SCREEN PUSHBUTTON 75(9) text-003 USER-COMMAND sta1.
SELECTION-SCREEN END OF LINE.
* numrows(text) - 'Max Number of ROWS'
PARAMETERS: numrows LIKE sy-subrc DEFAULT '100'.
************************************************************************
* At Selection-Screen *
************************************************************************
AT SELECTION-SCREEN.
CASE sscrfields-ucomm.
WHEN 'STA1'.
CLEAR sl_sel.
CALL FUNCTION 'ZSTAN_SELECTIONS'
EXPORTING
tabname = tabname
IMPORTING
ds_clauses = ds_clauses
EXCEPTIONS
table_not_valid = 1
other_error = 2
OTHERS = 3.
IF sy-subrc = 0.
sl_sel = 'X'.
ENDIF.
ENDCASE.
************************************************************************
*At Selection-Screen Output *
************************************************************************
AT SELECTION-SCREEN OUTPUT.
SELECT SINGLE tabname
INTO tabname
FROM dd02l
WHERE tabname = tabname
AND as4local = 'A'
AND ( tabclass = 'TRANSP' OR tabclass = 'POOL'
OR tabclass = 'CLUSTER' ).
IF sy-subrc <> 0.
MESSAGE 'Table is not valid' TYPE 'S'.
RETURN.
ENDIF.
*----------------------------------------------------------------*
* START-OF-SELECTION.
*----------------------------------------------------------------*
START-OF-SELECTION.
DEFINE: acheck.
zauth = 'ZTABAUTH'.
select single statu
into sl_update
from (zauth)
where tabname = tabname
and bname = sy-uname.
if sy-subrc <> 0.
message 'You are not authorized to view this table' type 'S'.
return.
endif.
END-OF-DEFINITION.
SELECT SINGLE tabname
INTO tabname
FROM dd02l
WHERE tabname = tabname
AND as4local = 'A'
AND ( tabclass = 'TRANSP' OR tabclass = 'POOL'
OR tabclass = 'CLUSTER' ).
IF sy-subrc <> 0.
MESSAGE 'Table is not valid' TYPE 'S'.
RETURN.
ENDIF.
DATA: ptr_itab TYPE REF TO data.
FIELD-SYMBOLS:
CREATE DATA ptr_itab TYPE STANDARD TABLE OF (tabname).
ASSIGN ptr_itab->* TO
* For DELETION
DATA: ptr_itd TYPE REF TO data.
FIELD-SYMBOLS:
CREATE DATA ptr_itd TYPE STANDARD TABLE OF (tabname).
ASSIGN ptr_itd->* TO
* For MODIFICATION
DATA: ptr_itm TYPE REF TO data.
FIELD-SYMBOLS:
CREATE DATA ptr_itm TYPE STANDARD TABLE OF (tabname).
ASSIGN ptr_itm->* TO
DATA: ptr_wtab TYPE REF TO data.
FIELD-SYMBOLS:
CREATE DATA ptr_wtab TYPE (tabname).
ASSIGN ptr_wtab->* TO
DATA: itabname(15) TYPE c.
itabname = '
* Standard list status with 'SAVE' button
SET PF-STATUS 'STLI'.
CLEAR sl_update.
* Maintain authorisation access in table ZTABAUTH
* Key fields: tabname - Table name
* bname = sy-uname - User name
* statu = 'X' - maintain
* ' ' - view
* Check authorisation access
acheck.
SELECT fieldname position keyflag datatype
INTO TABLE ifield
FROM dd03l
WHERE tabname = tabname
AND fieldname NOT LIKE '.INCLU%'
ORDER BY position.
FIELD-SYMBOLS:
DATA: tab_field(60) TYPE c,
sline LIKE sy-lisel.
DATA: field_attr LIKE dfies.
DATA: BEGIN OF tfield_attr OCCURS 0.
INCLUDE STRUCTURE field_attr.
DATA: END OF tfield_attr.
LOOP AT ifield.
CALL FUNCTION 'G_FIELD_READ'
EXPORTING
table = tabname
fieldname = ifield-fieldname
text_flag = 'X'
IMPORTING
field_attr = field_attr.
tfield_attr = field_attr.
APPEND tfield_attr.
ENDLOOP.
IF sl_sel = 'X'.
SELECT *
FROM (tabname)
INTO TABLE
WHERE (ds_clauses-where_tab).
ELSE.
SELECT *
FROM (tabname)
INTO TABLE
ENDIF.
DESCRIBE TABLE
* Show two extra lines to allow addition up to 2 new lines
IF sl_update = 'X'.
DO 2 TIMES.
APPEND INITIAL LINE TO
ENDDO.
ENDIF.
DATA: info(22) VALUE 'D - Delete, M - Modify'.
WRITE: / icon_information AS ICON QUICKINFO info.
WRITE ' '.
CLEAR check_len.
LOOP AT tfield_attr.
IF tfield_attr-datatype = 'CLNT'.
CONTINUE.
ENDIF.
len = tfield_attr-outputlen.
IF tfield_attr-keyflag = 'X'.
check_len = check_len + len + 1.
ENDIF.
IF tfield_attr-scrtext_m IS NOT INITIAL.
WRITE: AT (len) tfield_attr-scrtext_m COLOR 1.
ELSE.
WRITE: AT (len) tfield_attr-fieldtext COLOR 1.
ENDIF.
ENDLOOP.
CLEAR ss_step.
CLEAR ss_act.
LOOP AT
IF sy-tabix LE sl_lines.
ss_step = 1.
ELSE.
CLEAR ss_step.
ENDIF.
* In field SS_STEP put D - to delete record
* M - to modify/add new record
IF sl_update = 'X'.
WRITE:/ icon_change AS ICON.
IF ss_step = 1.
WRITE: ss_act INPUT ON.
ELSE.
ss_act = 'M'.
WRITE: ss_act.
CLEAR ss_act.
ENDIF.
ELSE.
WRITE:/ icon_display AS ICON.
WRITE: ss_act COLOR 2.
ENDIF.
LOOP AT ifield.
* Maintain client dependant tables in the same client
IF ifield-datatype = 'CLNT'.
sl_mandt = 'X'.
CONTINUE.
ENDIF.
CONCATENATE itabname '-' ifield-fieldname INTO tab_field.
ASSIGN (tab_field) TO
IF sl_update = 'X'.
IF ifield-keyflag = 'X' AND ss_step IS NOT INITIAL.
WRITE:
ELSE.
WRITE:
ENDIF.
ELSE.
IF ifield-keyflag = 'X' AND ss_step IS NOT INITIAL.
WRITE:
ELSE.
WRITE:
ENDIF.
ENDIF.
UNASSIGN
ENDLOOP.
ENDLOOP.
*----------------------------------------------------------------*
* END-OF-SELECTION.
*----------------------------------------------------------------*
END-OF-SELECTION.
*----------------------------------------------------------------*
* AT USER-COMMAND.
*----------------------------------------------------------------*
AT USER-COMMAND.
CASE sy-ucomm.
WHEN 'SAVE'.
IF sl_update = 'X'.
CLEAR: sl_step,
sl_status,
sl_subrc,
d_stat,
m_stat,
max_len.
REFRESH
REFRESH
DO.
IF sl_status <> 0.
EXIT.
ENDIF.
ADD 1 TO sl_step.
IF sl_subrc <> 0.
EXIT.
ENDIF.
CLEAR ss_step.
CLEAR ss_act.
READ LINE sl_step
FIELD VALUE ss_act INTO f_value.
sl_subrc = sy-subrc.
IF f_value(1) EQ 'D' OR f_value(1) = 'd'.
ss_step = 1. "Delete
ELSEIF f_value(1) EQ 'M' OR f_value(1) = 'm'.
ss_step = 2. "Modify
ELSE.
CLEAR ss_step.
ENDIF.
CHECK sy-lisel(3) = '0Z '.
IF ss_step GT 0.
CLEAR sline.
sline = sy-lisel+5(250).
max_len = 250.
CHECK sline(check_len) <> ' '.
LOOP AT tfield_attr.
CONCATENATE itabname '-' tfield_attr-fieldname
INTO tab_field.
ASSIGN (tab_field) TO
IF tfield_attr-fieldname = 'MANDT'.
ELSE.
CLEAR f_value.
IF max_len LT tfield_attr-outputlen.
max_len = 255.
ADD 1 TO sl_step.
READ LINE sl_step.
sline = sy-lisel.
ENDIF.
f_value = sline(tfield_attr-outputlen).
max_len = max_len - tfield_attr-outputlen - 1.
IF tfield_attr-inttype = 'D'.
IF f_value CO ' 0./-'.
CLEAR sl_datum.
ELSE.
CALL FUNCTION 'CONVERT_DATE_INPUT'
EXPORTING
input = f_value
plausibility_check = 'X'
IMPORTING
output = sl_datum
EXCEPTIONS
plausibility_check_failed = 1
wrong_format_in_input = 2
OTHERS = 3.
IF sy-subrc = 0.
ELSE.
text = 'Invalid Date'.
sl_status = 1.
EXIT.
ENDIF.
ENDIF.
ELSEIF tfield_attr-inttype = 'T'.
IF f_value CO ' 0:'.
CLEAR sl_uzeit.
ELSE.
CALL FUNCTION 'CONVERT_TIME_INPUT'
EXPORTING
input = f_value
plausibility_check = 'X'
IMPORTING
output = sl_uzeit
EXCEPTIONS
plausibility_check_failed = 1
wrong_format_in_input = 2
OTHERS = 3.
IF sy-subrc = 0.
ELSE.
text = 'Invalid Time'.
sl_status = 1.
EXIT.
ENDIF.
ENDIF.
ELSEIF tfield_attr-inttype = 'C'.
TRANSLATE f_value TO UPPER CASE.
ELSE.
TRANSLATE f_value USING ', '.
CONDENSE f_value NO-GAPS.
TRY.
CATCH cx_root INTO ref_ptr.
text = ref_ptr->get_text( ).
sl_status = 1.
EXIT.
ENDTRY.
ENDIF.
SHIFT sline BY tfield_attr-outputlen PLACES.
SHIFT sline LEFT.
ENDIF.
UNASSIGN
ENDLOOP.
IF sl_status = 0.
CASE ss_step.
WHEN 1. "Delete
ADD 1 TO d_stat.
APPEND
WHEN 2. "Modify
ADD 1 TO m_stat.
APPEND
ENDCASE.
ENDIF.
ENDIF.
ENDDO.
IF sl_status = 0.
IF d_stat IS NOT INITIAL.
slchar = d_stat.
CONCATENATE 'Deleted -' slchar 'record.' INTO text
SEPARATED BY space.
DELETE (tabname) FROM TABLE
ENDIF.
IF m_stat IS NOT INITIAL.
slchar = m_stat.
CONCATENATE text 'Modified -' slchar 'record.' INTO text
SEPARATED BY space.
MODIFY (tabname) FROM TABLE
ENDIF.
IF d_stat IS INITIAL AND m_stat IS INITIAL.
MESSAGE 'No changes were done' TYPE 'S'.
ELSE.
MESSAGE text TYPE 'S'.
ENDIF.
LEAVE.
ELSE.
MESSAGE text TYPE 'I'.
EXIT.
ENDIF.
ELSE.
LEAVE.
ENDIF.
ENDCASE.
*----------------------------
* Below is Function for a Dynamic Selection Screen
FUNCTION zstan_selections.
*"----------------------------------------------------------------------
*"*"Local interface:
*" IMPORTING
*" VALUE(TABNAME) LIKE DD02L-TABNAME DEFAULT 'ZSCARE'
*" EXPORTING
*" VALUE(DS_CLAUSES) TYPE RSDS_WHERE
*" EXCEPTIONS
*" TABLE_NOT_VALID
*" OTHER_ERROR
*"----------------------------------------------------------------------
DATA texpr TYPE rsds_texpr.
DATA twhere TYPE rsds_twhere.
DATA trange TYPE rsds_trange.
DATA BEGIN OF qcat. "Selections View for
INCLUDE STRUCTURE rsdsqcat. "Free Selectoptions
DATA END OF qcat.
DATA BEGIN OF tabs OCCURS 10.
INCLUDE STRUCTURE rsdstabs.
DATA END OF tabs.
DATA BEGIN OF fields OCCURS 10.
INCLUDE STRUCTURE rsdsfields.
DATA END OF fields.
DATA BEGIN OF efields OCCURS 10.
INCLUDE STRUCTURE rsdsfields.
DATA END OF efields.
DATA selid LIKE rsdynsel-selid.
DATA actnum LIKE sy-tfill.
DATA title LIKE sy-title VALUE 'Selection Screen'.
DATA: maxnum LIKE sy-subrc VALUE '69'.
CLEAR tabs.
tabs-prim_tab = tabname.
COLLECT tabs.
DATA: position LIKE dd03l-position.
DATA: keyflag LIKE dd03l-keyflag.
CLEAR fields.
fields-tablename = tabname.
fields-sign = 'I'.
DATA: step LIKE sy-subrc.
SELECT fieldname keyflag position
INTO (fields-fieldname, keyflag, position)
FROM dd03l
WHERE tabname = tabname
AND fieldname NOT LIKE '.INCLU%'
AND datatype NE 'CLNT'
ORDER BY position.
ADD 1 TO step.
CHECK step LE maxnum.
IF keyflag <> 'X'.
efields = fields.
APPEND efields.
ENDIF.
APPEND fields.
ENDSELECT.
IF sy-subrc <> 0.
RAISE table_not_valid.
ENDIF.
CALL FUNCTION 'FREE_SELECTIONS_INIT'
EXPORTING
expressions = texpr
kind = 'F'
IMPORTING
selection_id = selid
expressions = texpr
where_clauses = twhere
field_ranges = trange
number_of_active_fields = actnum
TABLES
tables_tab = tabs
fields_tab = fields
fields_not_selected = efields
EXCEPTIONS
fields_incomplete = 01
fields_no_join = 02
field_not_found = 03
no_tables = 04
table_not_found = 05
expression_not_supported = 06
incorrect_expression = 07
illegal_kind = 08
area_not_found = 09
inconsistent_area = 10
kind_f_no_fields_left = 11
kind_f_no_fields = 12
too_many_fields = 13.
IF sy-subrc = 0.
CALL FUNCTION 'FREE_SELECTIONS_DIALOG'
EXPORTING
selection_id = selid
title = title
IMPORTING
where_clauses = twhere
expressions = texpr
field_ranges = trange
number_of_active_fields = actnum
TABLES
fields_tab = fields
EXCEPTIONS
internal_error = 01
no_action = 02
no_fields_selected = 03
no_tables_selected = 04
selid_not_found = 05.
IF sy-subrc = 0.
CLEAR ds_clauses.
MOVE tabname TO ds_clauses-tablename.
READ TABLE twhere WITH KEY ds_clauses-tablename INTO ds_clauses.
IF sy-subrc <> 0.
RAISE other_error.
ENDIF.
ELSE.
RAISE other_error.
ENDIF.
ELSE.
RAISE other_error.
ENDIF.
ENDFUNCTION.
Hi
ReplyDeleteI like this post:
You create good material for community.
Please keep posting.
Let me introduce other material that may be good for net community.
Source: Maintenance interview questions
Best rgs
Peter