SAP R/3 форум ABAP консультантов
Russian ABAP Developer's Club

Home - FAQ - Search - Memberlist - Usergroups - Profile - Log in to check your private messages - Register - Log in - English
Blogs - Weblogs News

Export / Import programs with Texts, GUI status, Dynpro



 
Post new topic   Reply to topic    Russian ABAP Developer's Club Forum Index -> ABAP Dictionary -> Migration
View previous topic :: View next topic  
Author Message
admin
Администратор
Администратор



Joined: 01 Sep 2007
Posts: 1636

PostPosted: Wed Mar 11, 2009 11:36 am    Post subject: Export / Import programs with Texts, GUI status, Dynpro Reply with quote

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.

start-of-selection.

perform add_tab using:
  'PRG', 'TXT',  'ATR',  'INC',
  'STA', 'FUN',  'MEN',  'MTX',  'ACT', 'BUT', 'PFK', 'SET',
  'DOC', 'TIT',  'ADM',
  'DYN', 'DYNH', 'DYNF', 'DYNE', 'DYNM'.

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.

    TRKEY-DEVCLASS = '$TMP'.
    TRKEY-OBJ_TYPE = 'PROG'.
    TRKEY-OBJ_NAME = repid.
    TRKEY-SUB_TYPE = 'CUAD'.
    TRKEY-SUB_NAME = repid.

    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.

      EXPORT DYNPRO H F E M ID DYNNAME.

      D020T-PROG = dyn-prog.
      D020T-DYNR = dyn-dnum.
      D020T-LANG = sy-langu.
      D020T-DTXT = dynh-dtxt.
      MODIFY D020T. " Подругому ввести текст экрана не получается
    endloop.
  endif.
endform.

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.

    call function 'WS_DOWNLOAD'
      EXPORTING
        FILENAME                      = filename
        FILETYPE                      = 'DAT'
      tables
        DATA_TAB                      = <tab>
      EXCEPTIONS
        FILE_OPEN_ERROR               = 1
        FILE_WRITE_ERROR              = 2
        INVALID_FILESIZE              = 3
        INVALID_TYPE                  = 4
        NO_BATCH                      = 5
        UNKNOWN_ERROR                 = 6
        INVALID_TABLE_WIDTH           = 7
        GUI_REFUSE_FILETRANSFER       = 8
        CUSTOMER_ERROR                = 9
        NO_AUTHORITY                  = 10
        OTHERS                        = 11.
  endloop.
endform.

form load_tabs.
data: FILENAME LIKE  RLGRAP-FILENAME.
  loop at ittab.
    assign (ittab) to <tab>.
    check sy-subrc = 0.
    refresh <tab>.

    translate ittab using '[ ] '. " Убираем []
    concatenate dir '\' repid '.' ittab into filename.

    case ittab.
    when 'DYNF'.
      perform load_tabx tables <tab> using filename.
    when others.
      call function 'WS_UPLOAD'
        EXPORTING
          FILENAME                      = filename
          FILETYPE                      = 'DAT'
        tables
          DATA_TAB                      = <tab>
        EXCEPTIONS
          CONVERSION_ERROR              = 1
          FILE_OPEN_ERROR               = 2
          FILE_READ_ERROR               = 3
          INVALID_TYPE                  = 4
          NO_BATCH                      = 5
          UNKNOWN_ERROR                 = 6
          INVALID_TABLE_WIDTH           = 7
          GUI_REFUSE_FILETRANSFER       = 8
          CUSTOMER_ERROR                = 9
          NO_AUTHORITY                  = 10
          OTHERS                        = 11.
    endcase.
  endloop.
endform.

* При выгрузке для полей с типом 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.

field-symbols <fs>.

  assign ctab to <fs> type 'X'.
  <fs> = xtab.

  call function 'WS_UPLOAD'
    EXPORTING
      FILENAME                      = filename
      FILETYPE                      = 'ASC'
    tables
      DATA_TAB                      = itf
    EXCEPTIONS
      CONVERSION_ERROR              = 1
      FILE_OPEN_ERROR               = 2
      FILE_READ_ERROR               = 3
      INVALID_TYPE                  = 4
      NO_BATCH                      = 5
      UNKNOWN_ERROR                 = 6
      INVALID_TABLE_WIDTH           = 7
      GUI_REFUSE_FILETRANSFER       = 8
      CUSTOMER_ERROR                = 9
      NO_AUTHORITY                  = 10
      OTHERS                        = 11.

  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.
Back to top
View user's profile Send private message
Display posts from previous:   
Post new topic   Reply to topic    Russian ABAP Developer's Club Forum Index -> ABAP Dictionary -> Migration All times are GMT + 4 Hours
Page 1 of 1

 
Jump to:  
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.