ABAP-动态创建DATABASE/FUNCTION(风险)

 

 

警告:此程序仅供研究,请谨慎操作,切勿对系统标准数据表及功能函数进行测试(可能无法修复)。

 

程序:EWUCINS

REPORT EWUCINS MESSAGE-ID US NO STANDARD PAGE HEADING.

* Administrieren Cluster und parallele Tasks

 

PARAMETERS: TESTRUN DEFAULT 'X',       "test B(reak), C(alled)

            P_FKT(3)     DEFAULT 'SIZ'."SIZ,INS,DEL

 

TABLES: TAORA, TAINF.

DATA: H_RUNTI TYPE F.

DATA: BEGIN OF T_DBAFREE OCCURS 0,

        NAME(30),

        BYTES TYPE I,

      END OF T_DBAFREE,

        H_TABNAME LIKE DD02L-TABNAME VALUE 'EWUCLU'.

DATA: BEGIN OF T_DBAONLINE OCCURS 0,

        NAME(30),

        STATUS(9),

      END OF T_DBAONLINE.

DATA: RC LIKE SY-SUBRC.

AT SELECTION-SCREEN OUTPUT.

*f sy-subty = '04'.                                   "dialog

  IF TESTRUN <> 'C'.                   "dialog

    P_FKT = 'SIZ'.

  ENDIF.

 

START-OF-SELECTION.

*******************************************************

* Write out Parameters

*******************************************************

  PERFORM WRITE_PARMS.

 

  GET RUN TIME FIELD H_RUNTI.

************************************************************************

* functions

************************************************************************

  CASE P_FKT.

* available freespace in db ------------------------------------------*

    WHEN 'SIZ'.

      IF SY-DBSYS = 'ORACLE'

      OR SY-DBSYS = 'INFORMIX'.

        PERFORM SEL_DBAFREE.

      ELSE.

* installation --------------------------------------------------------*

* when 'INS'.

        TAORA-TABART = 'APPL0'.

        PERFORM CREATE_TABLE.

        PERFORM CREATE_FUNCTION.

      ENDIF.

* drop ewuclu --------------------------------------------------------*

    WHEN 'DEL'.

      PERFORM DELETE_TABLE.

  ENDCASE.

 

  GET RUN TIME FIELD H_RUNTI.

*  IF testrun = 'B'. BREAK-POINT. ENDIF.

  WRITE: / 'runtime:', H_RUNTI,

         / 'endtime:', SY-UZEIT.

  COMMIT WORK.

  IF TESTRUN = 'C'. LEAVE PROGRAM. ENDIF.       "called

  STOP.

*----------------------------------------------------------------------*

AT LINE-SELECTION.

  T_DBAFREE-name = SY-LISEL(30).

  WRITE: / T_DBAFREE-NAME, 'wurde ausgewählt'(001).

  PERFORM FIND_TABLE_DETAIL.

  PERFORM CREATE_TABLE.

  PERFORM CREATE_FUNCTION.

*----------------------------------------------------------------------*

FORM APPEND_DBAFREE.

  IF SY-SUBRC = 0. APPEND T_DBAFREE. ENDIF.

ENDFORM.

FORM APPEND_DBAONLINE.

  IF SY-SUBRC = 0. APPEND T_DBAONLINE. ENDIF.

ENDFORM.

*----------------------------------------------------------------------*

FORM SEL_DBAFREE.

  CASE SY-DBSYS.

    WHEN 'ORACLE'.

      EXEC SQL PERFORMING APPEND_DBAFREE.

        SELECT TABLESPACE_NAME, SUM(NVL(BYTES,0))/1024

          FROM DBA_FREE_SPACE

          GROUP BY TABLESPACE_NAME INTO :T_DBAFREE

      ENDEXEC.

      EXEC SQL PERFORMING APPEND_DBAONLINE.

        SELECT TABLESPACE_NAME, STATUS

          FROM DBA_TABLESPACES

          INTO :T_DBAONLINE

      ENDEXEC.

      LOOP AT T_DBAONLINE.

        IF T_DBAONLINE-STATUS = 'OFFLINE'.

          DELETE T_DBAFREE WHERE NAME = T_DBAONLINE-NAME.

        ENDIF.

      ENDLOOP.

    WHEN 'INFORMIX'.

      PERFORM LISTE_DBSPACES_CREATE.

    WHEN OTHERS.

      WRITE: / 'DB not implemented'. STOP.

  ENDCASE.

  SORT T_DBAFREE BY BYTES DESCENDING.

  IF TESTRUN <> 'C'.

    LOOP AT T_DBAFREE.

      IF SY-TABIX = 1.

        WRITE: / 'Tablespace', 'Freespace(KB)'.

      ENDIF.

      WRITE: / T_DBAFREE-NAME, T_DBAFREE-BYTES.

    ENDLOOP.

* automatically find biggest freespace

  ELSE.

    LOOP AT T_DBAFREE.

      IF  T_DBAFREE-NAME(8) <> 'PSAPROLL'

      AND T_DBAFREE-NAME(8) <> 'PSAPTEMP'

      AND T_DBAFREE-NAME(6) <> 'SYSTEM'.

        PERFORM FIND_TABLE_DETAIL.

        PERFORM CREATE_TABLE.

        PERFORM CREATE_FUNCTION.

        EXIT.

      ENDIF.

    ENDLOOP.

  ENDIF.

ENDFORM.

*----------------------------------------------------------------------*

FORM FIND_TABLE_DETAIL.

* tabellenart (appl0) bestimmt tablespace/dbspace

  CASE SY-DBSYS.

    WHEN 'ORACLE'.

      SELECT SINGLE * FROM TAORA WHERE TABSPACE = T_DBAFREE-NAME.

    WHEN 'INFORMIX'.

      TAINF-DBSPACES = T_DBAFREE-NAME.

      TRANSLATE TAINF-DBSPACES TO UPPER CASE. "#EC TRANSLANG

      SELECT SINGLE * FROM TAINF WHERE DBSPACES = TAINF-DBSPACES.

      TAORA-TABART = TAINF-TABART.

  ENDCASE.

  IF SY-SUBRC <> 0.

*   write: / 'tabart not found'.

*   exit.

    TAORA-TABART = 'APPL0'.

    IF SY-DBSYS = 'ORACLE'.

      DATA: PROG(72) OCCURS 0 WITH HEADER LINE.

      TABLES: DD02L.

    PROG = 'report x.                                    '. APPEND PROG.

    PROG = 'tables: dd02ora.                             '. APPEND PROG.

      IF SY-SAPRL >= '31I'.

    PROG = 'tables: ddstorage.                           '. APPEND PROG.

      ENDIF.

    PROG = 'form insert_dd02ora.                         '. APPEND PROG.

      CONCATENATE 'dd02ora-tabname = ''' H_TABNAME '''.' INTO PROG.

      APPEND PROG.

      CONCATENATE 'delete from dd02ora where tabname = '''

        H_TABNAME '''.' INTO PROG.

      APPEND PROG.

    PROG = 'dd02ora-source     = ''USR''.                '. APPEND PROG.

    PROG = 'dd02ora-useflag    = ''X''.                  '. APPEND PROG.

     CONCATENATE 'dd02ora-tabspace = ''' T_DBAFREE-NAME '''.' INTO PROG.

      APPEND PROG.

    PROG = 'dd02ora-init       = ''10240''.              '. APPEND PROG.

    PROG = 'dd02ora-next       = ''10240''.              '. APPEND PROG.

    PROG = 'dd02ora-minext     = ''1''.                  '. APPEND PROG.

    PROG = 'dd02ora-maxext     = ''500''.                '. APPEND PROG.

    PROG = 'dd02ora-pctinc     = ''0''.                  '. APPEND PROG.

    PROG = 'dd02ora-ofreelist  = ''1''.                  '. APPEND PROG.

    PROG = 'dd02ora-ofreegroup = ''1''.                  '. APPEND PROG.

    PROG = 'dd02ora-opctfree   = ''10''.                 '. APPEND PROG.

    PROG = 'dd02ora-opctused   = ''40''.                 '. APPEND PROG.

    PROG = 'insert dd02ora.                              '. APPEND PROG.

    PROG = 'endform.                                     '. APPEND PROG.

      DATA: H_GENPROG LIKE TRDIR-NAME.

*     break-point.

      GENERATE SUBROUTINE POOL PROG NAME H_GENPROG MESSAGE PROG.

      PERFORM INSERT_DD02ORA IN PROGRAM (H_GENPROG).

 

    ENDIF.

  ENDIF.

ENDFORM.

*----------------------------------------------------------------------*

FORM CREATE_TABLE.

  DATA: I_DD02V_WA LIKE DD02V,

        I_DD09L_WA LIKE DD09L,

        I_DD03P_TAB LIKE DD03P OCCURS 0 WITH HEADER LINE.

* Header

  I_DD02V_WA-TABNAME    = H_TABNAME.

  I_DD02V_WA-DDLANGUAGE = 'D'.

  I_DD02V_WA-DDTEXT     = '_conv_ Cluster'.

  I_DD02V_WA-TABCLASS   = 'TRANSP'.

  I_DD02V_WA-CONTFLAG   = 'L'.

* Technical Settings

  I_DD09L_WA-TABNAME    = H_TABNAME.

  I_DD09L_WA-TABKAT     = '4'.

  I_DD09L_WA-TABART     = TAORA-TABART.

*_dd09l_wa-bufalow    = 'N'.

* Fields

  I_DD03P_TAB-TABNAME    = H_TABNAME.

  I_DD03P_TAB-DDLANGUAGE = 'D'.

  I_DD03P_TAB-FIELDNAME  = 'MANDT'.

  I_DD03P_TAB-POSITION   = '1'.

  I_DD03P_TAB-KEYFLAG    = 'X'.

  I_DD03P_TAB-DATATYPE   = 'CLNT'.

  I_DD03P_TAB-LENG       = '3'.

  APPEND I_DD03P_TAB.

  I_DD03P_TAB-FIELDNAME  = 'RELID'.

  I_DD03P_TAB-POSITION   = '2'.

  I_DD03P_TAB-KEYFLAG    = 'X'.

  I_DD03P_TAB-DATATYPE   = 'CHAR'.

  I_DD03P_TAB-LENG       = '2'.

  APPEND I_DD03P_TAB.

  I_DD03P_TAB-FIELDNAME  = 'UMSID'.

  I_DD03P_TAB-POSITION   = '3'.

  I_DD03P_TAB-KEYFLAG    = 'X'.

  I_DD03P_TAB-DATATYPE   = 'CHAR'.

  I_DD03P_TAB-LENG       = '4'.

  APPEND I_DD03P_TAB.

  I_DD03P_TAB-FIELDNAME  = 'PAGENO'.

  I_DD03P_TAB-POSITION   = '4'.

  I_DD03P_TAB-KEYFLAG    = 'X'.

  I_DD03P_TAB-DATATYPE   = 'INT4'.

  I_DD03P_TAB-LENG       = '10'.

  APPEND I_DD03P_TAB.

  I_DD03P_TAB-FIELDNAME  = 'CLUSTR'.

  I_DD03P_TAB-POSITION   = '5'.

  I_DD03P_TAB-KEYFLAG    = ' '.

  I_DD03P_TAB-DATATYPE   = 'INT2'.

  I_DD03P_TAB-LENG       = '5'.

  APPEND I_DD03P_TAB.

  I_DD03P_TAB-FIELDNAME  = 'CLUSTD'.

  I_DD03P_TAB-POSITION   = '6'.

  I_DD03P_TAB-KEYFLAG    = ' '.

  I_DD03P_TAB-DATATYPE   = 'LRAW'.

  I_DD03P_TAB-LENG       = '32000'.

  APPEND I_DD03P_TAB.

 

  CALL FUNCTION 'DDIF_TABL_PUT'

       EXPORTING

            NAME              = H_TABNAME

            DD02V_WA          = I_DD02V_WA

            DD09L_WA          = I_DD09L_WA

       TABLES

            DD03P_TAB         = I_DD03P_TAB

*         DD05M_TAB         =

*         DD08V_TAB         =

       EXCEPTIONS

            TABL_NOT_FOUND    = 1

            NAME_INCONSISTENT = 2

            TABL_INCONSISTENT = 3

            PUT_FAILURE       = 4

            PUT_REFUSED       = 5

            OTHERS            = 6.

 

  IF SY-SUBRC <> 0.

    MESSAGE e306(mq) WITH text-110.  "'Table create error'.

  ENDIF.

  CALL FUNCTION 'DDIF_TABL_ACTIVATE'

       EXPORTING

            NAME        = H_TABNAME

          AUTH_CHK    = 'X'

*         PRID        = -1

     IMPORTING

          RC            = RC

       EXCEPTIONS

            NOT_FOUND   = 1

            PUT_FAILURE = 2

            OTHERS      = 3.

  IF SY-SUBRC <> 0 OR RC = 8.

    MESSAGE E341(MQ).

    LEAVE PROGRAM.

  ENDIF.

  CALL FUNCTION 'TRINT_TADIR_INSERT'

       EXPORTING

*           AUTHOR               = SY-UNAME

*           MASTERLANG           = ' '

            DEVCLASS             = 'ECLU'

*           GENFLAG              = ' '

            OBJECT               = 'TABL'

            OBJ_NAME             = 'EWUCLU'

            PGMID                = 'R3TR'

            SRCSYSTEM            = 'SAP'

*      IMPORTING

*           ES_TADIR             =

       EXCEPTIONS

            OBJECT_EXISTS_GLOBAL = 1

            OBJECT_EXISTS_LOCAL  = 2

            OTHERS               = 3.

  IF SY-SUBRC = 3.

     MESSAGE e306(mq) WITH text-120.   "'tadir insert error'

  ENDIF.

 

*  SUBMIT EWUCADM

*          WITH TESTRUN  = 'X'

*          WITH P_FKT    = 'DIR'

*          WITH P_MAXTSK = ' '

*          WITH P_PROG   = ' '

*          WITH P_BATCH  = ' '

*          WITH P_RELID  = ' '

*          WITH P_CLUSIZ = ' '.

ENDFORM.

*----------------------------------------------------------------------*

FORM DELETE_TABLE.

  CALL FUNCTION 'DB_DROP_TABLE'

       EXPORTING

*         DBSYS                 = SY-DBSYS

*         NO_EXEC               = ' '

*         PRID                  = 0

*         PROGNAME              = ' '

            TABNAME               = 'EWUCLU'

*         DB_CHECK_FLAG         = ' '

*    IMPORTING

*         GENPROG               =

*         SUBRC                 =

       EXCEPTIONS

            PROGRAM_NOT_GENERATED = 1

            PROGRAM_NOT_WRITTEN   = 2

            TABLE_NOT_DROPPED     = 3

            OTHERS                = 4.

  IF SY-SUBRC <> 0. MESSAGE e306(mq) WITH text-130. ENDIF.

 

  CALL FUNCTION 'DD_TABL_DEL'

       EXPORTING

            TABNAME   = 'EWUCLU'

            DEL_STATE = 'A'

*                 PRID      = 0

       EXCEPTIONS

            OTHERS    = 1.

  IF SY-SUBRC <> 0. MESSAGE e306(mq) WITH text-140. ENDIF.

 

  CALL FUNCTION 'TRINT_TADIR_DELETE'

       EXPORTING

            OBJECT                   = 'TABL'

            OBJ_NAME                 = 'EWUCLU'

            PGMID                    = 'R3TR'

       EXCEPTIONS

            TADIR_ENTRY_NOT_EXISTING = 1

            OBJECT_EXISTS            = 2

            OTHERS                   = 3.

 

  IF SY-SUBRC = 3. MESSAGE e306(mq) WITH text-150 . ENDIF.

 

ENDFORM.

*----------------------------------------------------------------------*

FORM CREATE_FUNCTION.

  CALL FUNCTION 'FUNCTION_POOL_CREATE'

       EXPORTING

            POOL_NAME           = 'ZCNV'

*         RESPONSIBLE         = SY-UNAME

            SHORT_TEXT          = '_conversion_'

*         NAMESPACE           = ' '

       EXCEPTIONS

            NAME_ALREADY_EXISTS = 1

            NAME_NOT_CORRECT    = 2

            OTHERS              = 3.

  IF SY-SUBRC <> 0 AND SY-SUBRC <> 1.

    MESSAGE e306(mq) WITH text-160.  "Function pool error

  ENDIF.

 

  DATA: I_RSEXC LIKE RSEXC OCCURS 0 WITH HEADER LINE.

  DATA: I_RSEXP LIKE RSEXP OCCURS 0 WITH HEADER LINE.

  DATA: I_RSIMP LIKE RSIMP OCCURS 0 WITH HEADER LINE.

  DATA: I_RSFSO LIKE RSFSO OCCURS 0 WITH HEADER LINE.

  DATA: I_RSTBL LIKE RSTBL OCCURS 0 WITH HEADER LINE.

  DATA: I_RSCHA LIKE RSCHA OCCURS 0 WITH HEADER LINE.

  TABLES: RS38L.

  I_RSIMP-PARAMETER = 'TESTRUN'.

  I_RSIMP-DBFIELD   = 'TRDIR-SQLX'.

  APPEND I_RSIMP.

  I_RSIMP-PARAMETER = 'PROGNAME'.

  I_RSIMP-DBFIELD   = 'TRDIR-NAME'.

  APPEND I_RSIMP.

  I_RSIMP-PARAMETER = 'FUNKTION'.

  I_RSIMP-DBFIELD   = 'TRDIR-TYPE'.

  APPEND I_RSIMP.

  I_RSIMP-PARAMETER = 'UMSID'.

  I_RSIMP-DBFIELD   = 'EWUCLU-UMSID'.

  APPEND I_RSIMP.

  I_RSIMP-PARAMETER = 'UMSI2'.

  I_RSIMP-DBFIELD   = 'EWUCLU-UMSID'.

  APPEND I_RSIMP.

  I_RSIMP-PARAMETER = 'TSKNO'.

  I_RSIMP-DBFIELD   = 'EWUCLU-RELID'.

  APPEND I_RSIMP.

  I_RSIMP-PARAMETER = 'RELID'.

  I_RSIMP-DBFIELD   = 'EWUCLU-RELID'.

  APPEND I_RSIMP.

  I_RSIMP-PARAMETER = 'CLUSIZ'.

  I_RSIMP-DBFIELD   = 'TRDIR-NAME'.

  APPEND I_RSIMP.

 

  CALL FUNCTION 'FUNCTION_CREATE'

       EXPORTING

*         CORRNUM                 = ' '

            FUNCNAME                = 'Z_SUB_PROG'

            FUNCTION_POOL           = 'ZCNV'

*         INTERFACE_GLOBAL        = ' '

            REMOTE_CALL             = 'X'

            SHORT_TEXT              = '_conversion_'

*         SUPPRESS_CORR_CHECK     = 'X'

*         UPDATE_TASK             = ' '

       IMPORTING

            FUNCTION_INCLUDE        = RS38L-INCLUDE

       TABLES

            EXCEPTION_LIST          = I_RSEXC

            EXPORT_PARAMETER        = I_RSEXP

            IMPORT_PARAMETER        = I_RSIMP

            PARAMETER_DOCU          = I_RSFSO

            TABLES_PARAMETER        = I_RSTBL

            CHANGING_PARAMETER      = I_RSCHA

       EXCEPTIONS

            DOUBLE_TASK             = 1

            ERROR_MESSAGE           = 2

            FUNCTION_ALREADY_EXISTS = 3

            INVALID_FUNCTION_POOL   = 4

            INVALID_NAME            = 5

            TOO_MANY_FUNCTIONS      = 6

            OTHERS                  = 7.

  IF SY-SUBRC <> 0.

    IF SY-SUBRC <> 3.

*   write: / 'Irgendwas ist beim FUBA anlegen schiefgegangen', sy-subrc.

      MESSAGE e306(mq) WITH text-160.

    ENDIF.

    EXIT.

  ENDIF.

  DATA: BEGIN OF PROG OCCURS 0,

    LINE(72),

        END OF PROG.

* break-point.

  READ REPORT RS38L-INCLUDE INTO PROG.

  LOOP AT PROG.

    IF PROG-LINE = ' '.

      PROG-LINE = 'submit (progname)'. INSERT PROG INTO PROG.

      PROG-LINE = 'with testrun  = testrun '. INSERT PROG INTO PROG.

      PROG-LINE = 'with p_fkt    = funktion'. INSERT PROG INTO PROG.

      PROG-LINE = 'with p_umsid  = umsid   '. INSERT PROG INTO PROG.

      PROG-LINE = 'with p_umsi2  = umsi2   '. INSERT PROG INTO PROG.

      PROG-LINE = 'with p_tskno  = tskno   '. INSERT PROG INTO PROG.

      PROG-LINE = 'with p_relid  = relid   '. INSERT PROG INTO PROG.

      PROG-LINE = 'with p_clusiz = clusiz  '. INSERT PROG INTO PROG.

      PROG-LINE = 'to sap-spool            '. INSERT PROG INTO PROG.

      PROG-LINE = 'without spool dynpro    '. INSERT PROG INTO PROG.

      PROG-LINE = 'and return.             '. INSERT PROG INTO PROG.

      EXIT.

    ENDIF.

  ENDLOOP.

  INSERT REPORT RS38L-INCLUDE FROM PROG.

ENDFORM.

*----------------------------------------------------------------------*

FORM LISTE_DBSPACES_CREATE.

  DATA: BUFSIZE TYPE I.

  PERFORM GET_DB_PARAMETER(RSINF000) USING 'BUFFSIZE' BUFSIZE.

  BUFSIZE = BUFSIZE / 1024 .

*  exec sql performing makedbspaces.

*              c.dbsnum,

*              sum(c.chksize) * :bufsize ,

*       into :dbspaces_chunks

  EXEC SQL PERFORMING APPEND_DBAFREE.

    SELECT D.NAME,

           SUM(C.NFREE)   * :BUFSIZE

    FROM SYSMASTER:SYSDBSPACES D,

         SYSMASTER:SYSCHUNKS C

    WHERE C.DBSNUM = D.DBSNUM

    GROUP BY C.DBSNUM, D.NAME

    INTO :T_DBAFREE

  ENDEXEC.

ENDFORM.

*---------------------------------------------------------------------*

FORM WRITE_PARMS.

  WRITE: / 'testrun:', TESTRUN,

         / 'funktion:',  P_FKT(3),

         / 'time:', SY-UZEIT,

         / '--------------------------------------------------'.

ENDFORM.
原文地址:https://www.cnblogs.com/ricoo/p/10170088.html