Posted: Wed Mar 11, 2009 11:36 am Post subject: Export / Import programs with Texts, GUI status, Dynpro
Author: DKiyanov
Написал программу проблем с unicode нету позволяет выгружать/загружать исходный текст, тексты, GUI статусы, Dynpro
проверял на 4.0b и 4.7 с unicode - работает.
Code:
REPORT YDK_PROGS.
TABLES: EUDB, TRDIR, TADIR, D020T.
select-options: sprog for sy-repid obligatory NO INTERVALS.
selection-screen skip.
parameters: saveinc as checkbox.
select-options: incmask for sy-repid NO INTERVALS.
selection-screen skip.
parameters: dir(132) type c obligatory.
selection-screen skip.
parameters rbdl RADIOBUTTON GROUP rbl.
parameters rbul RADIOBUTTON GROUP rbl.
selection-screen skip.
parameters: cbprog as checkbox default 'X'.
parameters: cbcua as checkbox default 'X'.
parameters: cbdyn as checkbox default 'X'.
data: repid like sy-repid.
data: itprog like sy-repid occurs 0 with header line.
DATA: BEGIN OF PRG OCCURS 0, " Иначе WS_Download
LINE(100) TYPE C, " неправильно работает
END OF PRG.
data: txt like TEXTPOOL occurs 0 with header line.
data: atr like trdir occurs 0 with header line.
DATA: BEGIN OF INC OCCURS 0, " Иначе WS_Download
repid like sy-repid, " неправильно работает
END OF INC.
data: inct like line of inc occurs 0 with header line.
DATA: STA LIKE RSMPE_STAT OCCURS 0 WITH HEADER LINE.
DATA: FUN LIKE RSMPE_FUNT OCCURS 0 WITH HEADER LINE.
DATA: MEN LIKE RSMPE_MEN OCCURS 0 WITH HEADER LINE.
DATA: MTX LIKE RSMPE_MNLT OCCURS 0 WITH HEADER LINE.
DATA: ACT LIKE RSMPE_ACT OCCURS 0 WITH HEADER LINE.
DATA: BUT LIKE RSMPE_BUT OCCURS 0 WITH HEADER LINE.
DATA: PFK LIKE RSMPE_PFK OCCURS 0 WITH HEADER LINE.
DATA: SET LIKE RSMPE_STAF OCCURS 0 WITH HEADER LINE.
DATA: DOC LIKE RSMPE_ATRT OCCURS 0 WITH HEADER LINE.
DATA: TIT LIKE RSMPE_TITT OCCURS 0 WITH HEADER LINE.
DATA: ADM LIKE RSMPE_ADM OCCURS 0 WITH HEADER LINE.
DATA: BIV LIKE RSMPE_BUTS OCCURS 0 WITH HEADER LINE.
data: DYNNAME(44) TYPE C.
data: dyn like D020S occurs 0 with header line.
DATA: H like D020S.
DATA: F like D021S occurs 0 with header line.
DATA: E like D022S occurs 0 with header line.
DATA: M like D023S occurs 0 with header line.
DATA: BEGIN OF DYNH OCCURS 0.
INCLUDE STRUCTURE D020S.
DATA: DTXT LIKE D020T-DTXT,
END OF DYNH.
data: begin of dynf occurs 0,
prog like D020S-PROG,
dnum like D020S-DNUM.
include structure D021S.
data: end of dynf.
data: begin of dyne occurs 0,
prog like D020S-PROG,
dnum like D020S-DNUM.
include structure D022S.
data: end of dyne.
data: begin of dynm occurs 0,
prog like D020S-PROG,
dnum like D020S-DNUM.
include structure D023S.
data: end of dynm.
data: ittab(10) type c occurs 0 with header line.
field-symbols <tab> type table.
initialization.
field-symbols <fs>.
loop at screen.
check screen-input = 0.
if screen-name cp '*SPROG*'.
assign (screen-name) to <fs>.
<fs> = 'Programm, include, ...'.
endif.
if screen-name cp '*SAVEINC*'.
assign (screen-name) to <fs>.
<fs> = 'Include Unload/Download'.
endif.
if screen-name cp '*INCMASK*'.
assign (screen-name) to <fs>.
<fs> = 'Include mask'.
endif.
if screen-name cp '*DIR*'.
assign (screen-name) to <fs>.
<fs> = 'File directory'.
endif.
if screen-name cp '*RBDL*'.
assign (screen-name) to <fs>.
<fs> = 'From file to SAP'.
endif.
if screen-name cp '*RBUL*'.
assign (screen-name) to <fs>.
<fs> = 'From SAP to file'.
endif.
if screen-name cp '*CBPROG*'.
assign (screen-name) to <fs>.
<fs> = 'Program'.
endif.
if screen-name cp '*CBCUA*'.
assign (screen-name) to <fs>.
<fs> = 'GUI Status'.
endif.
if screen-name cp '*CBDYN*'.
assign (screen-name) to <fs>.
<fs> = 'Dynpro'.
endif.
endloop.
case 'X'.
when rbul. " Выгрузка
select name into table itprog
from trdir
where name in sprog.
check sy-subrc = 0.
loop at itprog.
perform save_prog using itprog.
if saveinc = 'X' and cbprog = 'X'.
inct[] = inc[].
loop at inct.
perform save_prog using inct-repid.
endloop.
endif.
endloop.
when rbdl. " Загрузка
loop at sprog where sign = 'I'
and option = 'EQ'.
perform load_prog using sprog-low.
if saveinc = 'X' and cbprog = 'X'.
inct[] = inc[].
loop at inct where repid in incmask.
perform load_prog using inct-repid.
endloop.
endif.
endloop.
endcase.
form save_prog using arepid.
repid = arepid.
perform refresh_tabs.
SELECT single * into atr
FROM TRDIR
WHERE NAME = repid.
check sy-subrc = 0
and atr-subc ca '1MFI'. " Типы программ.
* Таблицы программы
if cbprog = 'X'.
append atr.
READ REPORT repid INTO prg.
if atr-subc = 'I'. " Include
perform save_tabs.
exit.
endif.
READ TEXTPOOL repid INTO txt LANGUAGE SY-LANGU.
if saveinc = 'X'.
call function 'RS_GET_ALL_INCLUDES'
exporting
PROGRAM = repid
TABLES
INCLUDETAB = inc
EXCEPTIONS
NOT_EXISTENT = 1
NO_PROGRAM = 2
OTHERS = 3.
if not incmask[] is initial.
delete inc where not repid in incmask.
endif.
endif.
endif.
check atr-subc ca '1MF'. " Типы программ.
* Таблицы GUI статуса
if cbcua = 'X'.
CALL FUNCTION 'RS_CUA_INTERNAL_FETCH'
EXPORTING
PROGRAM = REPID
LANGUAGE = SY-LANGU
IMPORTING
ADM = ADM
TABLES
STA = STA
FUN = FUN
MEN = MEN
MTX = MTX
ACT = ACT
BUT = BUT
PFK = PFK
SET = SET
DOC = DOC
TIT = TIT
BIV = BIV
EXCEPTIONS
NOT_FOUND = 1
OTHERS = 2.
IF SY-SUBRC = 0.
APPEND ADM.
ENDIF.
endif.
* Таблицы экранов
if cbdyn = 'X'.
SELECT * into table dyn
FROM D020S
WHERE PROG = REPID.
delete dyn where TYPE ca 'SW'. " Sel screen
loop at dyn.
DYNNAME(40) = DYN-PROG.
DYNNAME+40(4) = DYN-DNUM.
REFRESH: F, E.
CLEAR: H, F, E.
IMPORT DYNPRO H F E M ID DYNNAME.
dynh = H.
SELECT SINGLE DTXT INTO DYNH-DTXT
FROM D020T
WHERE PROG = DYN-PROG
AND DYNR = DYN-DNUM
AND LANG = SY-LANGU.
append dynh.
loop at f.
dynf-prog = dyn-prog.
dynf-dnum = dyn-dnum.
move-corresponding f to dynf.
append dynf.
endloop.
loop at e.
dyne-prog = dyn-prog.
dyne-dnum = dyn-dnum.
move-corresponding e to dyne.
append dyne.
endloop.
loop at m.
dynm-prog = dyn-prog.
dynm-dnum = dyn-dnum.
move-corresponding m to dynm.
append dynm.
endloop.
endloop.
endif.
perform save_tabs.
endform.
form load_prog using arepid.
data: TRKEY like TRKEY.
repid = arepid.
perform load_tabs.
* Программа
if cbprog = 'X' and not prg[] is initial.
INSERT REPORT repid FROM prg.
PERFORM UPDATE_TRDIR.
if not txt[] is initial.
INSERT TEXTPOOL repid FROM txt LANGUAGE SY-LANGU.
endif.
endif.
* GUI статус
if cbcua = 'X' and not sta[] is initial.
read table adm index 1.
call function 'RS_CUA_INTERNAL_WRITE'
exporting
PROGRAM = repid
LANGUAGE = sy-langu
TR_KEY = TRKEY
ADM = adm
STATE = 'I'
TABLES
STA = sta
FUN = fun
MEN = men
MTX = mtx
ACT = act
BUT = but
PFK = pfk
SET = set
DOC = doc
TIT = tit
BIV = biv
EXCEPTIONS
NOT_FOUND = 1
OTHERS = 2.
endif.
* Экраны
if cbdyn = 'X' and not dyn[] is initial.
loop at dyn where type na 'SW'.
refresh: F, E, M.
DYNNAME(40) = DYN-PROG.
DYNNAME+40(4) = DYN-DNUM.
read table dynh with key prog = dyn-prog dnum = dyn-dnum.
h = dynh.
loop at dynf where prog = dyn-prog
and dnum = dyn-dnum.
move-corresponding dynf to f.
append f.
endloop.
loop at dyne where prog = dyn-prog
and dnum = dyn-dnum.
move-corresponding dyne to e.
append e.
endloop.
loop at dynm where prog = dyn-prog
and dnum = dyn-dnum.
move-corresponding dynm to m.
append m.
endloop.
FORM UPDATE_TRDIR.
read table atr index 1.
check sy-subrc = 0.
TRDIR = atr.
MODIFY TRDIR.
SELECT SINGLE *
FROM TADIR
WHERE PGMID = 'R3TR'
AND OBJECT = 'PROG'
AND OBJ_NAME = TRDIR-NAME.
IF SY-SUBRC NE 0. " Иначе не будет записи каталога объектов
TADIR-PGMID = 'R3TR'.
TADIR-OBJECT = 'PROG'.
TADIR-OBJ_NAME = TRDIR-NAME.
TADIR-DEVCLASS = '$TMP'.
TADIR-CPROJECT = 'L'.
TADIR-MASTERLANG = SY-LANGU.
TADIR-SRCSYSTEM = SY-SYSID.
INSERT TADIR.
ENDIF.
ENDFORM.
form add_tab using tab.
concatenate tab '[]' into ittab.
append ittab.
endform.
form refresh_tabs.
loop at ittab.
assign (ittab) to <tab>.
check sy-subrc = 0.
refresh <tab>.
endloop.
endform.
form save_tabs.
data: FILENAME LIKE RLGRAP-FILENAME.
loop at ittab.
assign (ittab) to <tab>.
check sy-subrc = 0.
check not <tab> is initial.
translate ittab using '[ ] '. " Убираем []
concatenate dir '\' repid '.' ittab into filename.
* При выгрузке для полей с типом X перед значением ставится
* символ "X" врезультате ошибка при загрузке
* проявилось на таблице DYNF
form load_tabx tables tab using filename.
data: begin of itf occurs 0,
line(2300) type c,
end of itf.
data: itw(256) type c occurs 0 with header line.
data: xtab(2) type x value '0900'.
data: ctab type c.
data: typ type c.
loop at itf.
split itf at ctab into table itw.
clear tab.
loop at itw.
assign component sy-tabix of structure tab to <fs>.
if sy-subrc <> 0. exit. endif.
describe field <fs> type typ.
if typ = 'X'.
<fs> = itw+1.
else.
<fs> = itw.
endif.
endloop.
append tab.
endloop.
endform.
You cannot post new topics in this forum You cannot reply to topics in this forum You cannot edit your posts in this forum You cannot delete your posts in this forum You cannot vote in polls in this forum You cannot attach files in this forum You can download files in this forum
All product names are trademarks of their respective companies. SAPNET.RU websites are in no way affiliated with SAP AG. SAP, SAP R/3, R/3 software, mySAP, ABAP, BAPI, xApps, SAP NetWeaver and any other are registered trademarks of SAP AG. Every effort is made to ensure content integrity. Use information on this site at your own risk.
