SAP ABAP上传下载报表程序
这个程序可实现报表的完全下载和上传。一步到位。上传完成便可直接执行。
之后在完善。代码如下*&---------------------------------------------------------------------*
*& Report ZUPDOWN
*&---------------------------------------------------------------------*
*&
*&---------------------------------------------------------------------*
REPORTZUPDOWN.
***********************************************************************
* Description :download/upload a report from a flat file along with its Source code,
* Attributes, Textelements, PF-status and Documentation in different languages *
*_____________________________________________________________________*
* Inputs: *
* Tables: *
* SSCRFIELDS - Fields on selectionscreens *
* Select options: *
* N/A *
* Parameters: *
* P_DWN - Radio Button for Download *
* P_UPL - Radio Button for Upload *
* P_PROG - Program Name *
* P_FILE - File Name *
* Outputs: *
* When Uploaded: *
* A report is generated along with its Sourcecode, Attributes, *
* Text elements, PF-status and Documentationand the report would be *
* in Active state. *
* *
* When Downloaded: *
* A file is generated on the local system inwhich Source code, *
* Attributes, Text elements, PF-status andDocumentation of the *
* report are downloaded. *
***********************************************************************
* Tabledeclarations...................................................
TABLES: SSCRFIELDS. " Fields on selection screens
* Selection screenelements............................................
SELECTION-SCREEN BEGIN OF BLOCK B1
WITH FRAME
TITLE TIT1.
SELECTION-SCREEN BEGIN OF LINE.
SELECTION-SCREEN COMMENT 1(20) COMM1FOR FIELD P_DWN.
PARAMETERS: P_DWNRADIOBUTTON GROUP RAD1 DEFAULT'X' USER-COMMAND UCOM.
SELECTION-SCREEN END OF LINE.
SELECTION-SCREEN BEGIN OF LINE.
SELECTION-SCREEN COMMENT 1(20) COMM2FOR FIELD P_UPL.
PARAMETERS: P_UPLRADIOBUTTON GROUP RAD1 .
SELECTION-SCREEN END OF LINE.
SELECTION-SCREEN SKIP.
SELECTION-SCREEN BEGIN OF BLOCK B2
WITH FRAME
TITLE TIT2 .
SELECTION-SCREEN BEGIN OF LINE.
SELECTION-SCREEN COMMENT 1(20) COMM3FOR FIELD P_PROG.
PARAMETERS: P_PROGTYPE TRDIR-NAME MODIF ID BL1.
* "Program Name
SELECTION-SCREEN END OF LINE.
SELECTION-SCREEN SKIP.
SELECTION-SCREEN COMMENT /1(50) COMM5.
SELECTION-SCREEN COMMENT /1(50) COMM6.
SELECTION-SCREEN BEGIN OF LINE.
SELECTION-SCREEN COMMENT 1(20) COMM4FOR FIELD P_FILE.
PARAMETERS: P_FILE TYPE RLGRAP-FILENAME DEFAULT'C:\'
MODIF ID BL1.
* "Download File Name
SELECTION-SCREEN END OF LINE.
SELECTION-SCREEN END OF BLOCK B2.
SELECTION-SCREEN END OF BLOCK B1.
* Type declarations forinternal tables................................
TYPES: BEGIN OF TYPE_S_DD03L,
FIELDNAME TYPE FIELDNAME, " Field Name
END OFTYPE_S_DD03L,
BEGIN OFTYPE_S_TRDIR,
NAME TYPE PROGNAME, " Program Name
EDTX TYPE EDTX, " Editor lock flag
SUBC TYPE SUBC, " Program type
SECU TYPE SECU, " Authorization Group
FIXPT TYPE FIXPT, " Fixed point arithmetic
SSET TYPE SSET, " Start only via variant
UCCHECK TYPE UCCHECK, " Unicode check flag
RSTAT TYPE RDIR_RSTAT, " Status
APPL TYPE RDIR_APPL, " Application
LDBNAME TYPE LDBNAM, " LDB name
TYPE TYPE RDIR_TYPE, " Selection screen version
END OF TYPE_S_TRDIR.
* Workvariables........................................................
DATA:
W_FILE TYPE STRING, " File Name
W_TYPE(10) TYPE C, " File Type
W_EXIST(1) TYPE C, " Flag
W_PROG(60) TYPE C, " Program Name
W_INDEX TYPE SYTABIX, " Index
W_TEXT TYPE REPTI, " Title of the program
W_APPL TYPE RDIR_APPL, " Application
W_PROG2(120) TYPE C, " Program name
W_PROG3(70) TYPE C, " Program name
W_NAME TYPE PROGNAME, " Program name
W_OBJ TYPE TROBJ_NAME, " Object Name in Object List
W_STR TYPE STRING, " String
W_ANS(1) TYPE C, " Answer
W_PGMID TYPE PGMID, " Program ID
W_OBJECT TYPE TROBJTYPE, " Object Type
W_CHAR(1) TYPE C, " Language Key
W_LEN(10) TYPE C, " Reserved length for text
W_STATE TYPE DOKSTATE, " Documentation status
W_TYP TYPE DOKU_TYP, " Documentation type
W_VERSION TYPE DOKVERS, " Documentation version
W_LANG(1) TYPE C, " Language Key
W_MESS TYPE STRING, " Message
W_LIN TYPE I, " Line Number
W_WRD TYPE STRING, " Word
W_STRLEN TYPE I, " String Length
W_CNT2 TYPE I, " Counter Variable
W_CNT3 TYPE I, " Counter Variable
W_FIELD(20) TYPE C, " Holds Text
W_VAL TYPE STRING. " Holds Field Symbol value
*Constants.............................................................
CONSTANTS:
C_ASC(10) VALUE 'ASC', " File type
C_X(1) VALUE 'X', " Flag
C_LANG(1) VALUE 'E', " Language
C_PROG(4) VALUE 'PROG', " Object type
C_STAT(10)VALUE'RSMPE_STAT', " Constant 'RSMPE_STAT'
C_FUNT(10)VALUE'RSMPE_FUNT', " Constant 'RSMPE_FUNT'
C_MEN(9) VALUE 'RSMPE_MEN', " Constant 'RSMPE_MEN'
C_MNLT(10)VALUE'RSMPE_MNLT', " Constant 'RSMPE_MNLT'
C_ACT(9) VALUE 'RSMPE_ACT', " Constant 'RSMPE_ACT'
C_BUT(9) VALUE 'RSMPE_BUT', " Constant 'RSMPE_BUT'
C_PFK(9) VALUE 'RSMPE_PFK', " Constant 'RSMPE_PFK'
C_STAF(10)VALUE'RSMPE_STAF', " Constant 'RSMPE_STAF'
C_ATRT(10)VALUE'RSMPE_ATRT', " Constant 'RSMPE_ATRT'
C_TITT(10)VALUE'RSMPE_TITT', " Constant 'RSMPE_TITT'
C_BUTS(10)VALUE'RSMPE_BUTS', " Constant 'RSMPE_BUTS'
C_SEP(1) VALUE ';', " Separator ';'
C_SEP2(1) VALUE '*'. " Separator '*'
* FieldStrings.........................................................
DATA: FS_TRDIR TYPE TYPE_S_TRDIR, " (Structure) TRDIR
FS_TADIR TYPE TADIR, " (Structure) TADIR
FS_TDEVC TYPE TDEVC, " (Structure) TDEVC
FS_THEAD TYPE THEAD, " (Structure) THEAD
FS_ADM TYPE RSMPE_ADM, " (Structure) RSMPE_ADM
FS_DOC(50000)TYPE C, " (Structure) String
FS_STR(50000)TYPE C, " (Structure) String
FS_DIR TYPE TRDIR, " System Table TRDIR
FS_TRKEY TYPE TRKEY, " (Structure) TRKEY
FS_CODE TYPE STRING, " (Structure) Source Code
FS_ATTR TYPE STRING, " (Structure) Attributes
FS_DOCU TYPE STRING, " (Structure) Documentation
FS_TEXT1 TYPE STRING, " (Structure) Texts
FS_PFS TYPE STRING, " (Structure) PF-Status
FS_DATA TYPE STRING, " (Structure) Complete Data
FS_DATA2 TYPE STRING, " (Structure) Complete Data
FS_DOKIL TYPE DOKIL, " (Structure) Index for
* "Documentation
FS_TLINE TYPE TLINE, " (Structure) Docu Tables
FS_STA TYPE RSMPE_STAT, " (Structure) Text-dependentStat
FS_FUN TYPE RSMPE_FUNT, " (Structure) Language-specific
* "function texts
FS_MEN TYPE RSMPE_MEN, " (Structure) Menu structure
FS_MTX TYPE RSMPE_MNLT, " (Structure) Language-specific
* "menu texts
FS_ACT TYPE RSMPE_ACT, " (Structure) Menu bars
FS_BUT TYPE RSMPE_BUT, " (Structure) Pushbuttons
FS_PFK TYPE RSMPE_PFK, " (Structure) Function key
* "assignments
FS_SET TYPE RSMPE_STAF, " (Structure) Status functions
FS_ATRT TYPE RSMPE_ATRT, " (Structure) Attributes with
* "texts
FS_TIT TYPE RSMPE_TITT, " (Structure) Title Codes with
* "texts
FS_BIV TYPE RSMPE_BUTS, " (Structure) Fixed Functions on
* "Application Toolbars
FS_TXT TYPE TEXTPOOL, " (Structure) ABAP Text Pool
* "Definition
FS_DD03L TYPE TYPE_S_DD03L. " Table Fields
* Internaltables.......................................................
DATA:
*----------------------------------------------------------------------*
* Internal table to holdSource code *
*----------------------------------------------------------------------*
T_CODE TYPE TABLE OF STRING,
*----------------------------------------------------------------------*
* Internal table to holdAttributes *
*----------------------------------------------------------------------*
T_ATTR TYPE STANDARD TABLE OF STRING,
*----------------------------------------------------------------------*
* Internal table to holdDocumentation *
*----------------------------------------------------------------------*
T_DOCU TYPE TABLE OF STRING,
*----------------------------------------------------------------------*
* Internal table to holdTexts *
*----------------------------------------------------------------------*
T_TEXT TYPE TABLE OF STRING,
*----------------------------------------------------------------------*
* Internal table to holdPF-Status *
*----------------------------------------------------------------------*
T_PFS TYPE TABLE OF STRING,
*----------------------------------------------------------------------*
* Internal table to holdComplete data *
*----------------------------------------------------------------------*
T_DATA TYPE TABLE OF STRING,
T_DATA2 TYPE TABLE OF STRING,
*----------------------------------------------------------------------*
* Internal table to holdIndex for Documentation *
*----------------------------------------------------------------------*
T_DOKIL TYPE TABLE OF DOKIL,
*----------------------------------------------------------------------*
* Internal table to holdDocu tables *
*----------------------------------------------------------------------*
T_TLINE TYPE TABLE OF TLINE,
*----------------------------------------------------------------------*
* PF-STATUS relatedtables *
*----------------------------------------------------------------------*
T_STA TYPE TABLE OF RSMPE_STAT,
T_FUN TYPE TABLE OF RSMPE_FUNT,
T_MEN TYPE TABLE OF RSMPE_MEN,
T_MTX TYPE TABLE OF RSMPE_MNLT,
T_ACT TYPE TABLE OF RSMPE_ACT,
T_BUT TYPE TABLE OF RSMPE_BUT,
T_PFK TYPE TABLE OF RSMPE_PFK,
T_SET TYPE TABLE OF RSMPE_STAF,
T_ATRT TYPE TABLE OF RSMPE_ATRT,
T_TIT TYPE TABLE OF RSMPE_TITT,
T_BIV TYPE TABLE OF RSMPE_BUTS,
T_TXT TYPE TABLE OF TEXTPOOL,
T_DD03L TYPE TABLE OF TYPE_S_DD03L.
* FieldSymbols........................................................
FIELD-SYMBOLS: <FS1>TYPE ANY.
*---------------------------------------------------------------------*
* INITIALIZATIONEVENT *
*---------------------------------------------------------------------*
INITIALIZATION.
MOVE : 'Selection Criteria' TO TIT1,
'Specify the required parameters' TO TIT2,
'Download下载' TO COMM1,
'Upload上载' TO COMM2,
'Program Name程序名' TO COMM3,
'File Path文件路径' TO COMM4,
'Specify only File Path in case ofDownload,' TOCOMM5,
'filename is taken from Program nameby default'TOCOMM6.
*---------------------------------------------------------------------*
* AT SELECTION-SCREEN OUTPUTEVENT *
*---------------------------------------------------------------------*
AT SELECTION-SCREEN OUTPUT.
* For upload option
IF P_UPL = 'X'.
MOVE ' ' TO P_FILE.
MOVE ' ' TO P_PROG.
ENDIF. " IF P_UPL = 'X'
* For download option
IF P_DWN = 'X'.
MOVE 'C:\' TO P_FILE.
ENDIF. " IF P_DWN = 'X'
*----------------------------------------------------------------*
* AT SELECTION-SCREEN ON VALUE-REQUEST FORFIELD EVENT *
*----------------------------------------------------------------*
AT SELECTION-SCREEN ON VALUE-REQUEST FOR P_FILE.
* F4 help for file
PERFORM FILE_HELP CHANGING P_FILE.
*--------------------------------------------------------------------*
* AT SELECTION-SCREENEVENT *
*--------------------------------------------------------------------*
AT SELECTION-SCREEN.
* If program name is notentered on the screen
IF SSCRFIELDS-UCOMM = 'ONLI'.
IF P_PROG IS INITIAL.
MESSAGE 'SpecifyProgram Name'TYPE 'E'.
ENDIF. " IF P_PROG IS INITIAL
ENDIF. " IF SSCRFIELDS-UCOMM = 'ONLI'
* If file path is notentered on the screen
IF SSCRFIELDS-UCOMM = 'ONLI'.
IF P_FILE IS INITIAL.
MESSAGE 'SpecifyFile Path'TYPE 'E'.
ENDIF. " IF P_FILE IS INITIAL
ENDIF. " IF SSCRFIELDS-UCOMM = 'ONLI'
* check if program nameentered is greater than 30 chars
W_STRLEN = STRLEN( P_PROG).
IF W_STRLEN GT 30.
CONCATENATE 'Program nametoo long. '
'Nameslonger than 30 chars for internal use only'
INTOW_STR.
MESSAGE W_STR TYPE 'E'.
CLEAR W_STR.
ENDIF. " IF W_STRLEN GT 30...
* Check if the filealready exists
PERFORM CHECK_FILE.
*---------------------------------------------------------------------*
* START-OF-SELECTIONEVENT *
*---------------------------------------------------------------------*
START-OF-SELECTION.
* When download optionis selected
IF P_DWN = 'X'.
* Get Program Name
PERFORM GET_PROG_NAME.
* Check if the programis active or not
PERFORM CHECK_PROG_STATUS.
* Get Source code
PERFORM GET_SOURCE USING FS_TRDIR-NAME.
* Get Attributes
PERFORM GET_ATTR USING FS_TRDIR.
* Get Documentaionmaintained in all the languages
* i.e; includestranslations
PERFORM GET_DOCU.
* Get all the textsmaintained in all the languages
* i.e; includestranslations
PERFORM GET_TEXT USING FS_TRDIR-NAME.
* Get PF-STATUS
PERFORM GET_PFSTAT USING FS_TRDIR-NAME.
* File type
MOVE C_ASC TO W_TYPE.
* Append all the data tofinal internal table
APPEND LINES OF T_CODE TO T_DATA.
APPEND LINES OF T_ATTR TO T_DATA.
APPEND LINES OF T_DOCU TO T_DATA.
APPEND LINES OF T_TEXT TO T_DATA.
APPEND LINES OF T_PFS TO T_DATA.
* Download file
PERFORM DOWNLOAD TABLES T_DATA
USING W_FILE
W_TYPE.
ENDIF. " IF P_DWN = 'X'
* When upload option isselected
IF P_UPL = 'X'.
* Check if the programalready exists
PERFORM CHECK_PROG.
* File type
MOVE C_ASC TO W_TYPE.
* Upload File
PERFORM UPLOAD TABLES T_DATA
USING W_FILE
W_TYPE.
* Split the data intodifferent tables
PERFORM PROCESS_DATA.
* Create New Program
PERFORM CREATE_PROG.
ENDIF. " IF P_UPL = 'X'
*&---------------------------------------------------------------------*
*& Form FILE_HELP *
*&---------------------------------------------------------------------*
* Subroutine for f4 helpfor file *
*----------------------------------------------------------------------*
* PV_FILE ==> FileName *
*----------------------------------------------------------------------*
FORMFILE_HELP CHANGING PV_FILETYPE RLGRAP-FILENAME.
CALL FUNCTION 'F4_FILENAME'
IMPORTING
FILE_NAME = PV_FILE.
ENDFORM. " FILE_HELP
*&---------------------------------------------------------------------*
*& Form CHECK_FILE *
*&---------------------------------------------------------------------*
* Subroutine to check iffile exists or not *
*----------------------------------------------------------------------*
* There are no interfaceparameters to be passed to this subroutine *
*----------------------------------------------------------------------*
FORMCHECK_FILE .
* Concatenate Filepathand Program name to get filename in case
* of download
IF P_DWN = 'X'.
IF P_FILE NS '.txt'.
CONCATENATE P_FILE
P_PROG
'.txt'
INTO P_FILE.
ENDIF. " IF p_file NS...
ENDIF. " IF P_DWN = 'X'
* Populate file andprogram variables
MOVE P_FILE TO W_FILE.
MOVE P_PROG TO W_PROG2.
MOVE P_PROG TO W_PROG3.
CALL FUNCTION 'TMP_GUI_GET_FILE_EXIST'
EXPORTING
FNAME = P_FILE
IMPORTING
EXIST = W_EXIST
EXCEPTIONS
FILEINFO_ERROR = 1
OTHERS =2.
IF SY-SUBRC EQ 0.
* If file already existsin case of download
IF W_EXIST = C_XAND P_DWN = 'X'.
CLEAR: W_STR,W_ANS.
CONCATENATE 'File '
P_FILE
' already exists,'
'do you want to overwrite it?'
INTO W_STR
SEPARATED BY SPACE.
CALL FUNCTION 'POPUP_TO_CONFIRM'
EXPORTING
TEXT_QUESTION = W_STR
DISPLAY_CANCEL_BUTTON = ' '
IMPORTING
ANSWER = W_ANS
EXCEPTIONS
TEXT_NOT_FOUND = 1.
IFSY-SUBRC = 0.
* If user doesn't wantto overwrite the existing file,
* allow him to specifydifferent file name, otherwise continue
IFW_ANS = '2'.
MESSAGE 'Specifyvalid Filename along with Path and Extension'
TYPE 'S'.
STOP.
ENDIF. " IF w_ans = '2'
ENDIF. " IF sy-subrc = 0
* If file does not existin case of upload
ELSEIF W_EXIST NE C_XAND P_UPL = 'X'.
MESSAGE 'Filedoes not exist'TYPE 'S'.
STOP.
ENDIF. " IF W_EXIST = C_X...
ENDIF. " IF SY-SUBRC EQ 0
CLEAR: W_STR,W_ANS.
ENDFORM. " CHECK_FILE
*&---------------------------------------------------------------------*
*& Form GET_PROG_NAME *
*&---------------------------------------------------------------------*
* Subroutine to getprogram name *
*----------------------------------------------------------------------*
* There are no interfaceparameters to be passed to this subroutine *
*----------------------------------------------------------------------*
FORMGET_PROG_NAME.
MOVE P_PROG TO W_PROG.
SELECT SINGLE NAME " ABAP Program Name
EDTX " Editor lock flag
SUBC " Program type
SECU " Authorization Group
FIXPT " Fixed point arithmetic
SSET " Start only via variant
UCCHECK " Unicode check was performed
RSTAT " Status
APPL " Application
LDBNAME " LDB Name
TYPE " Selection screen version
FROMTRDIR
INTOFS_TRDIR
WHERENAME =W_PROG.
IF SY-SUBRC NE 0.
MESSAGE 'Invalid Programname'TYPE 'S'.
STOP.
ENDIF. " IF SY-SUBRC NE 0
ENDFORM. " GET_PROG_NAME
*&---------------------------------------------------------------------*
*& Form GET_SOURCE *
*&---------------------------------------------------------------------*
* Subroutine to getsource code *
*----------------------------------------------------------------------*
* PV_NAME ==> ProgramName *
*----------------------------------------------------------------------*
FORMGET_SOURCE USINGPV_NAMETYPETRDIR-NAME.
READ REPORT PV_NAME INTO T_CODE.
IF SY-SUBRC EQ 0.
CONCATENATE '**This codeis automatically generated by YASH program'
',please do not make any changes**'
INTOFS_CODE
SEPARATED BY SPACE.
INSERT FS_CODE INTO T_CODEINDEX 1.
LOOP AT T_CODE INTO FS_CODE.
IFSY-TABIX NE 1.
MOVESY-TABIX TOW_INDEX.
CONCATENATE 'C'
FS_CODE
INTO FS_CODE.
MODIFYT_CODE FROMFS_CODEINDEXW_INDEX.
ELSE.
MOVESY-TABIX TOW_INDEX.
CONCATENATE 'H'
FS_CODE
INTO FS_CODE.
MODIFYT_CODE FROMFS_CODEINDEXW_INDEX.
ENDIF. " IF SY-TABIX NE 1
ENDLOOP. " LOOP AT T_CODE INTO FS_CODE...
ENDIF. " IF SY-SUBRC EQ 0
ENDFORM. " GET_SOURCE
*&---------------------------------------------------------------------*
*& Form GET_ATTR *
*&---------------------------------------------------------------------*
* Subroutine to getattributes *
*----------------------------------------------------------------------*
* PV_TRDIR ==> TRDIRstructure *
*----------------------------------------------------------------------*
FORMGET_ATTR USINGPV_TRDIRTYPETYPE_S_TRDIR.
* Report Title
SELECT SINGLE TEXT " Report Title
FROMTRDIRT
INTOW_TEXT
WHERENAME = P_PROG
ANDSPRSL =C_LANG.
IF SY-SUBRC EQ 0.
CONCATENATE 'A'
'TEXT'
W_TEXT
INTOFS_ATTR.
APPEND FS_ATTR TO T_ATTR.
CLEAR FS_ATTR.
ENDIF. " IF SY-SUBRC EQ 0
* Type
CONCATENATE 'A'
'SUBC'
PV_TRDIR-SUBC
INTOFS_ATTR.
APPEND FS_ATTR TO T_ATTR.
CLEAR FS_ATTR.
* Status
CONCATENATE 'A'
'RSTAT'
PV_TRDIR-RSTAT
INTOFS_ATTR.
APPEND FS_ATTR TO T_ATTR.
CLEAR FS_ATTR.
* Application
SELECT SINGLE APPL " Applications programs,function
* "modules, logical databases
FROMTAPLP
INTOW_APPL
WHEREAPPL =PV_TRDIR-APPL.
IF SY-SUBRC EQ 0.
CONCATENATE 'A'
'APPL'
W_APPL
INTOFS_ATTR.
APPEND FS_ATTR TO T_ATTR.
CLEAR FS_ATTR.
ENDIF. " IF SY-SUBRC EQ 0
* Authorization Group
CONCATENATE 'A'
'SECU'
PV_TRDIR-SECU
INTOFS_ATTR.
APPEND FS_ATTR TO T_ATTR.
CLEAR FS_ATTR.
* Package
CALL FUNCTION 'AKB_GET_TADIR'
EXPORTING
OBJ_TYPE = C_PROG
OBJ_NAME = PV_TRDIR-NAME
IMPORTING
TADIR = FS_TADIR
TDEVC = FS_TDEVC
EXCEPTIONS
OBJECT_NOT_FOUND = 1
OTHERS =2.
IF SY-SUBRC EQ 0.
CONCATENATE 'A'
'DEVCLASS'
FS_TDEVC-DEVCLASS
INTOFS_ATTR.
APPEND FS_ATTR TO T_ATTR.
CLEAR FS_ATTR.
ELSE.
MESSAGE 'Object notfound'TYPE 'S'.
ENDIF. " IF SY-SUBRC EQ 0
* Logical database
CONCATENATE 'A'
'LDBNAME'
PV_TRDIR-LDBNAME
INTOFS_ATTR.
APPEND FS_ATTR TO T_ATTR.
CLEAR FS_ATTR.
* Selection screenversion
CONCATENATE 'A'
'TYPE'
PV_TRDIR-TYPE
INTOFS_ATTR.
APPEND FS_ATTR TO T_ATTR.
CLEAR FS_ATTR.
* Editor Lock
CONCATENATE 'A'
'EDTX'
PV_TRDIR-EDTX
INTOFS_ATTR.
APPEND FS_ATTR TO T_ATTR.
CLEAR FS_ATTR.
* Fixed point arithmetic
CONCATENATE 'A'
'FIXPT'
PV_TRDIR-FIXPT
INTOFS_ATTR.
APPEND FS_ATTR TO T_ATTR.
CLEAR FS_ATTR.
* Unicode checks active
CONCATENATE 'A'
'UCCHECK'
PV_TRDIR-UCCHECK
INTOFS_ATTR.
APPEND FS_ATTR TO T_ATTR.
CLEAR FS_ATTR.
* Start using variant
CONCATENATE 'A'
'SSET'
PV_TRDIR-SSET
INTO FS_ATTR.
APPEND FS_ATTR TO T_ATTR.
CLEAR FS_ATTR.
* Variables fordocumentation
* Program ID
CONCATENATE 'D'
'PGMID'
FS_TADIR-PGMID
INTOFS_DOCU.
APPEND FS_DOCU TO T_DOCU.
CLEAR FS_DOCU.
* Object Type
CONCATENATE 'D'
'OBJECT'
FS_TADIR-OBJECT
INTOFS_DOCU.
APPEND FS_DOCU TO T_DOCU.
CLEAR FS_DOCU.
ENDFORM. " GET_ATTR
*&---------------------------------------------------------------------*
*& Form GET_DOCU *
*&---------------------------------------------------------------------*
* Subroutine to getdocumentation *
*----------------------------------------------------------------------*
* There are no interfaceparameters to be passed to this subroutine *
*----------------------------------------------------------------------*
FORMGET_DOCU.
* Get Index forDocumentation
SELECT ID " Document class
OBJECT " Documentation Object
LANGU " Documentation Language
TYP " Documentation type
VERSION " Version of DocumentationModule
DOKSTATE " Status of Documentation Module
FROM DOKIL
INTO TABLE T_DOKIL
WHERE OBJECT = W_PROG.
IF SY-SUBRC EQ 0.
LOOP AT T_DOKIL INTO FS_DOKIL.
CLEAR: FS_THEAD,
FS_TLINE,
T_TLINE[].
CALL FUNCTION 'DOCU_READ'
EXPORTING
ID = FS_DOKIL-ID
LANGU = FS_DOKIL-LANGU
OBJECT = FS_DOKIL-OBJECT
TYP = FS_DOKIL-TYP
VERSION = FS_DOKIL-VERSION
IMPORTING
HEAD = FS_THEAD
TABLES
LINE = T_TLINE.
* Text lines
LOOP ATT_TLINE INTOFS_TLINE.
CONCATENATE 'DLINE'
FS_TLINE-TDFORMAT
FS_TLINE-TDLINE
INTO FS_DOCU
SEPARATED BY ';'.
APPENDFS_DOCU TOT_DOCU.
CLEAR FS_DOCU.
ENDLOOP. " LOOP AT T_TLINE INTO FS_TLINE
* Text header
CONCATENATE 'DHEAD'
FS_THEAD-TDOBJECT FS_THEAD-TDNAME FS_THEAD-TDID
FS_THEAD-TDSPRAS FS_THEAD-TDTITLE FS_THEAD-TDFORM
FS_THEAD-TDSTYLE FS_THEAD-TDVERSION
FS_THEAD-TDFUSER FS_THEAD-TDFRELES
FS_THEAD-TDFDATE FS_THEAD-TDFTIME
FS_THEAD-TDLUSER FS_THEAD-TDLRELES
FS_THEAD-TDLDATE FS_THEAD-TDLTIME
FS_THEAD-TDLINESIZE
FS_THEAD-TDTXTLINES FS_THEAD-TDHYPHENAT
FS_THEAD-TDOSPRAS FS_THEAD-TDTRANSTAT
FS_THEAD-TDMACODE1 FS_THEAD-TDMACODE2
FS_THEAD-TDREFOBJ FS_THEAD-TDREFNAME
FS_THEAD-TDREFID FS_THEAD-TDTEXTTYPE
FS_THEAD-TDCOMPRESS FS_THEAD-MANDT FS_THEAD-TDOCLASS
FS_THEAD-LOGSYS
INTO FS_DOCU
SEPARATED BY ';'.
APPENDFS_DOCU TOT_DOCU.
CLEAR FS_DOCU.
* Other parameters
* Documentation Status
CONCATENATE 'D'
'DOKSTATE'
FS_DOKIL-DOKSTATE
INTO FS_DOCU.
APPENDFS_DOCU TOT_DOCU.
CLEAR FS_DOCU.
* Documentation Type
CONCATENATE 'D'
'TYP'
FS_DOKIL-TYP
INTO FS_DOCU.
APPENDFS_DOCU TOT_DOCU.
CLEAR FS_DOCU.
* Documentation Version
CONCATENATE 'D'
'DOKVERSION'
FS_DOKIL-VERSION
INTO FS_DOCU.
APPENDFS_DOCU TOT_DOCU.
CLEAR FS_DOCU.
ENDLOOP. " LOOP AT T_DOKIL INTO FS_DOKIL
ENDIF. " IF SY-SUBRC EQ 0
ENDFORM. " GET_DOCU
*&---------------------------------------------------------------------*
*& Form GET_TEXT *
*&---------------------------------------------------------------------*
* Subroutine to get textelements *
*----------------------------------------------------------------------*
* PV_NAME ==> ProgramName *
*----------------------------------------------------------------------*
FORMGET_TEXT USINGPV_NAMETYPETRDIR-NAME.
DATA: LV_LEN(10)TYPE C.
TYPES: BEGIN OF TYPE_S_TXTLANG,
LANGUAGE TYPE SPRAS,
END OF TYPE_S_TXTLANG.
DATA: FS_TXTLANGTYPE TYPE_S_TXTLANG,
LT_TXTLANG TYPE TABLE OF TYPE_S_TXTLANG.
SELECT LANGUAGE
FROM REPOTEXT
INTO TABLE LT_TXTLANG
WHERE PROGNAME = PV_NAME.
IF SY-SUBRC EQ 0.
LOOP AT LT_TXTLANG INTO FS_TXTLANG.
READ TEXTPOOL PV_NAME INTO T_TXT LANGUAGE FS_TXTLANG-LANGUAGE.
IFSY-SUBRC EQ 0.
LOOP ATT_TXT INTOFS_TXT.
MOVEFS_TXT-LENGTH TOLV_LEN.
CONCATENATE 'T' FS_TXTLANG-LANGUAGE
FS_TXT-ID FS_TXT-KEY
FS_TXT-ENTRY LV_LEN
INTO FS_TEXT1 SEPARATED BY '*%'.
APPENDFS_TEXT1 TOT_TEXT.
CLEAR: FS_TEXT1,
LV_LEN.
ENDLOOP. " LOOP AT T_TXT INTO FS_TXT
* IF report title is notpopulated, exceptional cases
CLEAR: W_LANG.
MOVESY-LANGU TOW_LANG.
IFFS_TXTLANG-LANGUAGE = W_LANG.
CLEAR: FS_TXT-KEY,
LV_LEN,
FS_TEXT1,
FS_TXT.
READ TABLE T_TXT INTO FS_TXT WITH KEY ID ='R'.
IFSY-SUBRC NE 0.
LV_LEN = STRLEN( W_TEXT).
CONCATENATE 'T' FS_TXTLANG-LANGUAGE
'R' FS_TXT-KEY
W_TEXT LV_LEN
INTO FS_TEXT1 SEPARATED BY '*%'.
APPENDFS_TEXT1 TOT_TEXT.
CLEAR: FS_TEXT1,
LV_LEN.
ENDIF. " IF SY-SUBRC NE 0
ENDIF. " IF FS_TXTLANG-LANGUAGE...
ENDIF. " IF SY-SUBRC EQ 0
ENDLOOP. " LOOP AT lt_txtlang
ENDIF. " IF SY-SUBRC EQ 0
ENDFORM. " GET_TEXT
*&---------------------------------------------------------------------*
*& Form GET_PFSTAT *
*&---------------------------------------------------------------------*
* Subroutine to getpf-status *
*----------------------------------------------------------------------*
* PV_NAME ==> ProgramName *
*----------------------------------------------------------------------*
FORMGET_PFSTAT USINGPV_NAMETYPETRDIR-NAME.
DATA:
LT_LANGU TYPE TABLE OF SPRSL,
FS_LANGU TYPE SPRSL.
SELECT SPRSL
FROM RSMPTEXTS
INTO TABLE LT_LANGU
WHERE PROGNAME = PV_NAME.
IF SY-SUBRC EQ 0.
SORT LT_LANGU.
DELETE ADJACENT DUPLICATES FROM LT_LANGU.
LOOP AT LT_LANGU INTO FS_LANGU.
CLEAR: FS_ADM,
FS_STA, T_STA[],
FS_FUN, T_FUN[],
FS_MEN, T_MEN[],
FS_MTX, T_MTX[],
FS_ACT, T_ACT[],
FS_BUT, T_BUT[],
FS_PFK, T_PFK[],
FS_SET, T_SET[],
FS_ATRT,T_ATRT[],
FS_TIT, T_TIT[],
FS_BIV, T_BIV[].
CALL FUNCTION 'RS_CUA_INTERNAL_FETCH'
EXPORTING
PROGRAM = PV_NAME
LANGUAGE = FS_LANGU
IMPORTING
ADM = FS_ADM
TABLES
STA = T_STA
FUN = T_FUN
MEN = T_MEN
MTX = T_MTX
ACT = T_ACT
BUT = T_BUT
PFK = T_PFK
SET = T_SET
DOC = T_ATRT
TIT = T_TIT
BIV = T_BIV
EXCEPTIONS
NOT_FOUND = 1
UNKNOWN_VERSION = 2
OTHERS = 3.
IFSY-SUBRC EQ 0.
CONCATENATE 'PLAN'
FS_LANGU
INTO FS_PFS.
APPENDFS_PFS TOT_PFS.
CLEAR FS_PFS.
CLEAR: W_CNT3.
PERFORMDOWNLOAD_PF_TABS TABLES T_STA
USING C_STAT
FS_STA
'FS_STA-'
'PSTA'.
PERFORMDOWNLOAD_PF_TABS TABLES T_FUN
USING C_FUNT
FS_FUN
'FS_FUN-'
'PFUN'.
PERFORMDOWNLOAD_PF_TABS TABLES T_MEN
USING C_MEN
FS_MEN
'FS_MEN-'
'PMEN'.
PERFORMDOWNLOAD_PF_TABS TABLES T_MTX
USING C_MNLT
FS_MTX
'FS_MTX-'
'PMTX'.
PERFORMDOWNLOAD_PF_TABS TABLES T_ACT
USING C_ACT
FS_ACT
'FS_ACT-'
'PACT'.
PERFORMDOWNLOAD_PF_TABS TABLES T_BUT
USING C_BUT
FS_BUT
'FS_BUT-'
'PBUT'.
PERFORMDOWNLOAD_PF_TABS TABLES T_PFK
USING C_PFK
FS_PFK
'FS_PFK-'
'PPFK'.
PERFORMDOWNLOAD_PF_TABS TABLES T_SET
USING C_STAF
FS_SET
'FS_SET-'
'PSET'.
PERFORMDOWNLOAD_PF_TABS TABLES T_ATRT
USING C_ATRT
FS_ATRT
'FS_ATRT-'
'PATR'.
PERFORMDOWNLOAD_PF_TABS TABLES T_TIT
USING C_TITT
FS_TIT
'FS_TIT-'
'PTIT'.
PERFORMDOWNLOAD_PF_TABS TABLES T_BIV
USING C_BUTS
FS_BIV
'FS_BIV-'
'PBIV'.
CLEAR: W_CNT3.
CONCATENATE 'PADM'
FS_ADM-ACTCODE FS_ADM-MENCODE FS_ADM-PFKCODE
FS_ADM-DEFAULTACT FS_ADM-DEFAULTPFK
FS_ADM-MOD_LANGU
INTO FS_PFS
SEPARATED BY ';'.
APPENDFS_PFS TOT_PFS.
CLEAR FS_PFS.
ELSE.
MESSAGE 'Errorduring PF-STATUS download'TYPE 'E' DISPLAYLIKE
'S'.
ENDIF. " IF SY-SUBRC EQ 0
ENDLOOP. " LOOP AT LT_LANGU INTO FS_LANGU
ENDIF. " IF SY-SUBRC EQ 0
CONCATENATE 'PTRK'
FS_TADIR-DEVCLASS
FS_TADIR-OBJECT
P_PROG
INTOFS_PFS
SEPARATED BY ';'.
APPEND FS_PFS TO T_PFS.
CLEAR FS_PFS.
ENDFORM. " GET_PFSTAT
*&---------------------------------------------------------------------*
*& Form DOWNLOAD *
*&---------------------------------------------------------------------*
* Subroutine to downlaodFile to PC *
*----------------------------------------------------------------------*
* PT_ITAB *
* PC_FILE ==>Filename *
* PC_TYPE ==>Filetype *
*----------------------------------------------------------------------*
FORMDOWNLOAD TABLESPT_ITAB
USING PC_FILE TYPE STRING
PC_TYPE TYPE CHAR10.
CALL FUNCTION 'GUI_DOWNLOAD'
EXPORTING
FILENAME = PC_FILE
FILETYPE = PC_TYPE
TABLES
DATA_TAB = PT_ITAB
EXCEPTIONS
FILE_WRITE_ERROR = 1
NO_BATCH = 2
GUI_REFUSE_FILETRANSFER = 3
INVALID_TYPE = 4
NO_AUTHORITY = 5
UNKNOWN_ERROR = 6
HEADER_NOT_ALLOWED = 7
SEPARATOR_NOT_ALLOWED = 8
FILESIZE_NOT_ALLOWED = 9
HEADER_TOO_LONG = 10
DP_ERROR_CREATE = 11
DP_ERROR_SEND = 12
DP_ERROR_WRITE = 13
UNKNOWN_DP_ERROR = 14
ACCESS_DENIED = 15
DP_OUT_OF_MEMORY = 16
DISK_FULL = 17
DP_TIMEOUT = 18
FILE_NOT_FOUND = 19
DATAPROVIDER_EXCEPTION = 20
CONTROL_FLUSH_ERROR = 21
OTHERS = 22.
IF SY-SUBRC NE 0.
MESSAGE 'Error duringfile download'TYPE 'S'.
ENDIF. " IF SY-SUBRC NE 0
ENDFORM. " DOWNLOAD
*&---------------------------------------------------------------------*
*& Form CHECK_PROG_STATUS *
*&---------------------------------------------------------------------*
* Subroutine to checkprogram status *
*----------------------------------------------------------------------*
* There are no interfaceparameters to be passed to this subroutine *
*----------------------------------------------------------------------*
FORMCHECK_PROG_STATUS .
SELECT OBJ_NAME
FROM DWINACTIV
INTO W_OBJ
UP TO 1ROWS
WHERE OBJ_NAME = P_PROG.
ENDSELECT. " SELECT OBJ_NAME...
IF SY-SUBRC EQ 0.
MESSAGE 'Given program isinactive, activate it before downloading'
TYPE 'S'.
STOP.
ENDIF. " IF SY-SUBRC EQ 0
ENDFORM. " CHECK_PROG_STATUS
*&---------------------------------------------------------------------*
*& Form CHECK_PROG *
*&---------------------------------------------------------------------*
* Subroutine to check ifthe program exists *
*----------------------------------------------------------------------*
* There are no interfaceparameters to be passed to this subroutine *
*----------------------------------------------------------------------*
FORMCHECK_PROG .
IF P_PROG+0(1) ='Y'
OR P_PROG+0(1) ='Z'.
SELECT SINGLE NAME " ABAP Program Name
FROM TRDIR
INTO W_NAME
WHERENAME =P_PROG.
IF SY-SUBRC EQ 0.
CONCATENATE 'Program '
P_PROG
' already exists,'
'do you want to overwrite it?'
INTO W_STR
SEPARATED BY SPACE.
CALL FUNCTION 'POPUP_TO_CONFIRM'
EXPORTING
TEXT_QUESTION = W_STR
DISPLAY_CANCEL_BUTTON = ' '
IMPORTING
ANSWER = W_ANS
EXCEPTIONS
TEXT_NOT_FOUND = 1
OTHERS =2.
IFSY-SUBRC EQ 0.
* If user doesn't wantto overwrite the existing program,
* Stop and come out ofthe program
IFW_ANS = '2'.
STOP.
* If the user wants tooverwrite the existing program,
* delete it and continue
ELSE.
CALL FUNCTION 'RS_DELETE_PROGRAM'
EXPORTING
PROGRAM = P_PROG
WITH_CUA ='X'
EXCEPTIONS
ENQUEUE_LOCK = 1
OBJECT_NOT_FOUND = 2
PERMISSION_FAILURE = 3
REJECT_DELETION = 4.
IFSY-SUBRC EQ 1.
MESSAGE
'Another User is currently editingthe given program'
TYPE'S'.
STOP.
ENDIF. " IF SY-SUBRC EQ 1
ENDIF. " IF W_ANS = '2'
ENDIF. " IF SY-SUBRC EQ 0
CLEARW_STR.
ENDIF. " IF SY-SUBRC EQ 0
ELSE.
MESSAGE 'Test objectscannot be created in foreign namespaces'
TYPE 'S'.
STOP.
ENDIF. " IF P_PROG+0(1) = 'Y'...
ENDFORM. " CHECK_PROG
*&---------------------------------------------------------------------*
*& Form UPLOAD *
*&---------------------------------------------------------------------*
* Subroutine to Uploadfile data to internal table *
*----------------------------------------------------------------------*
* PT_ITAB *
* PC_FILE ==>Filename *
* PC_TYPE ==>Filetype *
*----------------------------------------------------------------------*
FORMUPLOAD TABLES PT_ITAB
USING PC_FILE TYPE STRING
PC_TYPE TYPE CHAR10.
CALL FUNCTION 'GUI_UPLOAD'
EXPORTING
FILENAME = PC_FILE
FILETYPE = PC_TYPE
TABLES
DATA_TAB = PT_ITAB
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 NE 0.
MESSAGE 'Error duringfile upload'TYPE 'S'.
ENDIF. " IF SY-SUBRC NE 0
ENDFORM. " UPLOAD
*&---------------------------------------------------------------------*
*& Form PROCESS_DATA *
*&---------------------------------------------------------------------*
* Subroutine to processdata *
*----------------------------------------------------------------------*
* There are no interfaceparameters to be passed to this subroutine *
*----------------------------------------------------------------------*
FORMPROCESS_DATA .
LOOP AT T_DATA INTO FS_DATA.
CLEAR: FS_DOC,
FS_STR.
MOVE SY-TABIX TO W_INDEX.
CASE FS_DATA+0(1).
* Header Text
WHEN 'H'.
DELETET_DATA INDEXW_INDEX.
* Code
WHEN 'C'.
MOVEFS_DATA+1TO FS_CODE.
APPENDFS_CODE TOT_CODE.
CLEAR FS_CODE.
DELETET_DATA INDEXW_INDEX.
* Documentation
WHEN 'D'.
MOVEFS_DATA+1TO FS_DOC.
IFFS_DOC+0(5) ='PGMID'.
SHIFTFS_DOC BY 5 PLACES.
MOVEFS_DOC TOW_PGMID.
ELSEIFFS_DOC+0(6) ='OBJECT'.
SHIFTFS_DOC BY 6 PLACES.
MOVEFS_DOC TOW_OBJECT.
ENDIF. " IF FS_DOC+0(5) = 'PGMID'
* Attributes
WHEN 'A'.
MOVEFS_DATA+1TO FS_DOC.
IFFS_DOC+0(4) ='SUBC'.
SHIFTFS_DOC BY 4 PLACES.
MOVEFS_DOC TOFS_DIR-SUBC.
ELSEIFFS_DOC+0(5) ='FIXPT'.
SHIFTFS_DOC BY 5 PLACES.
MOVEFS_DOC TOFS_DIR-FIXPT.
ELSEIFFS_DOC+0(7) ='UCCHECK'.
SHIFTFS_DOC BY 7 PLACES.
MOVEFS_DOC TOFS_DIR-UCCHECK.
ELSEIFFS_DOC+0(4) ='SECU'.
SHIFTFS_DOC BY 4 PLACES.
MOVEFS_DOC TOFS_DIR-SECU.
ELSEIFFS_DOC+0(4) ='EDTX'.
SHIFTFS_DOC BY 4 PLACES.
MOVEFS_DOC TOFS_DIR-EDTX.
ELSEIFFS_DOC+0(4) ='SSET'.
SHIFTFS_DOC BY 4 PLACES.
MOVEFS_DOC TOFS_DIR-SSET.
ELSEIFFS_DOC+0(7) ='LDBNAME'.
SHIFTFS_DOC BY 7 PLACES.
MOVEFS_DOC TOFS_DIR-LDBNAME.
ELSEIFFS_DOC+0(4) ='APPL'.
SHIFTFS_DOC BY 4 PLACES.
MOVEFS_DOC TOFS_DIR-APPL.
ELSEIFFS_DOC+0(5) ='RSTAT'.
SHIFTFS_DOC BY 5 PLACES.
MOVEFS_DOC TOFS_DIR-RSTAT.
ELSEIFFS_DOC+0(4) ='TYPE'.
SHIFTFS_DOC BY 4 PLACES.
MOVEFS_DOC TOFS_DIR-TYPE.
ENDIF. " IF FS_DOC+0(4)..
DELETET_DATA INDEXW_INDEX.
* PF-STATUS
WHEN 'P'.
MOVEFS_DATA+1TO FS_DOC.
IFFS_DOC+0(3) ='TRK'.
FS_STR = FS_DOC+4.
SPLITFS_STR AT ';'
INTO FS_TRKEY-DEVCLASS
FS_TRKEY-OBJ_TYPE
FS_TRKEY-OBJ_NAME.
ENDIF. " IF FS_DOC+0(3)
* Text elements
WHEN 'T'.
MOVEFS_DATA TOFS_DATA2.
APPENDFS_DATA2 TOT_DATA2.
CLEAR FS_DATA2.
DELETET_DATA INDEXW_INDEX.
ENDCASE. " CASE T_DATA+0(1)
ENDLOOP. " LOOP AT T_DATA...
ENDFORM. " PROCESS_DATA
*&---------------------------------------------------------------------*
*& Form CREATE_PROG *
*&---------------------------------------------------------------------*
* Subroutine to createnew program *
*----------------------------------------------------------------------*
* There are no interfaceparameters to be passed to this subroutine *
*----------------------------------------------------------------------*
FORMCREATE_PROG .
* Creates a new programuploading source code and attributes
INSERT REPORT P_PROG
FROMT_CODE
DIRECTORY ENTRY FS_DIR.
* Create TADIR entry forthe new program
CALL FUNCTION 'TR_TADIR_POPUP_ENTRY_E071'
EXPORTING
WI_E071_PGMID = W_PGMID
WI_E071_OBJECT = W_OBJECT
WI_E071_OBJ_NAME = W_PROG2
IMPORTING
WE_TADIR = FS_TADIR
ES_TDEVC = FS_TDEVC
EXCEPTIONS
DISPLAY_MODE = 1
EXIT = 2
GLOBAL_TADIR_INSERT_ERROR = 3
NO_REPAIR_SELECTED = 4
NO_SYSTEMNAME = 5
NO_SYSTEMTYPE = 6
NO_TADIR_TYPE = 7
RESERVED_NAME = 8
TADIR_ENQUEUE_FAILED = 9
DEVCLASS_NOT_FOUND = 10
TADIR_NOT_EXIST = 11
OBJECT_EXISTS = 12
INTERNAL_ERROR = 13
OBJECT_APPEND_ERROR = 14
TADIR_MODIFY_ERROR = 15
OBJECT_LOCKED = 16
NO_OBJECT_AUTHORITY = 17
OTHERS = 18.
IF SY-SUBRC NE 0.
MESSAGE 'Error whilecreating TADIR entry'TYPE 'S'.
ENDIF. " IF SY-SUBRC NE 0
* Upload text elementsto the new program,
* Using translation theycan be maintained in different languages
MOVE 1 TO W_INDEX.
DESCRIBE TABLE T_DATA2 LINES W_CNT2.
LOOP AT T_DATA2 INTO FS_DATA2.
W_CNT3 = W_CNT3 + 1.
CLEAR: FS_DOC,FS_STR.
IF W_INDEX = 1.
MOVEFS_DATA2+3(1)TO W_CHAR.
ENDIF. " IF W_INDEX = 1
* Check if language issame
IF W_CHAR = FS_DATA2+3(1).
MOVEFS_DATA2+6TO FS_DOC.
SPLITFS_DOC AT '*%'
INTO FS_TXT-ID
FS_TXT-KEY
FS_TXT-ENTRY
W_LEN.
MOVEW_LEN TOFS_TXT-LENGTH.
APPENDFS_TXT TOT_TXT.
CLEAR FS_TXT.
W_INDEX = W_INDEX + 1.
* If it comes to lastline of the internal table
IFW_CNT3 =W_CNT2.
* Upload text elementsto the new program
INSERT TEXTPOOL P_PROG FROM T_TXT
LANGUAGE W_CHAR.
CLEAR: W_CHAR,
FS_DOC,
FS_TXT,
T_TXT[].
ENDIF. " IF W_CNT3 = W_CNT2
* If language changes,insert text elements up to here
* into the givenlanguage
ELSE.
* Upload text elementsto the new program
INSERT TEXTPOOL P_PROG FROM T_TXT
LANGUAGE W_CHAR.
CLEAR: W_CHAR,
FS_DOC,
T_TXT,
T_TXT[].
* Append 1st line of newlanguage here
MOVEFS_DATA2+6TO FS_DOC.
SPLITFS_DOC AT '*%'
INTO FS_TXT-ID
FS_TXT-KEY
FS_TXT-ENTRY
W_LEN.
MOVEW_LEN TOFS_TXT-LENGTH.
APPENDFS_TXT TOT_TXT.
CLEAR FS_TXT.
MOVE 1TO W_INDEX.
ENDIF. " IF W_CHAR =...
ENDLOOP. " LOOP AT T_DATA2
LOOP AT T_DATA INTO FS_DATA.
CLEAR: FS_DOC,
FS_STR.
CASE FS_DATA+0(1).
* Documentation
WHEN 'D'.
MOVEFS_DATA+1TO FS_DOC.
IFFS_DOC+0(4) ='LINE'.
MOVEFS_DOC+5TO FS_STR.
SPLITFS_STR AT ';'
INTO FS_TLINE-TDFORMAT
FS_TLINE-TDLINE.
APPENDFS_TLINE TOT_TLINE.
CLEAR: FS_TLINE,
FS_STR.
ELSEIFFS_DOC+0(4) = 'HEAD'.
MOVEFS_DOC+5TO FS_STR.
SPLITFS_STR AT ';'
INTO FS_THEAD-TDOBJECT FS_THEAD-TDNAME
FS_THEAD-TDID FS_THEAD-TDSPRAS
FS_THEAD-TDTITLE FS_THEAD-TDFORM
FS_THEAD-TDSTYLE FS_THEAD-TDVERSION
FS_THEAD-TDFUSER FS_THEAD-TDFRELES
FS_THEAD-TDFDATE FS_THEAD-TDFTIME
FS_THEAD-TDLUSER FS_THEAD-TDLRELES
FS_THEAD-TDLDATE FS_THEAD-TDLTIME
FS_THEAD-TDLINESIZEFS_THEAD-TDTXTLINES
FS_THEAD-TDHYPHENATFS_THEAD-TDOSPRAS
FS_THEAD-TDTRANSTATFS_THEAD-TDMACODE1
FS_THEAD-TDMACODE2 FS_THEAD-TDREFOBJ
FS_THEAD-TDREFNAME FS_THEAD-TDREFID
FS_THEAD-TDTEXTTYPEFS_THEAD-TDCOMPRESS
FS_THEAD-MANDT FS_THEAD-TDOCLASS
FS_THEAD-LOGSYS.
CLEARFS_THEAD-TDNAME.
MOVEW_PROG3 TOFS_THEAD-TDNAME.
CLEARFS_STR.
ELSEIFFS_DOC+0(8) ='DOKSTATE'.
SHIFTFS_DOC BY 8 PLACES.
MOVEFS_DOC TOW_STATE.
ELSEIFFS_DOC+0(3) ='TYP'.
SHIFTFS_DOC BY 3 PLACES.
MOVEFS_DOC TOW_TYP.
ELSEIFFS_DOC+0(10) ='DOKVERSION'.
SHIFTFS_DOC BY 10PLACES.
MOVEFS_DOC TOW_VERSION.
* Update
CALL FUNCTION 'DOCU_UPDATE'
EXPORTING
HEAD = FS_THEAD
STATE = W_STATE
TYP = W_TYP
VERSION = W_VERSION
TABLES
LINE = T_TLINE.
CLEAR: FS_TLINE,
T_TLINE[],
FS_THEAD,
W_STATE,
W_TYP,
W_VERSION.
ENDIF. " IF FS_DOC+0(4) = 'LINE'
* PF-Status
WHEN 'P'.
MOVEFS_DATA+1TO FS_DOC.
IFFS_DOC+0(3) ='LAN'.
MOVEFS_DOC+3TO W_LANG.
ELSEIFFS_DOC+0(3) ='STA'.
PERFORMPOPULATE_PF_TABS TABLES T_STA
USING 'FS_STA'
FS_STA
C_STAT.
ELSEIFFS_DOC+0(3) ='FUN'.
PERFORMPOPULATE_PF_TABS TABLES T_FUN
USING 'FS_FUN'
FS_FUN
C_FUNT.
ELSEIFFS_DOC+0(3) ='MEN'.
PERFORMPOPULATE_PF_TABS TABLES T_MEN
USING 'FS_MEN'
FS_MEN
C_MEN.
ELSEIFFS_DOC+0(3) ='MTX'.
PERFORMPOPULATE_PF_TABS TABLES T_MTX
USING 'FS_MTX'
FS_MTX
C_MNLT.
ELSEIFFS_DOC+0(3) ='ACT'.
PERFORMPOPULATE_PF_TABS TABLES T_ACT
USING 'FS_ACT'
FS_ACT
C_ACT.
ELSEIFFS_DOC+0(3) ='BUT'.
PERFORMPOPULATE_PF_TABS TABLES T_BUT
USING 'FS_BUT'
FS_BUT
C_BUT.
ELSEIFFS_DOC+0(3) ='PFK'.
PERFORMPOPULATE_PF_TABS TABLES T_PFK
USING 'FS_PFK'
FS_PFK
C_PFK.
ELSEIFFS_DOC+0(3) ='SET'.
PERFORMPOPULATE_PF_TABS TABLES T_SET
USING 'FS_SET'
FS_SET
C_STAF.
ELSEIFFS_DOC+0(3) ='ATR'.
PERFORMPOPULATE_PF_TABS TABLES T_ATRT
USING 'FS_ATRT'
FS_ATRT
C_ATRT.
ELSEIFFS_DOC+0(3) ='TIT'.
PERFORMPOPULATE_PF_TABS TABLES T_TIT
USING 'FS_TIT'
FS_TIT
C_TITT.
ELSEIFFS_DOC+0(3) ='BIV'.
PERFORMPOPULATE_PF_TABS TABLES T_BIV
USING 'FS_BIV'
FS_BIV
C_BUTS.
ELSEIFFS_DOC+0(3) ='ADM'.
MOVEFS_DOC+4TO FS_STR.
SPLITFS_STR AT ';'
INTO FS_ADM-ACTCODE
FS_ADM-MENCODE
FS_ADM-PFKCODE
FS_ADM-DEFAULTACT
FS_ADM-DEFAULTPFK
FS_ADM-MOD_LANGU.
* Upload PF-STATUS tothe new program
CALL FUNCTION 'RS_CUA_INTERNAL_WRITE'
EXPORTING
PROGRAM = P_PROG
LANGUAGE = W_LANG
TR_KEY = FS_TRKEY
ADM = FS_ADM
TABLES
STA = T_STA
FUN = T_FUN
MEN = T_MEN
MTX = T_MTX
ACT = T_ACT
BUT = T_BUT
PFK = T_PFK
SET = T_SET
DOC = T_ATRT
TIT = T_TIT
BIV = T_BIV
EXCEPTIONS
NOT_FOUND = 1
OTHERS = 2.
IFSY-SUBRC NE 0.
MESSAGE 'Errorduring PF-STATUS upload'TYPE 'S'.
ENDIF. " IF SY-SUBRC NE 0
CLEAR: W_LANG, FS_ADM,
FS_STA, T_STA[],
FS_FUN, T_FUN[],
FS_MEN, T_MEN[],
FS_MTX, T_MTX[],
FS_ACT, T_ACT[],
FS_BUT, T_BUT[],
FS_PFK, T_PFK[],
FS_SET, T_SET[],
FS_ATRT,T_ATRT[],
FS_TIT, T_TIT[],
FS_BIV, T_BIV[].
ENDIF. " IF FS_DOC+0(3) = 'LAN'
ENDCASE. " CASE FS_DATA+0(1)
ENDLOOP. " LOOP AT T_DATA...
SYNTAX-CHECK FOR T_CODE MESSAGE W_MESS
LINE W_LIN
WORD W_WRD
PROGRAM P_PROG.
IF SY-SUBRC NE 0.
CONCATENATE 'Program '
P_PROG
'is syntactically incorrect,'
'correctit before executing'
INTOW_STR
SEPARATED BY SPACE.
MESSAGE W_STR TYPE 'S'.
CLEAR W_STR.
STOP.
ELSE.
CONCATENATE P_PROG
'created successfully'
INTOW_STR
SEPARATED BY SPACE.
MESSAGE W_STR TYPE 'S'.
CLEAR W_STR.
ENDIF. " IF SY-SUBRC NE 0
ENDFORM. " CREATE_PROG
*&---------------------------------------------------------------------*
*& Form download_pf_tabs *
*&---------------------------------------------------------------------*
* This subroutinedownloads PF Tabs *
*----------------------------------------------------------------------*
* PT_TAB *
* PC_TABNAME ==> Text *
* PC_WA ==> Text *
* PC_TXT ==> Text *
* PC_CONS ==> Text *
*----------------------------------------------------------------------*
FORMDOWNLOAD_PF_TABS TABLES PT_TAB
USING PC_TABNAME
PC_WA
PC_TXT
PC_CONS.
CLEAR: FS_DD03L,T_DD03L[].
SELECT FIELDNAME
FROM DD03L
INTO TABLE T_DD03L
WHERE TABNAME = PC_TABNAME.
IF SY-SUBRC EQ 0.
CLEAR: W_CNT3.
LOOP AT T_DD03L INTO FS_DD03LWHERE FIELDNAME = '.INCLUDE'.
DELETE TABLE T_DD03L FROM FS_DD03L.
ENDLOOP. " LOOP AT T_DD03L INTO...
DESCRIBE TABLE T_DD03L LINES W_CNT3.
ENDIF. " IF SY-SUBRC EQ 0
LOOP AT PT_TAB INTO PC_WA.
CLEAR: W_INDEX,
W_FIELD,
FS_PFS.
LOOP AT T_DD03L INTO FS_DD03L.
MOVESY-TABIX TOW_INDEX.
CONCATENATE PC_TXT FS_DD03L-FIELDNAME INTO W_FIELD.
CONDENSEW_FIELD NO-GAPS.
ASSIGN (W_FIELD)TO <FS1>.
IF <FS1>IS ASSIGNED.
IFW_INDEX = 1.
CONCATENATE PC_CONS
FS_DD03L-FIELDNAME '*' <FS1>
INTO FS_PFS.
ELSE.
CONCATENATE FS_PFS
';'
FS_DD03L-FIELDNAME '*' <FS1>
INTO FS_PFS.
ENDIF. " IF W_INDEX = 1
ENDIF. " IF <FS1> IS ASSIGNED
ENDLOOP. " LOOP AT T_DD03L INTO...
APPEND FS_PFS TO T_PFS.
ENDLOOP. " LOOP AT P_TAB INTO P_WA
ENDFORM. " DOWNLOAD_PF_TABS
*&---------------------------------------------------------------------*
*& Form POPULATE_PF_TABS *
*&---------------------------------------------------------------------*
* This subroutinepopulates PF Tabs *
*----------------------------------------------------------------------*
* PT_TAB *
* PC_WANAME ==> Text *
* PC_WA ==> Text *
* PC_STRUCT ==> Text *
*----------------------------------------------------------------------*
FORMPOPULATE_PF_TABS TABLES PT_TAB
USING PC_WANAME
PC_WA
PC_STRUCT.
UNASSIGN: <FS1>.
FIELD-SYMBOLS: <FS_WA>.
CLEAR: W_STR,
W_CNT2,
FS_STR.
SELECT FIELDNAME
FROM DD03L
INTO TABLE T_DD03L
WHERE TABNAME = PC_STRUCT.
IF SY-SUBRC EQ 0.
SORT T_DD03L.
MOVE FS_DOC+3TO FS_STR.
ASSIGN (PC_WANAME)TO <FS_WA>.
WHILE NOT FS_STR IS INITIAL.
IFFS_STR CSC_SEP.
MOVESY-FDPOS TOW_CNT2.
MOVEFS_STR+0(W_CNT2)TO W_STR.
W_CNT2 = W_CNT2 + 1.
SHIFTFS_STR BYW_CNT2PLACES LEFT.
IFW_STR CSC_SEP2.
CLEAR: W_CNT2.
MOVESY-FDPOS TOW_CNT2.
MOVEW_STR+0(W_CNT2)TO W_WRD.
W_CNT2 = W_CNT2 + 1.
MOVEW_STR+W_CNT2TO W_VAL.
READ TABLE T_DD03L INTO FS_DD03L WITH KEY
FIELDNAME = W_WRD BINARY SEARCH.
IFSY-SUBRC EQ 0.
IF <FS_WA>IS ASSIGNED.
ASSIGNCOMPONENT FS_DD03L-FIELDNAME OF
STRUCTURE <FS_WA>TO <FS1>.
IF<FS1>IS ASSIGNED.
MOVE W_VAL TO <FS1>.
UNASSIGN <FS1>.
ENDIF. " IF <FS1> IS ASSIGNED
ENDIF. " IF <FS_WA> IS ASSIGNED
CLEAR: W_CNT2,
W_STR,
W_WRD,
W_VAL,
FS_DD03L.
ENDIF. " IF SY-SUBRC EQ 0
ENDIF. " IF W_STR CS C_SEP2
ELSE.
IFFS_STR CSC_SEP2.
CLEAR: W_CNT2.
MOVESY-FDPOS TOW_CNT2.
MOVEFS_STR+0(W_CNT2)TO W_WRD.
W_CNT2 = W_CNT2 + 1.
MOVEFS_STR+W_CNT2TO W_VAL.
READ TABLE T_DD03L INTO FS_DD03L WITH KEY
FIELDNAME = W_WRD BINARY SEARCH.
IFSY-SUBRC EQ 0.
IF <FS_WA>IS ASSIGNED.
ASSIGNCOMPONENT FS_DD03L-FIELDNAME OF
STRUCTURE <FS_WA>TO <FS1>.
IF<FS1>IS ASSIGNED.
MOVE W_VAL TO <FS1>.
UNASSIGN <FS1>.
ENDIF. " IF <FS1> IS ASSIGNED
ENDIF. " IF <FS_WA> IS ASSIGNED
CLEAR: W_CNT2,
W_STR,
W_WRD,
W_VAL,
FS_DD03L,
FS_STR.
ENDIF. " IF SY-SUBRC EQ 0
ENDIF. " IF FS_STR CS C_SEP2
ENDIF. " IF FS_STR CS C_SEP
ENDWHILE. " WHILE NOT FS_STR IS INITIAL
APPEND PC_WA TO PT_TAB.
CLEAR PC_WA.
ENDIF. " IF SY-SUBRC EQ 0
UNASSIGN: <FS1>,
<FS_WA>.
ENDFORM. " POPULATE_PF_TABS