更新程序范例

**************************************************************
* Program Title : upload program
*
* Created by    : Mao jian   Date :  20120720
*
* Description   : for upload data
* Module name   :
* Type          : public
* Special note  : Nothing
***************************************************************

REPORT  ZIRR9013.
*----------------------------------------------------------------------*
* DATA DECLARATION
*----------------------------------------------------------------------*

FIELD-SYMBOLS: <F>.
DATA: GV_FILECOMP_COUNT         TYPE I,
      GV_STRCOMP_COUNT          TYPE I,
      GV_FILERECORD_COUNT       TYPE I,
      GV_POS                    TYPE I,
      GV_POSR                   TYPE I,
      GV_POSF                   TYPE I,
      GV_RECNO(10)              TYPE C,
      GV_SUCCESSFUL_RECORDS(10) TYPE C,
      GV_DELETED_RECORDS(10)    TYPE C,
      GV_FPOSITION(10)          TYPE C,
      GV_TYP                    TYPE C,
      GV_FVALUE(256)            TYPE C.

DATA: GV_FILENAME            TYPE STRING.
DATA: GV_CROSS_CLIENT        TYPE C.
DATA: GV_NUMERIC_CHECK_FIELD TYPE I.
DATA: GV_FIELD_TYPE          TYPE C,
      GV_COMP_NO             TYPE I.
DATA: GV_QUESTION(50)        TYPE C.
DATA: GV_ANSWER              TYPE C.

DATA: WA_DD02L LIKE DD02L.
RANGES: R_TABCLASS FOR WA_DD02L-TABCLASS.

*----------------------------------------------------------------------*
* Constants:
*----------------------------------------------------------------------*
CONSTANTS: C_ACTIVATION_STATUS VALUE 'A',
           C_MANDT(5)          VALUE 'MANDT'.

*----------------------------------------------------------------------*
* REF:
*----------------------------------------------------------------------*
DATA: DREF    TYPE REF TO DATA.
DATA: DREFTMP TYPE REF TO DATA.

FIELD-SYMBOLS: <FS>    TYPE ANY.
FIELD-SYMBOLS: <FSTMP> TYPE ANY.

*----------------------------------------------------------------------*
* Type T_DATA
*----------------------------------------------------------------------*
TYPES: BEGIN OF T_DATA,
         LINE(20000) TYPE C,
       END OF T_DATA.

DATA: ITAB_DATA TYPE STANDARD TABLE OF T_DATA,
      WA_DATA   LIKE LINE OF ITAB_DATA.

*----------------------------------------------------------------------*
* Type T_CLAUSE
*----------------------------------------------------------------------*
TYPES: BEGIN OF T_CLAUSE,
         CLAUSE(72),
       END OF T_CLAUSE.
DATA: ITAB_CLAUSE TYPE STANDARD TABLE OF T_CLAUSE,
      WA_CLAUSE   LIKE LINE OF ITAB_CLAUSE.

*---------------------------------------------------------------------*
*　INITIALIZATION EVENT
*---------------------------------------------------------------------*
INITIALIZATION.
  R_TABCLASS-LOW    = 'TRANSP'.
  R_TABCLASS-SIGN   = 'I'.
  R_TABCLASS-OPTION = 'EQ'.
  APPEND R_TABCLASS.

  R_TABCLASS-LOW    = 'CLUSTER'.
  R_TABCLASS-SIGN   = 'I'.
  R_TABCLASS-OPTION = 'EQ'.
  APPEND R_TABCLASS.

  R_TABCLASS-LOW    = 'POOL'.
  R_TABCLASS-SIGN   = 'I'.
  R_TABCLASS-OPTION = 'EQ'.
  APPEND R_TABCLASS.

*---------------------------------------------------------------------*
*  SELECTION-SCREEN
*---------------------------------------------------------------------*
  SELECTION-SCREEN BEGIN OF BLOCK BLK1 WITH FRAME.
  PARAMETERS: P_TAB(40)  TYPE C OBLIGATORY,
              P_FILE     LIKE RLGRAP-FILENAME OBLIGATORY,
              P_DLMT1    TYPE C,
              P_DLMT2(2) TYPE C,
              P_DLMT3(3) TYPE C,
              P_APP RADIOBUTTON GROUP OPER DEFAULT 'X', "append records
              P_OVR RADIOBUTTON GROUP OPER, "overwrite records
              P_DEL RADIOBUTTON GROUP OPER. "delete all records
  SELECTION-SCREEN END OF BLOCK BLK1.

*---------------------------------------------------------------------*
*　AT SELECTION-SCREEN EVENT
*---------------------------------------------------------------------*
AT SELECTION-SCREEN  .
* Verify table name
  IF P_TAB+0(1) NE 'Z'.
*  message: Upload allowed to customer tables only
    MESSAGE E000(0K) WITH 'Upload allowed to customer tables only.'.
  ENDIF.

  SELECT SINGLE *
    FROM DD02L
    INTO WA_DD02L
   WHERE TABNAME  = P_TAB
     AND AS4LOCAL = C_ACTIVATION_STATUS.

  IF SY-SUBRC NE 0.
    MESSAGE E402(MO) WITH P_TAB.
  ENDIF.

  IF NOT WA_DD02L-TABCLASS IN R_TABCLASS.
*  MESSAGE :is not a database table
    MESSAGE E000(0K) WITH P_TAB 'is not a database table'.
  ENDIF.

* Verify delimiter
  IF P_DLMT1 IS INITIAL AND P_DLMT2 IS INITIAL AND P_DLMT3 IS INITIAL.
* MESSAGE: Please maintain one and only one delimiter.
    MESSAGE E000(0K) WITH 'Please maintain one and only one delimiter.'.
  ENDIF.


*---------------------------------------------------------------------*
*　AT SELECTION-SCREEN EVENT
*---------------------------------------------------------------------*
AT SELECTION-SCREEN ON VALUE-REQUEST FOR P_FILE.
  CALL FUNCTION '/SAPDMC/LSM_F4_FRONTEND_FILE'
    CHANGING
      PATHFILE         = P_FILE
    EXCEPTIONS
      CANCELED_BY_USER = 1
      SYSTEM_ERROR     = 2
      OTHERS           = 3.
  IF SY-SUBRC <> 0.
  ENDIF.

*---------------------------------------------------------------------*
*　START-OF-SELECTION EVENT
*---------------------------------------------------------------------*
START-OF-SELECTION.
* Ask user to confirm before deleting all the entries.
  IF NOT P_DEL IS INITIAL OR NOT P_OVR IS INITIAL.
* Do you really want to delete all the records?
    GV_QUESTION = 'Do you really want to delete all the records?'.
    CALL FUNCTION 'POPUP_TO_CONFIRM'
         EXPORTING
*             Delete table contents
              TITLEBAR              = 'Message'
              TEXT_QUESTION         = GV_QUESTION
              TEXT_BUTTON_1         = 'Yes'(001)
              ICON_BUTTON_1         = ' '
              TEXT_BUTTON_2         = 'No'(002)
              ICON_BUTTON_2         = ' '
              DEFAULT_BUTTON        = '2'
              DISPLAY_CANCEL_BUTTON = SPACE
              POPUP_TYPE            = 'ICON_MESSAGE_WARNING'
         IMPORTING
              ANSWER                = GV_ANSWER
         EXCEPTIONS
              TEXT_NOT_FOUND        = 1
              OTHERS                = 2.
    IF SY-SUBRC <> 0.
      MESSAGE ID SY-MSGID TYPE SY-MSGTY NUMBER SY-MSGNO
              WITH SY-MSGV1 SY-MSGV2 SY-MSGV3 SY-MSGV4.
    ENDIF.
    IF GV_ANSWER = '2'.
      EXIT.
    ENDIF.
  ENDIF.

  GV_FILENAME = P_FILE.

  CREATE DATA DREF TYPE (P_TAB).
  ASSIGN DREF->* TO <FS> CASTING TYPE (P_TAB).
  CREATE DATA DREFTMP TYPE (P_TAB).
  ASSIGN DREFTMP->* TO <FSTMP> CASTING TYPE (P_TAB).

* Delete all the entries and exit
  IF NOT P_DEL IS INITIAL.
    PERFORM Z_DELETE_ALL_RECORDS.
    GV_POS = STRLEN( GV_DELETED_RECORDS ).
* WRITE: record(s) successfully deleted from the system.
    WRITE:/ GV_DELETED_RECORDS+0(GV_POS), 'successfully deleted from the system'.
    EXIT.
  ENDIF.

* upload file into an internal table
  PERFORM Z_GET_DATA.

* check whether table is client independent
  PERFORM Z_CHECK_CROSS_CLIENT  USING P_TAB
                             CHANGING GV_CROSS_CLIENT.

* get the number of fields in the table
  DESCRIBE FIELD <FS> TYPE GV_TYP COMPONENTS GV_STRCOMP_COUNT.

  LOOP AT ITAB_DATA INTO WA_DATA.
    GV_FILERECORD_COUNT = GV_FILERECORD_COUNT + 1.

    DO.
      IF NOT WA_DATA IS INITIAL OR GV_FILECOMP_COUNT < GV_STRCOMP_COUNT.
        GV_FILECOMP_COUNT = GV_FILECOMP_COUNT + 1.
      ENDIF.

      ASSIGN COMPONENT SY-INDEX OF STRUCTURE <FS> TO <F>.

      IF SY-SUBRC <> 0. EXIT. ENDIF.

      IF GV_FILECOMP_COUNT = 1 AND GV_CROSS_CLIENT = SPACE.
        <F> = SY-MANDT.
      ELSE.
        IF NOT P_DLMT1 IS INITIAL.
          SPLIT WA_DATA AT P_DLMT1 INTO GV_FVALUE WA_DATA-LINE.
        ELSEIF NOT P_DLMT2 IS INITIAL.
          SPLIT WA_DATA AT P_DLMT2 INTO GV_FVALUE WA_DATA-LINE.
        ELSE.
          SPLIT WA_DATA AT P_DLMT3 INTO GV_FVALUE WA_DATA-LINE.
        ENDIF.

        DESCRIBE FIELD <F> TYPE GV_FIELD_TYPE COMPONENTS GV_COMP_NO.
        MOVE GV_FVALUE TO <F>.

        CATCH SYSTEM-EXCEPTIONS CONVERSION_ERRORS = 2.
          MOVE GV_FVALUE TO <F>.  " <- Error: CONVT_NO_NUMBER
          IF GV_FIELD_TYPE = 'D'.
            MOVE GV_FVALUE TO GV_NUMERIC_CHECK_FIELD.
          ENDIF.
        ENDCATCH.

        IF SY-SUBRC NE 0.
          PERFORM Z_SHOW_ERRROR.
        ENDIF.

      ENDIF.
    ENDDO.

    IF GV_STRCOMP_COUNT NE GV_FILECOMP_COUNT.
* MESSAGE: File Structure <--> Table Structure Mismatch
      MESSAGE I000(0K) WITH 'File Structure <--> Table Structure Mismatch'.
      REJECT.
    ENDIF.

    IF GV_FILERECORD_COUNT = 1 AND P_OVR = 'X'.
      PERFORM Z_DELETE_ALL_RECORDS.
    ENDIF.

    MODIFY (P_TAB) FROM <FS>.
    IF SY-SUBRC = 0.
      GV_SUCCESSFUL_RECORDS = GV_SUCCESSFUL_RECORDS + 1.
    ENDIF.
    CLEAR WA_DATA.
    CLEAR GV_FILECOMP_COUNT.
  ENDLOOP.

  COMMIT WORK .

  IF P_OVR = 'X'.
    GV_POS = STRLEN( GV_DELETED_RECORDS ).
* WRITE: record(s) successfully deleted from the system.
    WRITE:/ GV_DELETED_RECORDS+0(GV_POS), 'successfully deleted from the system.'.
  ENDIF.

  GV_POS = STRLEN( GV_SUCCESSFUL_RECORDS ).
* WRITE: record(s) successfully updated in the system.
  WRITE:/ GV_SUCCESSFUL_RECORDS+0(GV_POS), 'successfully updated in the system.'.

*&---------------------------------------------------------------------*
*&      Form  Z_GET_DATA
*&---------------------------------------------------------------------*
*       text
*----------------------------------------------------------------------*
*  -->  p1        text
*  <--  p2        text
*----------------------------------------------------------------------*
FORM Z_GET_DATA.
  CALL FUNCTION 'GUI_UPLOAD'
    EXPORTING
      FILENAME                = GV_FILENAME
    TABLES
      DATA_TAB                = ITAB_DATA
    EXCEPTIONS
      FILE_OPEN_ERROR         = 1
      FILE_READ_ERROR         = 2
      NO_BATCH                = 3
      GUI_REFUSE_FILETRANSFER = 4
      INVALID_TYPE            = 5
      NO_AUTHORITY            = 6
      UNKNOWN_ERROR           = 7
      BAD_DATA_FORMAT         = 8
      HEADER_NOT_ALLOWED      = 9
      SEPARATOR_NOT_ALLOWED   = 10
      HEADER_TOO_LONG         = 11
      UNKNOWN_DP_ERROR        = 12
      ACCESS_DENIED           = 13
      DP_OUT_OF_MEMORY        = 14
      DISK_FULL               = 15
      DP_TIMEOUT              = 16
      OTHERS                  = 17.

  IF SY-SUBRC <> 0.
* MESSAGE: File could not be processed
    MESSAGE I000(0K) WITH 'File could not be processed.'.
    REJECT.
  ENDIF.

  IF ITAB_DATA[] IS INITIAL.
* MESSAGE: File has no records
    MESSAGE I000(0K) WITH 'File has no records.'.
    REJECT.
  ENDIF.

ENDFORM.                    " GET_DATA

*&---------------------------------------------------------------------*
*&      Form  Z_CHECK_CROSS_CLIENT
*&---------------------------------------------------------------------*
*       text
*----------------------------------------------------------------------*
*      -->P_P_TAB  text
*      <--P_CROSS_CLIENT  text
*----------------------------------------------------------------------*
FORM Z_CHECK_CROSS_CLIENT    USING P_P_TAB
                          CHANGING P_CROSS_CLIENT.
  DATA:  WA_DD03L LIKE DD03L.

  SELECT SINGLE *
    FROM DD03L
    INTO WA_DD03L
   WHERE TABNAME   = P_P_TAB
     AND FIELDNAME = C_MANDT
      OR ROLLNAME  = C_MANDT
     AND AS4LOCAL  = C_ACTIVATION_STATUS.

  IF SY-SUBRC = 0.
    P_CROSS_CLIENT = SPACE.
  ELSE.
    P_CROSS_CLIENT = 'X'.
  ENDIF.

ENDFORM.                    " CHECK_CROSS_CLIENT

*&---------------------------------------------------------------------*
*&      Form  Z_GET_WHERE_CLAUSE
*&---------------------------------------------------------------------*
*       text
*----------------------------------------------------------------------*
*      -->P_IT_WHERE_CLAUSE  text
*      -->P_P_TAB  text
*----------------------------------------------------------------------*
FORM Z_GET_WHERE_CLAUSE    TABLES P_IT_WHERE_CLAUSE
                        STRUCTURE WA_CLAUSE
                            USING  P_P_TAB.

  DATA:  WA_DD03L LIKE DD03L.

  SELECT SINGLE *
    FROM DD03L
    INTO WA_DD03L
   WHERE TABNAME = P_P_TAB
     AND NOT FIELDNAME = C_MANDT
     AND NOT ROLLNAME  = C_MANDT
     AND KEYFLAG       = 'X'
     AND AS4LOCAL      = C_ACTIVATION_STATUS.

  IF SY-SUBRC = 0.
    WA_CLAUSE =  WA_DD03L-FIELDNAME .
    APPEND WA_CLAUSE TO P_IT_WHERE_CLAUSE.
    WA_CLAUSE = 'IN (SPACE,SPACE)'  .
    APPEND WA_CLAUSE TO P_IT_WHERE_CLAUSE.
  ENDIF.

ENDFORM.                    " GET_WHERE_CLAUSE

*&---------------------------------------------------------------------*
*&      Form  Z_DELETE_ALL_RECORDS
*&---------------------------------------------------------------------*
*       text
*----------------------------------------------------------------------*
*  -->  p1        text
*  <--  p2        text
*----------------------------------------------------------------------*
FORM Z_DELETE_ALL_RECORDS.
*  SELECT * FROM (P_TAB) INTO <FSTMP>.
*    DELETE (P_TAB) FROM <FSTMP>.
*  ENDSELECT.
  DELETE FROM (P_TAB).
  GV_DELETED_RECORDS = SY-DBCNT.

ENDFORM.                    " DELETE_ALL_RECORDS

*&---------------------------------------------------------------------*
*&      Form  Z_SHOW_ERRROR
*&---------------------------------------------------------------------*
*       text
*----------------------------------------------------------------------*
*  -->  p1        text
*  <--  p2        text
*----------------------------------------------------------------------*
FORM Z_SHOW_ERRROR.
  ROLLBACK WORK.
  GV_RECNO = GV_FILERECORD_COUNT.
  GV_FPOSITION = GV_FILECOMP_COUNT.
  CONDENSE GV_RECNO.
  CONDENSE GV_FPOSITION.
  GV_POS = STRLEN( GV_FVALUE ).
  GV_POSR = STRLEN( GV_RECNO ).
  GV_POSF = STRLEN( GV_FPOSITION ).

  WRITE:/ 'System exception occured.'.
*  WRITE:/ TEXT-009.
  WRITE:/ 'Field value',
           GV_FVALUE+0(GV_POS) COLOR COL_NEGATIVE,
           'at record no',
           GV_RECNO+0(GV_POSR) COLOR COL_NEGATIVE,
           'position',
           GV_FPOSITION+0(GV_POSF) COLOR COL_NEGATIVE,
           'could not be interpreted.'.
*  WRITE:/  TEXT-010,
*           GV_FVALUE+0(GV_POS) COLOR COL_NEGATIVE,
*           TEXT-011,
*           GV_RECNO+0(GV_POSR) COLOR COL_NEGATIVE,
*           TEXT-012,
*           GV_FPOSITION+0(GV_POSF) COLOR COL_NEGATIVE,
*           TEXT-013.
  WRITE:/ 'Database Rollbacked.'.
  WRITE:/ 'No records updated.'.
  REJECT.
ENDFORM.                    " SHOW_ERRROR