data extract 代码生成程序(转)

************************************************************************
**                                                                    **
**             C O M P A N Y   C O N F I D E N T I A L                **
**                                                                    **
**        This program is the property of COMMSCOPE                   **
**        Care should be taken to prevent its unauthorized use.       **
************************************************************************
**                                                                    **
**                    COPYRIGHT (C) 2009 by                           **
**                          COMMSCOPE                                 **
**                                                                    **
**                     ALL RIGHTS RESERVED                            **
**                                                                    **
**                   REVISIONS COPYRIGHT (C)                          **
**                       20xx, 20y, 20zz                              **
**                             by                                     **
**                          COMMSCOPE                                 **
************************************************************************
* HEADER                                                               *
*    Program     :  ZARR1000                                           *
*    Title       :  Create extract codes automatically                 *
*    Author      :  Scott Zheng                                        *
*    Date Written:  02/26/2009                                         *
*    Description :  Create extract codes automaticlly through          *
*                   the certain table.                                 *
*    T-code      :  ZARR1000                                           *
* OTHER PROGRAMS                                                       *
*    Includes    :   not applicable                                    *
*    Logical DB  :   not applicable                                    *
*    Functions   :   not applicable                                    *
*    Dialog      :   not applicable                                    *
*                                                                      *
* AUTHORIZATIONS                                                       *
*    Objects     :   not applicable                                    *
*    Groups      :   not applicable                                    *
*                                                                      *
* INPUT PARAMETERS   none                                              *
* OUTPUT PARAMETERS  none                                              *
*                                                                      *
************************************************************************
*                          CHANGE HISTORY                              *
************************************************************************
* Date     Programmer   CTS Number & Revision Description  SAP Version *
* -------- -----------  ---------------------------------  ----------- *
*
************************************************************************
REPORT ZARR1000 LINE-SIZE  200
          MESSAGE-ID ZA
          NO STANDARD PAGE HEADING.

*&------------------------------------------------------
*  DB Tables
*&------------------------------------------------------
  TABLES: DD03L,           " Table Fields
          DD01L.           " Domains

*&------------------------------------------------------
*  Internal Tables
*&------------------------------------------------------
DATA:
  BEGIN OF IT_TAB_INFO OCCURS 0,
      POSITION  LIKE DD03L-POSITION,   " Position of the field
      FIELDNAME LIKE DD03L-FIELDNAME,  " Field name
      LENG      LIKE DD03L-LENG,       " Length (no. of characters)
      INTTYPE   LIKE DD03L-INTTYPE,    " ABAP data type (C,D,N,...)
      DECIMALS  LIKE DD03L-DECIMALS,   " Number of decimal places
      DOMNAME   LIKE DD03L-DOMNAME,    " Domain name
      SIGNFLAG  LIKE DD01L-SIGNFLAG,   " Flag for sign in numerical
END OF IT_TAB_INFO.

*&------------------------------------------------------
*  Work fields
*&------------------------------------------------------
DATA: TOTL      TYPE I,                  " Total length of all column
      TOTLS     TYPE STRING,             " Total length (String typ)
      TNAME     TYPE STRING,             " Table name (String typ)
      LINENUM   TYPE STRING,             " Line number(String typ)
      CLENGTH   TYPE I,                  " Column length (I typ)
      CLENGTHS  TYPE STRING,             " Column length (String typ)
      FIELDNAME TYPE STRING.             " Field name

*&------------------------------------------------------
*  Selection Screen
*&------------------------------------------------------
  PARAMETERS: P_TNAME LIKE DD03L-TABNAME OBLIGATORY.  " Table name

**********************************************************
*  START-OF-SELECTION
**********************************************************
START-OF-SELECTION.

  SELECT POSITION             " Position of the field
         FIELDNAME            " Field name
         LENG                 " Length (no. of characters)
         INTTYPE              " ABAP data type (C,D,N,...)
         DECIMALS             " Number of decimal places
         DOMNAME              " Domain name
    FROM DD03L
    INTO CORRESPONDING FIELDS OF TABLE IT_TAB_INFO
   WHERE TABNAME = P_TNAME
*    exclude field 'MANDT'
     AND FIELDNAME <> 'MANDT'
*    exclude the field name like '.INCLUDE'
     AND FIELDNAME <> '.INCLUDE'
*    exclude the field name like '.INCLU--AP'
     AND FIELDNAME <> '.INCLU--AP'.

* Check the table is exist
 IF SY-SUBRC = 0.
* Sort IT_TAB_INFO by field position
SORT IT_TAB_INFO ASCENDING BY POSITION.

* Get the total length of all columns
LOOP AT IT_TAB_INFO.

* Check the numerical fields.
  IF IT_TAB_INFO-INTTYPE = 'P'.
*    If the numerical field have decimals.
      IF NOT IT_TAB_INFO-DECIMALS IS INITIAL.
*    Add 1 to the field length
         IT_TAB_INFO-LENG = IT_TAB_INFO-LENG + 1.
      ENDIF.            " IF NOT IT_TAB_INFO-DECIMA...

*    Check the sign in numerical fields
     SELECT SINGLE SIGNFLAG     " Flag for sign in numerical fields
       FROM DD01L
       INTO IT_TAB_INFO-SIGNFLAG
      WHERE DOMNAME = IT_TAB_INFO-DOMNAME
        AND SIGNFLAG = 'X'.

       IF SY-SUBRC = 0.
*    Add 1 to the field length
         IT_TAB_INFO-LENG = IT_TAB_INFO-LENG + 1.
       ENDIF.                   " if sy-subrc = 0.
    MODIFY IT_TAB_INFO.
  ENDIF.                " IT_TAB_INFO-INTTYPE = 'P'

* Calculate the whole fields length
  TOTL = TOTL + IT_TAB_INFO-LENG.
ENDLOOP.

* Convert type of total length to String
  TOTLS = TOTL.
* Ignore the gaps.
  CONDENSE TOTLS NO-GAPS.

*  Ignore the gaps of table name
   TNAME = P_TNAME.
   CONDENSE TNAME NO-GAPS.

* Print the Extract Code
  PERFORM. PRINT_EXTRACT_CODE.
 ELSE.
   MESSAGE I999 WITH 'The table is not exist in SAP system'.
 ENDIF.            " if sy-subrc = 0.

 

*&---------------------------------------------------------------------*
*&      Form  PRINT_EXTRACT_CODE
*&---------------------------------------------------------------------*
*       Print the code of data extract
*----------------------------------------------------------------------*
*       No parameters
*----------------------------------------------------------------------*
FORM. PRINT_EXTRACT_CODE.

* Print the part of Table Definition
  WRITE:  '*  Step 1. Declare Table',
        / 'TABLES:' NO-GAP,
        /  TNAME    NO-GAP,'.'.

* Skip 3 lines
SKIP.
SKIP.
SKIP.

* Print the part of Internal Table Definition
WRITE: '* Step 2. Declare Internal table',
     / 'DATA:  BEGIN OF IT_' NO-GAP,
       TNAME                 NO-GAP,
       ' OCCURS 0.',
     / 'INCLUDE STRUCTURE '  NO-GAP,
       TNAME                 NO-GAP,
       '.',
     / 'DATA:  END OF IT_'   NO-GAP,
       TNAME                 NO-GAP,
       '.'.

* Skip 2 lines
SKIP.
SKIP.

* Print the header of structure definition
WRITE: /'* Step 3. Declare Structure',
       / 'DATA:  BEGIN OF ST_1 OCCURS 1,'.

* Loop print the body of structure definition
LOOP AT IT_TAB_INFO.

* Line numbers type conversion and ignore gaps
  LINENUM = SY-TABIX.
  CONDENSE LINENUM NO-GAPS.

* Field length type conversion and ignore gaps
  CLENGTH = IT_TAB_INFO-LENG.
  CLENGTHS = CLENGTH.
  CONDENSE CLENGTHS NO-GAPS.

* Print the body and comments
WRITE: / '      ',
         'F_'        NO-GAP,
         LINENUM     NO-GAP,
         '('         NO-GAP,
         CLENGTHS    NO-GAP,
         ')'         NO-GAP,
         ' TYPE '    NO-GAP,
         'C, " FOR ' NO-GAP,
         TNAME       NO-GAP,
         '-'         NO-GAP,
         IT_TAB_INFO-FIELDNAME.
ENDLOOP.

* Print the footer of structure definition
WRITE: / 'END OF ST_1.'.

* Print internal table definition
WRITE: / 'DATA:  IT_1 LIKE ST_1 OCCURS 0 WITH HEADER LINE.'.

* Skip 1 line
SKIP.

* Print data count definition
WRITE: / 'DATA: W_EXTRACT_CNT  TYPE I.'.

* Skip 1 line
SKIP.

* Print operation of internal table
WRITE: / 'CLEAR IT_1.',
       / 'REFRESH IT_1.',
       / 'CLEAR IT_'   NO-GAP,
         TNAME         NO-GAP,
         '.',
       / 'REFRESH IT_' NO-GAP,
         TNAME         NO-GAP,
         '.'.

* Skip 1 line
SKIP.

*Print include subroutines
WRITE: / 'include zaoo4000.',
       / 'include zaoo4001.'.

* Skip 1 line
SKIP.

*Print the operation for data extract
WRITE: /  'OPEN DATASET DSN FOR OUTPUT IN TEXT MODE.',
       /  'IF SY-SUBRC <> 0.',
       /  '   WRITE:/ ''UNABLE TO OPEN DATASET:'',dsn.',
       /  '   EXIT.',
       /  'ENDIF.'.

* Skip 1 line
SKIP.

* Print the statments for getting data from the Database
WRITE: / 'SELECT'.

* Loop print the fields of the table
LOOP AT IT_TAB_INFO.

* indent operation
  IF SY-TABIX > 1.
    WRITE: / '      '.
  ENDIF.     " if sy-tabix > 1.

  WRITE: IT_TAB_INFO-FIELDNAME.
ENDLOOP.

* Print the operation statement for the internal table
WRITE: / 'INTO CORRESPONDING FIELDS OF IT_' NO-GAP,
         TNAME                              NO-GAP,
       / 'FROM '                            NO-GAP,
         TNAME                              NO-GAP,
         '.'                                NO-GAP.

LOOP AT IT_TAB_INFO.

* Line numbers type conversion and ignore gaps
  LINENUM = SY-TABIX.
  CONDENSE LINENUM NO-GAPS.

* Field name ignore gaps
  FIELDNAME = IT_TAB_INFO-FIELDNAME.
  CONDENSE FIELDNAME NO-GAPS.

  WRITE: / '   ',
           'IT_1-F_' NO-GAP,
           LINENUM   NO-GAP,
           ' = IT_'  NO-GAP,
           TNAME     NO-GAP,
           '-'       NO-GAP,
           FIELDNAME NO-GAP,
           '.'.
ENDLOOP.

 

WRITE: / '   TRANSFER IT_1 to DSN length '  NO-GAP,
         TOTLS                              NO-GAP,
         '.',
       / '   ADD 1 TO W_EXTRACT_CNT.',
       / 'ENDSELECT.'.

* Skip 1 line
SKIP.

* Print the log of the extract result
WRITE: / 'WRITE : / ''Extract count to file: '', W_EXTRACT_CNT.'.

* Skip 1 line
SKIP.

* Print the comments of closing dataset
WRITE: / '* CLOSE DSN dataset.'.

* Print the operation of closing dataset
WRITE: / 'CLOSE DATASET DSN.'.

* Skip 1 line
SKIP.

* Print the include program
WRITE: / 'include zaoo4002.'.
ENDFORM.                    " PRINT_EXTRACT_CODE

来自 “ ITPUB博客 ” ，链接：http://blog.itpub.net/181844/viewspace-609115/，如需转载，请注明出处，否则将追究法律责任。

转载于:http://blog.itpub.net/181844/viewspace-609115/