自己编程请求修改传递

*-----------------------------------------------------------------------
* Report ZTRRQ001
* Author: Alexander Nelovkin
*-----------------------------------------------------------------------
* This programm transports a requests between systems
* Notes: This programm is to be running from within source system!
* !!!!!!!!!!!!!!!!!!!!!!!
* !!! Only Windows NT !!!
* !!!!!!!!!!!!!!!!!!!!!!!
*-----------------------------------------------------------------------

*-----------------------------------------------------------------------
* Comments:
* PF-STATUS 'MAIN' content functions:
* PICK - Mark
* TRNS - Transport
* REFR - Refresh
* ELOG - Export log
*
* PF-STATUS '0001' content functions:
* ILOG - Import log
*
* PF-STATUS '0002' is blank. (type of "List in window" )
*
* External command : 'ZTP' call external command "tp.exe"
* (Created by means of transaction 'SM69')
*
* This programm uses as default:
* 'DEV' as sourse system ID (host name - 'sshost') and
* 'QAS' as target system ID (host name - 'tthost')
*
* Systems have different transport catalogs (in our case:
* sshost//sapmnt/trans - in sourse system;
* tthost//sapmnt/trans - in target system)
*
*-----------------------------------------------------------------------
REPORT ZTRRQ001
LINE-SIZE 80
MESSAGE-ID 38.

TABLES: E070, T000.
*-----------------------------------------------------------------------
* Constants
*-----------------------------------------------------------------------
CONSTANTS: DATAC(4) VALUE 'data',
COFILES(7) VALUE 'cofiles',
LOGC(3) VALUE 'log',
TPPARAM(12) VALUE '/bin/tpparam',
* pointer to TPPARAM file (see HELP for tp.exe)
TR_R VALUE 'R',
TR_K VALUE 'K',
TR_I VALUE 'I',
TR_D VALUE 'D'.

DATA RE070 LIKE E070.

DATA IE070 LIKE E070 OCCURS 1.

DATA: BEGIN OF SELECT_REQUESTS OCCURS 1,
TRKORR LIKE E070-TRKORR,
TRFUNCTION LIKE E070-TRFUNCTION,
END OF SELECT_REQUESTS.

DATA PROTOCOL LIKE BTCXPM OCCURS 0 WITH HEADER LINE.

DATA COMMAND LIKE SXPGCOLIST-NAME.

DATA PARAM LIKE SXPGCOLIST-PARAMETERS.

DATA DEST(12).

SELECTION-SCREEN BEGIN OF BLOCK B1 WITH FRAME TITLE TEXT-008.
* TEXT-008 : Request_parameters
SELECT-OPTIONS TRKORR FOR E070-TRKORR.
SELECT-OPTIONS TRSTATUS FOR E070-TRSTATUS DEFAULT 'R' NO INTERVALS.
* TRSTATUS - Correction status
SELECTION-SCREEN END OF BLOCK B1.

SELECTION-SCREEN BEGIN OF BLOCK B4 WITH FRAME.
SELECTION-SCREEN BEGIN OF LINE.
PARAMETERS REPEAT AS CHECKBOX.
* If REPEAT = 'X' then request REPKORR will be transported once more
SELECTION-SCREEN COMMENT 3(25) TEXT-012 FOR FIELD REPEAT.
* TEXT-012 : Repeating_transport_request
SELECTION-SCREEN POSITION POS_LOW.
PARAMETERS REPKORR LIKE E070-TRKORR. "recurring transport request name
SELECTION-SCREEN END OF LINE.
SELECTION-SCREEN END OF BLOCK B4.

SELECTION-SCREEN BEGIN OF BLOCK B5 WITH FRAME TITLE TEXT-015.
* TEXT-015 : Sourse_system
PARAMETERS SSYSTEM LIKE SY-SYSID DEFAULT 'DEV'. "sourse system ID
PARAMETERS SHOST(6) DEFAULT 'sshost' LOWER CASE."sourse DB host name
PARAMETERS STRCAT(25) DEFAULT '/sapmnt/trans' LOWER CASE.
* STRCAT - sourse system transport directory
SELECTION-SCREEN END OF BLOCK B5.

SELECTION-SCREEN BEGIN OF BLOCK B6 WITH FRAME TITLE TEXT-016.
* TEXT-015 : Target_system
PARAMETERS TSYSTEM LIKE SY-SYSID DEFAULT 'QAS'. "target system ID
PARAMETERS THOST(6) DEFAULT 'tthost' LOWER CASE."target DB host name
PARAMETERS TTRCAT(25) DEFAULT '/sapmnt/trans' LOWER CASE.
* TTRCAT - target system transport directory
SELECT-OPTIONS CLIENT FOR T000-MANDT DEFAULT '010' NO INTERVALS.
* CLIENT - target clients
SELECTION-SCREEN END OF BLOCK B6.

SELECTION-SCREEN BEGIN OF BLOCK B2 WITH FRAME TITLE TEXT-009.
* TEXT-009 : Additional_parameters
PARAMETERS MAXSEL LIKE RSEUMOD-TBMAXSEL DEFAULT 100.
* MAXSEL - check out 'Imported/Not imported' request list size
PARAMETERS LIKEKORR LIKE E070-TRKORR DEFAULT 'DEVK9%'. "mask
PARAMETERS RFCNAME(20) DEFAULT 'QASBG' LOWER CASE. "RFC-connect name
PARAMETERS ADDPARAM(12) LOWER CASE. "additional parameters for tp.exe
SELECTION-SCREEN END OF BLOCK B2.

AT USER-COMMAND.
CASE SY-PFKEY.
*----------------------- GUI-status MAIN -------------------------------
WHEN 'MAIN'.
CASE SY-UCOMM.
WHEN 'PICK'.
PERFORM MARK_LINE.
WHEN 'TRNS'.
SET PF-STATUS '0001'.
SET TITLEBAR '001'.
LOOP AT SELECT_REQUESTS.
PERFORM TRANS_REQUEST.
ENDLOOP.
WHEN 'REFR'.
PERFORM REFRESH_LIST.
WHEN 'ELOG'.
READ CURRENT LINE FIELD VALUE:
RE070-TRKORR INTO RE070-TRKORR
RE070-TRFUNCTION INTO RE070-TRFUNCTION.
PERFORM READ_LOG USING 'E'
RFCNAME
RE070-TRKORR
RE070-TRFUNCTION.
WHEN OTHERS.
ENDCASE.
*------------------------- GUI-status 0001 -----------------------------
WHEN '0001'.
CASE SY-UCOMM.
WHEN 'ILOG'.
WINDOW STARTING AT 45 10 ENDING AT 60 12.
SET PF-STATUS '0002'.
SET TITLEBAR '002'.
PERFORM LIST_TRANS_REQUESTS.
WHEN 'REFR'.
IF REPEAT IS INITIAL.
SET PF-STATUS 'MAIN'.
SET TITLEBAR '001'.
PERFORM REFRESH_LIST.
ELSE.
LEAVE SCREEN.
ENDIF.
WHEN OTHERS.
ENDCASE.
*------------------------ GUI-status 0002 ------------------------------
WHEN '0002'.
CASE SY-UCOMM.
WHEN 'PICK'.
READ CURRENT LINE FIELD VALUE:
SELECT_REQUESTS-TRKORR INTO RE070-TRKORR
SELECT_REQUESTS-TRFUNCTION INTO RE070-TRFUNCTION.
PERFORM READ_LOG USING 'I'
RFCNAME
RE070-TRKORR
RE070-TRFUNCTION.
ENDCASE.
WHEN OTHERS.
ENDCASE.

AT LINE-SELECTION.
CASE SY-PFKEY.
WHEN 'MAIN'.
PERFORM MARK_LINE.
WHEN '0002'.
READ CURRENT LINE FIELD VALUE:
SELECT_REQUESTS-TRKORR INTO RE070-TRKORR
SELECT_REQUESTS-TRFUNCTION INTO RE070-TRFUNCTION.
PERFORM READ_LOG USING 'I'
RFCNAME
RE070-TRKORR
RE070-TRFUNCTION.
WHEN OTHERS.
ENDCASE.

START-OF-SELECTION.
IF REPEAT IS INITIAL.
SET PF-STATUS 'MAIN'.
SET TITLEBAR '001'.
PERFORM EXTRACT_REQUESTS.
PERFORM WRITE_REQUESTS_LIST.
ELSE.
SET PF-STATUS '0001'.
SET TITLEBAR '001'.
NEW-PAGE NO-HEADING NO-TITLE.
SELECT_REQUESTS-TRKORR = REPKORR.
SELECT SINGLE TRFUNCTION FROM E070 INTO SELECT_REQUESTS-TRFUNCTION
WHERE TRKORR EQ REPKORR.
APPEND SELECT_REQUESTS.
PERFORM TRANS_REQUEST.
ENDIF.
*----------------------------------------------------------------------
* FORM EXTRACT_REQUESTS
*----------------------------------------------------------------------
FORM EXTRACT_REQUESTS.
DATA DIR_NAME LIKE EPSF-EPSDIRNAM.
DATA FILE_MASK LIKE EPSF-EPSFILNAM.
DATA LOG_DIR LIKE EPSFILI OCCURS 0 WITH HEADER LINE.
DATA RKEY LIKE EPSFILI-NAME.

REFRESH IE070.
SELECT * FROM E070 APPENDING TABLE IE070 UP TO MAXSEL ROWS
WHERE TRKORR IN TRKORR
AND TRKORR LIKE LIKEKORR
AND TRFUNCTION IN ('K','W')
AND TRSTATUS IN TRSTATUS
ORDER BY TRKORR DESCENDING.
IF SY-SUBRC NE 0.
MESSAGE I001 WITH 'Requests not found'(005).
ENDIF.
CONCATENATE '//' THOST TTRCAT '/' LOGC INTO DIR_NAME.
CONCATENATE SSYSTEM TR_I '*' INTO FILE_MASK.
CALL FUNCTION 'EPS_GET_DIRECTORY_LISTING'
EXPORTING
DIR_NAME = DIR_NAME
FILE_MASK = FILE_MASK
TABLES
DIR_LIST = LOG_DIR.

LOOP AT IE070 INTO RE070.
RE070-TRKORR+3(1) = TR_I.
CONCATENATE RE070-TRKORR '.' TSYSTEM INTO RKEY.
READ TABLE LOG_DIR WITH KEY NAME = RKEY.
IF SY-SUBRC EQ 0.
DELETE IE070.
ENDIF.
ENDLOOP.
ENDFORM. "EXTRACT_REQUESTS.
*---------------------------------------------------------------------
* Form MARK_LINE
*---------------------------------------------------------------------
FORM MARK_LINE.
GET CURSOR FIELD RE070-TRKORR VALUE RE070-TRKORR.
IF SY-SUBRC EQ 0.
READ CURRENT LINE FIELD VALUE RE070-TRKORR INTO RE070-TRKORR.
READ TABLE SELECT_REQUESTS WITH KEY TRKORR = RE070-TRKORR.
IF SY-SUBRC NE 0.
MODIFY CURRENT LINE LINE FORMAT COLOR = 3.
READ CURRENT LINE FIELD VALUE RE070-TRFUNCTION
INTO RE070-TRFUNCTION.
APPEND RE070 TO SELECT_REQUESTS.
ELSE.
MODIFY CURRENT LINE LINE FORMAT COLOR OFF
FIELD FORMAT RE070-TRKORR COLOR 5
RE070-TRFUNCTION COLOR 3
RE070-TRSTATUS COLOR 3
RE070-AS4DATE COLOR 2.
DELETE SELECT_REQUESTS WHERE TRKORR = RE070-TRKORR.
ENDIF.
ENDIF.
ENDFORM. " MARK_LINE
*----------------------------------------------------------------------
* Form TRANS_REQUEST
*----------------------------------------------------------------------
FORM TRANS_REQUEST.
DATA: NAME1 LIKE EPSF-EPSPATH,
NAME2 LIKE EPSF-EPSPATH.
DATA: BEGIN OF PARAMETER OCCURS 0,
BEFORE(74), AFTER(74),
END OF PARAMETER.

IF REPEAT IS INITIAL AND TSYSTEM NE SSYSTEM.
CONCATENATE '//' SHOST STRCAT '/' DATAC '/' TR_D
SELECT_REQUESTS-TRKORR+4
'.' SSYSTEM INTO NAME1.
OPEN DATASET NAME1.
IF SY-SUBRC EQ 0.
CLOSE DATASET NAME1.
CONCATENATE '//' THOST TTRCAT '/' DATAC '/' TR_D
SELECT_REQUESTS-TRKORR+4
'.' SSYSTEM INTO NAME2.
PERFORM COPY_FILE USING NAME1 NAME2.
ENDIF.
CLEAR: NAME1, NAME2.

CONCATENATE '//' SHOST STRCAT '/' COFILES '/' TR_K
SELECT_REQUESTS-TRKORR+4
'.' SSYSTEM INTO NAME1.
CONCATENATE '//' THOST TTRCAT '/' COFILES '/' TR_K
SELECT_REQUESTS-TRKORR+4
'.' SSYSTEM INTO NAME2.
PERFORM COPY_FILE USING NAME1 NAME2.
CLEAR: NAME1, NAME2.
CONCATENATE '//' SHOST STRCAT '/' DATAC '/' TR_R
SELECT_REQUESTS-TRKORR+4
'.' SSYSTEM INTO NAME1.
CONCATENATE '//' THOST TTRCAT '/' DATAC '/' TR_R
SELECT_REQUESTS-TRKORR+4
'.' SSYSTEM INTO NAME2.
PERFORM COPY_FILE USING NAME1 NAME2.
ENDIF.

REFRESH PARAMETER.
PARAMETER-BEFORE = 'addtobuffer'.
CONCATENATE TSYSTEM
'pf='
INTO PARAMETER-AFTER SEPARATED BY ' '.
CONCATENATE PARAMETER-AFTER
'//' THOST TTRCAT TPPARAM
INTO PARAMETER-AFTER.
APPEND PARAMETER.
LOOP AT CLIENT.
IF SY-TABIX NE 1 OR NOT ( REPEAT IS INITIAL ).
ADDPARAM = 'u1'.
ENDIF.
PARAMETER-BEFORE = 'import'.
CONCATENATE TSYSTEM 'client'
INTO PARAMETER-AFTER SEPARATED BY ' '.
CONCATENATE PARAMETER-AFTER
CLIENT-LOW
INTO PARAMETER-AFTER.
CONCATENATE PARAMETER-AFTER
ADDPARAM 'pf=//'
INTO PARAMETER-AFTER SEPARATED BY ' '.
CONCATENATE PARAMETER-AFTER
THOST TTRCAT TPPARAM
INTO PARAMETER-AFTER.
APPEND PARAMETER.
ENDLOOP.
COMMAND = 'ZTP'.
LOOP AT PARAMETER.
CONCATENATE PARAMETER-BEFORE
SELECT_REQUESTS-TRKORR
PARAMETER-AFTER
INTO PARAM SEPARATED BY ' '.
IF TSYSTEM NE SSYSTEM.
DEST = RFCNAME.
ENDIF.
PERFORM CALL_EXTERNAL_COMMAND.
CLEAR DEST.
REFRESH PROTOCOL.
ENDLOOP.
REFRESH PARAMETER.

ENDFORM. " TRANS_REQUEST
*----------------------------------------------------------------------
* Form WRITE_REQUESTS_LIST
*----------------------------------------------------------------------
FORM WRITE_REQUESTS_LIST.
IF IE070 IS INITIAL.
SKIP.
WRITE: 'Requests not found'(002).
ELSE.
LOOP AT IE070 INTO RE070.
WRITE: /3(3) SY-TABIX, RE070-TRKORR COLOR 5 INTENSIFIED OFF.
WRITE: RE070-TRFUNCTION COLOR 3 INTENSIFIED OFF,
RE070-TRSTATUS COLOR 3 INTENSIFIED OFF,
RE070-AS4USER INTENSIFIED OFF,
RE070-AS4DATE COLOR 2 INTENSIFIED OFF.
ENDLOOP.
ENDIF.

ENDFORM. " WRITE_REQUESTS_LIST
*----------------------------------------------------------------------
* Form REFRESH_LIST
*----------------------------------------------------------------------
FORM REFRESH_LIST.
IF SY-LSIND NE 0.
SY-LSIND = 0.
ENDIF.
NEW-PAGE WITH-HEADING WITH-TITLE.
PERFORM EXTRACT_REQUESTS.
PERFORM WRITE_REQUESTS_LIST.
REFRESH SELECT_REQUESTS.

ENDFORM. " REFRESH_LIST
*----------------------------------------------------------------------
* Form CALL_EXTERNAL_COMMAND
*----------------------------------------------------------------------
FORM CALL_EXTERNAL_COMMAND.

WRITE: PARAM COLOR 2.
CALL FUNCTION 'SXPG_CALL_SYSTEM'
DESTINATION DEST
EXPORTING
COMMANDNAME = COMMAND
PARAMETERS = PARAM
TABLES
EXEC_PROTOCOL = PROTOCOL.

PERFORM WRITE_PROTOCOL.

ENDFORM. " CALL_EXTERNAL_COMMAND
*---------------------------------------------------------------------
* Form LIST_TRANS_REQUESTS
*---------------------------------------------------------------------
FORM LIST_TRANS_REQUESTS.
LOOP AT SELECT_REQUESTS.
WRITE: / SELECT_REQUESTS-TRKORR COLOR 2,
SELECT_REQUESTS-TRFUNCTION.
ENDLOOP.

ENDFORM. " LIST_TRANS_REQUESTS
*---------------------------------------------------------------------
* Form READ_LOG
*---------------------------------------------------------------------
FORM READ_LOG USING TYPE_LOG VALUE(DEST) VALUE(TRKORR) VALUE(FUNCTION).
DATA TCODE LIKE SY-TCODE VALUE 'SE01'.
DATA MODE LIKE SY-SUBCS VALUE 'E'.
DATA BDCTAB LIKE BDCDATA OCCURS 0 WITH HEADER LINE.

REFRESH BDCTAB.
CLEAR BDCTAB.
BDCTAB-PROGRAM = 'RDDM0004'.
BDCTAB-DYNPRO = '0100'.
BDCTAB-DYNBEGIN = 'X'.
APPEND BDCTAB.
CLEAR BDCTAB.
BDCTAB-FNAM = 'KO003-TRKORR'.
BDCTAB-FVAL = TRKORR.
APPEND BDCTAB.
CLEAR BDCTAB.
CASE FUNCTION.
WHEN 'K'.
BDCTAB-FNAM = 'KO003-TR_FLAG'.
WHEN 'W'.
BDCTAB-FNAM = 'KO003-CW_FLAG'.
WHEN OTHERS.
EXIT.
ENDCASE.
BDCTAB-FVAL = 'X'.
APPEND BDCTAB.
CLEAR BDCTAB.
BDCTAB-FNAM = 'BDC_OKCODE'.
BDCTAB-FVAL = 'DISP'.
APPEND BDCTAB.
CLEAR BDCTAB.
BDCTAB-PROGRAM = 'RDDM0005'.
CASE FUNCTION.
WHEN 'K'.
BDCTAB-DYNPRO = '0610'.
WHEN 'W'.
BDCTAB-DYNPRO = '0670'.
WHEN OTHERS.
EXIT.
ENDCASE.
BDCTAB-DYNBEGIN = 'X'.
APPEND BDCTAB.
CLEAR BDCTAB.
BDCTAB-FNAM = 'BDC_OKCODE'.
BDCTAB-FVAL = '/8'.
APPEND BDCTAB.
CLEAR BDCTAB.

IF TYPE_LOG EQ 'E' OR TSYSTEM EQ SSYSTEM.
DEST = SPACE.
ENDIF.
CALL FUNCTION 'Z_RFC_CALL_TRANSACTION'
DESTINATION DEST
EXPORTING
TCODE = TCODE
MODE = MODE
TABLES
BDC_TAB = BDCTAB
EXCEPTIONS
OTHERS = 1.
IF SY-SUBRC NE 0.
MESSAGE I000 WITH 'Log not found'(001).
EXIT.
ENDIF.
IF TYPE_LOG EQ 'I'.
SET USER-COMMAND 'RW'.
ENDIF.

ENDFORM. " READ_LOG
*---------------------------------------------------------------------
* Form COPY_FILE
*---------------------------------------------------------------------
FORM COPY_FILE USING SOURSEFILE LIKE EPSF-EPSPATH
TARGETFILE LIKE EPSF-EPSPATH.
DATA BIN TYPE X.

OPEN DATASET SOURSEFILE FOR INPUT IN BINARY MODE.
OPEN DATASET TARGETFILE FOR OUTPUT IN BINARY MODE.

DO.
READ DATASET SOURSEFILE INTO BIN.
IF SY-SUBRC NE 0. EXIT. ENDIF.
TRANSFER BIN TO TARGETFILE.
ENDDO.
CLOSE DATASET SOURSEFILE.
CLOSE DATASET TARGETFILE.

ENDFORM. " COPY_FILE
*---------------------------------------------------------------------
* Form WRITE_PROTOCOL
*---------------------------------------------------------------------
FORM WRITE_PROTOCOL.
LOOP AT PROTOCOL.
WRITE / PROTOCOL-MESSAGE.
ENDLOOP.

ENDFORM. " WRITE_PROTOCOL

*FUNCTION Z_RFC_CALL_TRANSACTION. "with RFC-support
**"---------------------------------------------------------------------
**" IMPORTING
**" VALUE(TCODE) LIKE SY-TCODE
**" VALUE(MODE) LIKE SY-SUBCS DEFAULT 'A'
**" VALUE(UPDATE) LIKE SY-SUBCS DEFAULT 'A'
**" VALUE(SKIP_FIRST_SCREEN) LIKE SY-SUBCS DEFAULT SPACE
**" TABLES
**" BDC_TAB STRUCTURE BDCDATA
**"---------------------------------------------------------------------
* TRANSLATE TCODE TO UPPER CASE.
* IF SKIP_FIRST_SCREEN IS INITIAL.
* CALL TRANSACTION TCODE USING BDC_TAB MODE MODE UPDATE UPDATE.
* ELSE.
* CALL TRANSACTION TCODE USING BDC_TAB MODE MODE UPDATE UPDATE
* AND SKIP FIRST SCREEN.
* ENDIF.
*ENDFUNCTION.