Re: save/download program to client-pc

Former Member — Wed, 07 Dec 2005 17:10:52 GMT

REPORT ZBACKUP06.

$$********************************************************************

$$* parametros

$$********************************************************************

SELECTION-SCREEN BEGIN OF BLOCK SEL WITH FRAME TITLE TITLE1.

SELECTION-SCREEN BEGIN OF LINE.

SELECTION-SCREEN COMMENT 1(31) C_NOME FOR FIELD NOME.

PARAMETERS: NOME LIKE RS38M-PROGRAMM DEFAULT '*'.

SELECTION-SCREEN END OF LINE.

SELECTION-SCREEN BEGIN OF LINE.

SELECTION-SCREEN COMMENT 1(31) C_PATH FOR FIELD PATH.

PARAMETERS: PATH(250) TYPE C DEFAULT 'C:'.

SELECTION-SCREEN END OF LINE.

SELECTION-SCREEN BEGIN OF LINE.

SELECTION-SCREEN COMMENT 1(31) C_EXPORT FOR FIELD EXPORT.

PARAMETERS: EXPORT RADIOBUTTON GROUP RAD2 DEFAULT 'X'.

SELECTION-SCREEN END OF LINE.

SELECTION-SCREEN BEGIN OF LINE.

SELECTION-SCREEN COMMENT 1(31) C_IMPORT FOR FIELD IMPORT.

PARAMETERS: IMPORT RADIOBUTTON GROUP RAD2.

SELECTION-SCREEN END OF LINE.

SELECTION-SCREEN END OF BLOCK SEL.

SELECTION-SCREEN BEGIN OF BLOCK CHK WITH FRAME TITLE TITLE2.

SELECTION-SCREEN BEGIN OF LINE.

SELECTION-SCREEN COMMENT 1(31) C_RELA FOR FIELD RELATOR.

PARAMETERS: RELATOR RADIOBUTTON GROUP RADI.

SELECTION-SCREEN END OF LINE.

SELECTION-SCREEN BEGIN OF LINE.

SELECTION-SCREEN COMMENT 1(31) C_ONLINE FOR FIELD ON_LINE.

PARAMETERS: ON_LINE RADIOBUTTON GROUP RADI.

SELECTION-SCREEN END OF LINE.

SELECTION-SCREEN BEGIN OF LINE.

SELECTION-SCREEN COMMENT 1(31) C_SAPSCP FOR FIELD SAP_SCRP.

PARAMETERS: SAP_SCRP RADIOBUTTON GROUP RADI.

SELECTION-SCREEN END OF LINE.

SELECTION-SCREEN BEGIN OF LINE.

SELECTION-SCREEN COMMENT 1(31) C_TABELA FOR FIELD TABELA.

PARAMETERS: TABELA RADIOBUTTON GROUP RADI.

SELECTION-SCREEN END OF LINE.

SELECTION-SCREEN END OF BLOCK CHK.

************************************************************************

SELECTION-SCREEN: BEGIN OF SCREEN 9001 TITLE TITLE_1 AS WINDOW.

SELECTION-SCREEN BEGIN OF BLOCK BLOQUE WITH FRAME TITLE TITLE3.

SELECTION-SCREEN BEGIN OF LINE.

SELECTION-SCREEN COMMENT 1(31) C_OBJ FOR FIELD OBJECT.

PARAMETERS: OBJECT LIKE TADIR-OBJECT DEFAULT 'FORM'.

SELECTION-SCREEN END OF LINE.

SELECTION-SCREEN BEGIN OF LINE.

SELECTION-SCREEN COMMENT 1(31) C_OBJ_N FOR FIELD OBJ_NAME.

PARAMETERS: OBJ_NAME(40) DEFAULT 'Z*'.

SELECTION-SCREEN END OF LINE.

SELECTION-SCREEN BEGIN OF LINE.

SELECTION-SCREEN COMMENT 1(31) C_DATA FOR FIELD DATASET.

PARAMETERS: DATASET(250) TYPE C DEFAULT 'C:'.

SELECTION-SCREEN END OF LINE.

PARAMETERS: MODE(6) NO-DISPLAY.

SELECTION-SCREEN BEGIN OF LINE.

SELECTION-SCREEN COMMENT 1(31) C_LSTF FOR FIELD LISTFILE.

PARAMETERS: LISTFILE AS CHECKBOX DEFAULT SPACE.

SELECTION-SCREEN END OF LINE.

PARAMETERS: PLANGVEC(60) DEFAULT SPACE NO-DISPLAY.

SELECTION-SCREEN END OF BLOCK BLOQUE.

SELECTION-SCREEN: END OF SCREEN 9001.

$$********************************************************************

$$ Tabelas

$$********************************************************************

TABLES: D020T,

TITLE.

$$********************************************************************

$$ Variaveis

$$********************************************************************

DATA : LIM_LINHA TYPE I,

LIM_PORCENT TYPE I,

ADM LIKE RSMPE_ADM,

TRKEY LIKE TRKEY,

LAST LIKE RSEU1_LST,

I TYPE I,

SLASH(1) TYPE C,

ITAB2(300) TYPE C ,

POSICAO(2) TYPE N,

BEGIN OF DR_READNAME,

PROG LIKE D020S-PROG,

DNUM LIKE D020S-DNUM,

END OF DR_READNAME,

FNAM(30) TYPE C,

DIDX(10) TYPE C,

FLG1(10) TYPE C,

FLG2(10) TYPE C,

FLG3(10) TYPE C,

FILL(10) TYPE C,

FMB1(10) TYPE C,

FMB2(10) TYPE C,

COLR(10) TYPE C,

LENG(10) TYPE C,

LINE(10) TYPE C,

COLN(10) TYPE C,

LTYP(10) TYPE C,

LANF(10) TYPE C,

LBLK(10) TYPE C,

LREP(10) TYPE C,

FMKY(10) TYPE C,

PAID(10) TYPE C,

UCNV(10) TYPE C,

TYPE(10) TYPE C,

AUTH(10) TYPE C,

WNAM(30) TYPE C,

DMAC(31) TYPE C,

GRP1(10) TYPE C,

GRP2(10) TYPE C,

GRP3(10) TYPE C,

GRP4(10) TYPE C,

ITYP(10) TYPE C,

AGLT(10) TYPE C,

ADEZ(10) TYPE C,

STXT(132) TYPE C,

BEGIN OF HC,

PROG(08),

DNUM(4),

TYPE(1),

FNUM(4),

DGRP(4),

BZMX(3),

BZBR(3),

MILI(3),

MICO(3),

MALI(3),

MACO(3),

NOLI(3),

NOCO(3),

VALP(3),

CUAN(1),

HDAT(1),

SPRA(1),

CUPO(30),

DGEN(6),

TGEN(6),

END OF HC,

N_MARCA TYPE I,

FLAG_MARC(4) TYPE C,

NOME2 LIKE RS38M-PROGRAMM,

NOME_TELA(60) TYPE C.

$$********************************************************************

$$ Tabelas internas

$$********************************************************************

DATA: BEGIN OF ITRDIR OCCURS 0,

NAME LIKE TRDIRT-NAME,

TEXT LIKE TRDIRT-TEXT,

END OF ITRDIR.

DATA : STA LIKE RSMPE_STAT OCCURS 0 WITH HEADER LINE,

FUN LIKE RSMPE_FUNT OCCURS 0 WITH HEADER LINE,

MEN LIKE RSMPE_MEN OCCURS 0 WITH HEADER LINE,

MTX LIKE RSMPE_MNLT OCCURS 0 WITH HEADER LINE,

ACT LIKE RSMPE_ACT OCCURS 0 WITH HEADER LINE,

BUT LIKE RSMPE_BUT OCCURS 0 WITH HEADER LINE,

PFK LIKE RSMPE_PFK OCCURS 0 WITH HEADER LINE,

SET LIKE RSMPE_STAF OCCURS 0 WITH HEADER LINE,

DOC LIKE RSMPE_ATRT OCCURS 0 WITH HEADER LINE,

TIT LIKE RSMPE_TITT OCCURS 0 WITH HEADER LINE,

PROGRAMAS LIKE RS38M-PROGRAMM OCCURS 0 WITH HEADER LINE,

PROGRAMAS2 LIKE RS38M-PROGRAMM OCCURS 0 WITH HEADER LINE,

TEXTOS LIKE TEXTPOOL OCCURS 0 WITH HEADER LINE,

REPORT(72) TYPE C OCCURS 0 WITH HEADER LINE,

ITAB(300) TYPE C OCCURS 0 WITH HEADER LINE,

E LIKE D022S OCCURS 0 WITH HEADER LINE,

H LIKE D020S OCCURS 0 WITH HEADER LINE,

F LIKE D021S OCCURS 0 WITH HEADER LINE,

M LIKE D023S OCCURS 0 WITH HEADER LINE,

DNUM LIKE D020S-DNUM OCCURS 0 WITH HEADER LINE,

H_BDC LIKE BDCDATA OCCURS 0 WITH HEADER LINE, " Dados da transação

MESSTAB LIKE BDCMSGCOLL OCCURS 0 WITH HEADER LINE.

$$********************************************************************

$$* Variaveis de Sapscript.

$$********************************************************************

DATA: ACTIVATE_OBJECT, "tried to activate object

ACTIVATE_OBJECT_OK. "activate o.k.

DATA:

BINFILE(1),

INDICE TYPE I,

i type i,
slash(1) type c,

BINFILE_CODEPAGE LIKE TCP02-CPCODEPAGE VALUE '0000',

TRUE(01) TYPE C VALUE 'X',

FALSE(01) TYPE C VALUE ' ',

NAME(89) TYPE C, "B20K016101

NAME_LEN LIKE SY-INDEX VALUE 88, "B20K016101

RC LIKE SY-SUBRC,

EXPORT_FLAG,

IMPORT_OK,

NOTHING,

END_OF_DATA,

FUNC_ACTIVATE(4) VALUE 'ACTV',

FUNC_OLANGUAGE(4) VALUE 'OLAN',

FUNC_NOTHING(4) VALUE 'NONE',

FUNC_DEL_PAPER(4) VALUE 'DPAP',

FUNC_DEL_FORM(4) VALUE 'DFOR', "B20K022630

FUNC_DEL_STYL(4) VALUE 'DSTY', "B20K022630

LANGUAGE_VECTOR(60) TYPE C,

CUSTOM_LANGUAGE_VECTOR(60) TYPE C,

CUSTOM_LANGUAGE_VECTOR_VALID(8) TYPE C VALUE SPACE,

CUSTOM_LANGUAGE_VECTOR_MAGIC(8) TYPE C VALUE 'LangVect',

NLP_LV1(1) TYPE C VALUE '1',

NLP_LV2(1) TYPE C VALUE '2',

NLP_LV3(1) TYPE C VALUE '3',

NLP_ERR(1) TYPE C VALUE 'E', "error

NLP_WAR(1) TYPE C VALUE 'W', "warning

NLP_INF(1) TYPE C VALUE ' ', "info

NLP_LAN(1) TYPE C VALUE 'E', "default message language

NLP_MID(2) TYPE C VALUE 'TD', "message id

NLP_NOB(1) TYPE C VALUE ' ', "no new object?

SYSTEM_CODEPAGE LIKE TCP02-CPCODEPAGE,

OBJECT_STYLE LIKE THEAD-TDOBJECT VALUE 'STYLE ',

OBJECT_FORM LIKE THEAD-TDOBJECT VALUE 'FORM ',

OBJECT_DOKU LIKE THEAD-TDOBJECT VALUE 'DOKU ',

OBJECT_DSYS LIKE THEAD-TDOBJECT VALUE 'DSYS ',

OBJECT_TEXT LIKE THEAD-TDOBJECT VALUE 'TEXT ',

BINARY_FILE_FORMAT_VALID(7) TYPE C VALUE SPACE,

BINARY_FILE_FORMAT_MAGIC(7) TYPE C VALUE 'BinFile',

END_OF_OBJDATA(01) TYPE C,

END_OF_CLIPBOARD(01) TYPE C,

FILENAME(60),

COUNT_ERROR(3) TYPE N,

COUNT_WARNING(3) TYPE N,

SUBRC LIKE SY-SUBRC,

CLIPBOARD(01) TYPE C,

LIST_FILE_CONTENTS(1) TYPE C,

TEXTNAME(70) VALUE 'TEXT,*,ST,&',

SUFFIX(4),

FILE(60),

DATASET_AUX(50),

TAB_NOME(30) TYPE C OCCURS 0 WITH HEADER LINE,

CORRECTION_CHECK(1).

TABLES : *TADIR, TCP00, STXH, TSP0A, TSP09, TFO03, TFO06, T022D,

TSP06, TSP1D, TFO04, ITCRS, T100.

DATA : BEGIN OF TAB_PC OCCURS 100,

LINHA(1024) TYPE C,

END OF TAB_PC.

DATA BEGIN OF PAPER.

DATA PDPAPER LIKE TSP06-PDPAPER.

DATA PDPTYPE LIKE TSP06-PDPTYPE.

DATA END OF PAPER.

DATA:BEGIN OF TSP06_LINE,

PDLFDNR(3) TYPE N,

PDDATALEN(3) TYPE N,

ALL(240),

END OF TSP06_LINE.

DATA:BEGIN OF TFO03_LINE,

CPI(10),

ALL(240),

END OF TFO03_LINE.

DATA :

BEGIN OF RECORD OCCURS 0,

TYP(1),

COMMAND(4),

DATA(507), "B20K043010

END OF RECORD.

DATA BEGIN OF HEADER_TAB OCCURS 20.

INCLUDE STRUCTURE THEAD.

DATA END OF HEADER_TAB.

DATA:

BEGIN OF TEXTLOW,

TDOBJECT LIKE THEAD-TDOBJECT,

TDNAME LIKE THEAD-TDNAME,

TDID LIKE THEAD-TDID,

TDSPRAS LIKE THEAD-TDSPRAS,

END OF TEXTLOW.

DATA BEGIN OF HEADER_DEF.

INCLUDE STRUCTURE THEAD.

DATA END OF HEADER_DEF.

DATA BEGIN OF HEADER.

INCLUDE STRUCTURE THEAD.

DATA END OF HEADER.

DATA BEGIN OF LINES OCCURS 50.

INCLUDE STRUCTURE TLINE.

DATA END OF LINES.

DATA:

TRANSLATION_WANTED LIKE ITCDA-TDTRANSTAT VALUE 0,

TRANSLATION_NOT_WANTED LIKE ITCDA-TDTRANSTAT VALUE 1.

DATA: FC_FULL_TAB_LINES LIKE SY-TABIX.

DATA: BEGIN OF FC_FULL_TAB OCCURS 0,

RECORD(512),

END OF FC_FULL_TAB.

DATA: BEGIN OF FC_COMP_TAB OCCURS 0,

RECORD(1024),

END OF FC_COMP_TAB.

DATA: FC_COMP_TAB_LINES LIKE SY-TABIX.

DATA:

ID_STANDARD LIKE THEAD-TDID VALUE 'ST ',

ID_DEF LIKE THEAD-TDID VALUE 'DEF',

ID_TXT LIKE THEAD-TDID VALUE 'TXT'.

DATA:

STATUS_ACTIVE LIKE ITCDA-TDSTATUS VALUE ' ',

STATUS_SAP LIKE ITCDA-TDSTATUS VALUE 'SAP',

STATUS_CUSTOMER LIKE ITCDA-TDSTATUS VALUE 'CUS'.

DATA BEGIN OF BUF_T022D OCCURS 50.

INCLUDE STRUCTURE T022D.

DATA END OF BUF_T022D.

DATA BEGIN OF BUF_TSP06 OCCURS 200.

INCLUDE STRUCTURE TSP06.

DATA END OF BUF_TSP06.

DATA BEGIN OF BUF_TFO03 OCCURS 20.

INCLUDE STRUCTURE TFO03.

DATA END OF BUF_TFO03.

DATA BEGIN OF BUF_TFO04 OCCURS 1000.

INCLUDE STRUCTURE TFO04.

DATA END OF BUF_TFO04.

DATA BEGIN OF BUF_TFO06 OCCURS 10.

INCLUDE STRUCTURE TFO06.

DATA END OF BUF_TFO06.

FIELD-SYMBOLS:

DATA NAME_POS LIKE SY-INDEX.

CONSTANTS:

BINARY_FILE_HEADER_BYTE1(2) VALUE '52', "R

BINARY_FILE_HEADER_BYTE2(2) VALUE '53', "S

BINARY_FILE_HEADER_BYTE3(2) VALUE '54', "T

BINARY_FILE_HEADER_BYTE4(2) VALUE '58', "X

BINARY_FILE_HEADER_BYTE5(2) VALUE '40'. "@

CONSTANTS: FC_FULL_TAB_MAXLINES LIKE SY-TABIX VALUE 5000.

$$********************************************************************

$$*Constantes

$$********************************************************************

CONSTANTS: SEPARADOR(50) TYPE C VALUE

'*** Agora vem o Programa ***'.

$$********************************************************************

$$*Inicialização

$$********************************************************************

INITIALIZATION.

TITLE2 = 'Tipo de PRG'.

TITLE3 = TITLE1 = 'Parametros de Import e Export'.

C_OBJ_N = C_NOME = 'Nome do PRG :'.

C_DATA = C_PATH = 'Caminho :'.

C_IMPORT = 'Importar'.

C_EXPORT = 'Exportar'.

C_ONLINE = 'On Line'.

TITLE_1 = C_SAPSCP = 'Sapscript'.

C_TABELA = 'Tabelas'.

C_RELA = 'Relatórios'.

C_OBJ = 'Categoria'.

C_LSTF = 'Listar'.

$$********************************************************************

$$*Macros

$$********************************************************************

DEFINE MENSSAGEM.

IF &4 = ' '.

DESCRIBE TABLE &1 LINES LIM_LINHA.

LIM_PORCENT = ( 100 * &2 ) / LIM_LINHA.

ELSE.

LIM_PORCENT = &2.

ENDIF.

CALL FUNCTION 'SAPGUI_PROGRESS_INDICATOR'

EXPORTING

PERCENTAGE = LIM_PORCENT

TEXT = &3

EXCEPTIONS

OTHERS = 0.

END-OF-DEFINITION.

$$********************************************************************

$$ inicio do codigo

$$********************************************************************

START-OF-SELECTION.

MESSTAB[] = MESSTAB[].

MESSTAB = MESSTAB.

IF RELATOR = 'X'.

CASE IMPORT.

WHEN ' '. " EXPORTAR

PERFORM EXPORT_RELATORIO.

WHEN: 'X'. " IMPORTAR

PERFORM IMPORT_RELATORIO.

ENDCASE.

ELSEIF ON_LINE = 'X'.

CASE IMPORT.

WHEN ' '. " EXPORTAR

PERFORM EXPORT_ON_LINE.

WHEN: 'X'. " IMPORTAR

PERFORM IMPORT_ON_LINE.

ENDCASE.

ELSEIF SAP_SCRP = 'X'.

CASE IMPORT.

WHEN ' '. " EXPORTAR

TITLE_1 = 'Sapscript - Exportar'.

WHEN: 'X'. " IMPORTAR

TITLE_1 = 'Sapscript - Importar'.

ENDCASE.

DATASET = PATH.

CALL SELECTION-SCREEN 9001 STARTING AT 5 6.

CHECK SY-SUBRC EQ 0.

CHECK NOT OBJ_NAME IS INITIAL.

PERFORM Z_SAPSCRIPT.

ELSEIF TABELA = 'X'.

CASE IMPORT.

WHEN ' '. " EXPORTAR

Incluir

WHEN: 'X'. " IMPORTAR

Incluir

ENDCASE.

ENDIF.

END-OF-SELECTION.

*----

FORM DOWNLOAD *

*----

FORM DOWNLOAD.

DATA: NOMBRE LIKE RLGRAP-FILENAME.

CONCATENATE PATH PROGRAMAS '.TXT' INTO NOMBRE.

MENSSAGEM STA[] 50 'Exportando Programa' 'X'.

CALL FUNCTION 'WS_DOWNLOAD'

EXPORTING

FILENAME = NOMBRE

FILETYPE = 'ASC'

TABLES

DATA_TAB = ITAB

EXCEPTIONS

FILE_OPEN_ERROR = 1

FILE_WRITE_ERROR = 2

OTHERS = 3.

CASE SY-SUBRC.

WHEN 0.

WRITE: / 'Abaixou : ', NOMBRE .

WHEN 1.

WRITE: / 'FILE_OPEN_ERROR: ', NOMBRE.

WHEN 2.

WRITE: / 'FILE_WRITE_ERROR: ', NOMBRE.

ENDCASE.

ENDFORM.

*&----

*& Form UPLOAD

*&----

FORM UPLOAD.

DATA: C_AUX LIKE RLGRAP-FILENAME.

CONCATENATE PATH NOME '.TXT' INTO C_AUX.

CALL FUNCTION 'WS_UPLOAD'

EXPORTING

FILENAME = C_AUX

FILETYPE = 'ASC'

TABLES

DATA_TAB = ITAB

EXCEPTIONS

CONVERSION_ERROR = 1

FILE_OPEN_ERROR = 2

FILE_READ_ERROR = 3

INVALID_TABLE_WIDTH = 4

INVALID_TYPE = 5

NO_BATCH = 6

UNKNOWN_ERROR = 7

OTHERS = 8.

IF SY-SUBRC = 0. ENDIF.

ENDFORM. " UPLOAD

*&----

*& Form INSERT_LINE

*&----

FORM INSERT_LINE USING LC_START TYPE C LC_NAME TYPE C LC_VALUE TYPE ANY.

CLEAR H_BDC.

MOVE LC_START TO H_BDC-DYNBEGIN.

IF LC_START = 'X'.

MOVE:

LC_NAME TO H_BDC-PROGRAM,

LC_VALUE TO H_BDC-DYNPRO.

ELSE.

MOVE:

LC_NAME TO H_BDC-FNAM,

LC_VALUE TO H_BDC-FVAL.

ENDIF.

APPEND H_BDC.

ENDFORM. " INSERT_LINE

*&----

*& Form EXPORT_ON_LINE

*&----

FORM EXPORT_ON_LINE.

TRANSLATE NOME USING '*%?_'.

I = STRLEN( PATH ) - 1.

MOVE PATH+I(1) TO SLASH.

IF SLASH <> ''.

CONCATENATE PATH '' INTO PATH.

ENDIF.

REFRESH: PROGRAMAS, PROGRAMAS2.

SELECT NAME FROM TRDIR INTO TABLE PROGRAMAS

WHERE NAME LIKE NOME.

IF SY-SUBRC <> 0.

MESSAGE S208(00) WITH 'Programa Não Encontrado na Biblioteca'.

STOP.

ENDIF.

REFRESH: REPORT, TEXTOS, ITAB.

LOOP AT PROGRAMAS.

ITAB = PROGRAMAS .

APPEND ITAB.

READ REPORT PROGRAMAS INTO REPORT.

CONCATENATE '###PROG##' PROGRAMAS INTO ITAB.

MESSAGE S208(00) WITH 'Exportando Programa Principal'.

APPEND ITAB.

LOOP AT REPORT INTO ITAB.

ITAB2 = ITAB.

APPEND ITAB.

CONDENSE ITAB2 NO-GAPS.

SEARCH ITAB2 FOR 'include'.

IF SY-SUBRC = 0.

POSICAO = 7 + SY-FDPOS.

PROGRAMAS2 = ITAB2+POSICAO(30).

TRANSLATE PROGRAMAS2 USING '. '.

APPEND PROGRAMAS2.

ENDIF.

ENDLOOP.

ITAB = '###FIM##'.

APPEND ITAB.

CONCATENATE '###TEXT##' PROGRAMAS INTO ITAB.

APPEND ITAB.

MESSAGE S208(00) WITH 'Exportando Textos'.

READ TEXTPOOL PROGRAMAS INTO TEXTOS LANGUAGE 'P'.

LOOP AT TEXTOS.

ITAB = TEXTOS.

APPEND ITAB.

ENDLOOP.

ITAB = '###FIM##'.

APPEND ITAB.

DATA LC_MENS(50) TYPE C.

LOOP AT PROGRAMAS2.

CLEAR LC_MENS.

CONCATENATE 'Exportando Include :' PROGRAMAS2 INTO LC_MENS

SEPARATED BY SPACE.

MENSSAGEM PROGRAMAS2[] SY-TABIX LC_MENS ' '.

READ TEXTPOOL PROGRAMAS2 INTO TEXTOS LANGUAGE 'P'.

READ REPORT PROGRAMAS2 INTO REPORT.

CONCATENATE '###INCL##' PROGRAMAS2 INTO ITAB.

APPEND ITAB.

LOOP AT REPORT INTO ITAB.

APPEND ITAB.

ENDLOOP.

ITAB = '###FIM##'.

APPEND ITAB.

ENDLOOP.

SELECT DNUM FROM D020S INTO TABLE DNUM

WHERE PROG = NOME.

LOOP AT DNUM.

DR_READNAME-DNUM = DNUM.

DR_READNAME-PROG = NOME.

CLEAR LC_MENS.

CONCATENATE 'Exportando Tela :' DNUM INTO LC_MENS

SEPARATED BY SPACE.

MENSSAGEM DNUM[] SY-TABIX LC_MENS ' '.

IMPORT DYNPRO H F E M ID DR_READNAME.

CONCATENATE '###Tela###' DR_READNAME INTO ITAB.

APPEND ITAB.

SELECT SINGLE * FROM D020T WHERE PROG = NOME

AND DYNR = DNUM

AND LANG = SY-LANGU.

CONCATENATE '###NP###' D020T-DTXT INTO ITAB.

APPEND ITAB.

CONCATENATE '###H###' DR_READNAME INTO ITAB.

APPEND ITAB.

HC-PROG = H-PROG.

HC-DNUM = H-DNUM.

HC-TYPE = H-TYPE.

HC-FNUM = H-FNUM.

HC-DGRP = H-DGRP.

HC-BZMX = H-BZMX.

HC-BZBR = H-BZBR.

HC-MILI = H-MILI.

HC-MICO = H-MICO.

HC-MALI = H-MALI.

HC-MACO = H-MACO.

HC-NOLI = H-NOLI.

HC-NOCO = H-NOCO.

HC-VALP = H-VALP.

HC-CUAN = H-CUAN.

HC-HDAT = H-HDAT.

HC-SPRA = H-SPRA.

HC-CUPO = H-CUPO.

HC-DGEN = H-DGEN.

HC-TGEN = H-TGEN.

ITAB = HC.

APPEND ITAB.

CONCATENATE '###F###' DR_READNAME INTO ITAB.

APPEND ITAB.

LOOP AT F. " into itab.

FNAM = F-FNAM.

DIDX = F-DIDX.

FLG1 = F-FLG1.

FLG2 = F-FLG2.

FLG3 = F-FLG3.

FILL = F-FILL.

FMB1 = F-FMB1.

FMB2 = F-FMB2.

COLR = F-COLR.

LENG = F-LENG.

LINE = F-LINE.

COLN = F-COLN.

LTYP = F-LTYP.

LANF = F-LANF.

LBLK = F-LBLK.

LREP = F-LREP.

FMKY = F-FMKY.

PAID = F-PAID.

UCNV = F-UCNV.

TYPE = F-TYPE.

AUTH = F-AUTH.

WNAM = F-WNAM.

DMAC = F-DMAC.

GRP1 = F-GRP1.

GRP2 = F-GRP2.

GRP3 = F-GRP3.

GRP4 = F-GRP4.

ITYP = F-ITYP.

AGLT = F-AGLT.

ADEZ = F-ADEZ.

STXT = F-STXT.

CONCATENATE

FNAM '|' DIDX '|' FLG1 '|' FLG2 '|' FLG3 '|' FILL '|'

FMB1 '|' FMB2 '|' COLR '|' LENG '|' LINE '|' COLN '|'

GRP2 '|' GRP3 '|' GRP4 '|' ITYP '|' AGLT '|' ADEZ '|' STXT

INTO ITAB.

APPEND ITAB.

ENDLOOP.

CONCATENATE '###E###' DR_READNAME INTO ITAB.

APPEND ITAB.

LOOP AT E INTO ITAB.

APPEND ITAB.

ENDLOOP.

CONCATENATE '###M###' DR_READNAME INTO ITAB.

APPEND ITAB.

LOOP AT M INTO ITAB.

APPEND ITAB.

ENDLOOP.

ITAB = '###FIM##'.

APPEND ITAB.

ENDLOOP.

CONCATENATE '###TITLE##' PROGRAMAS INTO ITAB.

APPEND ITAB.

SELECT * FROM TITLE

WHERE DDLANGUAGE = SY-LANGU

AND PROGNAME = PROGRAMAS.

CONCATENATE TITLE-DDNR '|' TITLE-TEXT_LINE INTO ITAB.

APPEND ITAB.

ENDSELECT.

ITAB = '###FIM##'.

APPEND ITAB.

CALL FUNCTION 'RS_CUA_INTERNAL_FETCH'

EXPORTING

PROGRAM = PROGRAMAS

IMPORTING

ADM = ADM

TABLES

STA = STA

FUN = FUN

MEN = MEN

MTX = MTX

ACT = ACT

BUT = BUT

PFK = PFK

SET = SET

DOC = DOC

TIT = TIT

EXCEPTIONS

NOT_FOUND = 1

OTHERS = 2.

IF SY-SUBRC = 0. ENDIF.

ITAB = '*INIC_LAST*'.

APPEND ITAB.

ITAB = LAST.

APPEND ITAB.

ITAB = '*FIM_LAST*'.

APPEND ITAB.

MENSSAGEM STA[] 10 'Exportando Gui-Status 10%' 'X'.

ITAB = '*INIC_STA*'.

APPEND ITAB.

LOOP AT STA.

ITAB = STA.

APPEND ITAB.

ENDLOOP.

ITAB = '*FIM_STA*'.

APPEND ITAB.

ITAB = '*INIC_FUN*'.

APPEND ITAB.

LOOP AT FUN.

ITAB = FUN.

APPEND ITAB.

ENDLOOP.

ITAB = '*FIM_FUN*'.

APPEND ITAB.

MENSSAGEM STA[] 20 'Exportando Gui-Status 20%' 'X'.

ITAB = '*INIC_MTX*'.

APPEND ITAB.

LOOP AT MTX.

ITAB = MTX.

APPEND ITAB.

ENDLOOP.

ITAB = '*FIM_MTX*'.

APPEND ITAB.

MENSSAGEM STA[] 30 'Exportando Gui-Status 30%' 'X'.

ITAB = '*INIC_DOC*'.

APPEND ITAB.

LOOP AT DOC.

ITAB = DOC.

APPEND ITAB.

ENDLOOP.

ITAB = '*FIM_DOC*'.

APPEND ITAB.

MENSSAGEM STA[] 40 'Exportando Gui-Status 40%' 'X'.

ITAB = '*INIC_TIT*'.

APPEND ITAB.

LOOP AT TIT.

ITAB = TIT.

APPEND ITAB.

ENDLOOP.

ITAB = '*FIM_TIT*'.

APPEND ITAB.

MENSSAGEM STA[] 50 'Exportando Gui-Status 50%' 'X'.

ITAB = '*INIC_MEN*'.

APPEND ITAB.

LOOP AT MEN.

ITAB = MEN.

APPEND ITAB.

ENDLOOP.

ITAB = '*FIM_MEN*'.

APPEND ITAB.

MENSSAGEM STA[] 60 'Exportando Gui-Status 60%' 'X'.

ITAB = '*INIC_ACT*'.

APPEND ITAB.

LOOP AT ACT.

ITAB = ACT.

APPEND ITAB.

ENDLOOP.

ITAB = '*FIM_ACT*'.

APPEND ITAB.

MENSSAGEM STA[] 70 'Exportando Gui-Status 70%' 'X'.

ITAB = '*INIC_ADM*'.

APPEND ITAB.

ITAB = ADM.

APPEND ITAB.

ITAB = '*FIM_ADM*'.

APPEND ITAB.

MENSSAGEM STA[] 80 'Exportando Gui-Status 80%' 'X'.

ITAB = '*INIC_BUT*'.

APPEND ITAB.

LOOP AT BUT.

ITAB = BUT.

APPEND ITAB.

ENDLOOP.

ITAB = '*FIM_BUT*'.

APPEND ITAB.

MENSSAGEM STA[] 90 'Exportando Gui-Status 90%' 'X'.

ITAB = '*INIC_PFK*'.

APPEND ITAB.

LOOP AT PFK.

ITAB = PFK.

APPEND ITAB.

ENDLOOP.

ITAB = '*FIM_PFK*'.

APPEND ITAB.

MENSSAGEM STA[] 100 'Exportando Gui-Status 100%' 'X'.

ITAB = '*INIC_SET*'.

APPEND ITAB.

LOOP AT SET.

ITAB = SET.

APPEND ITAB.

ENDLOOP.

ITAB = '*FIM_SET*'.

APPEND ITAB.

PERFORM DOWNLOAD.

ENDFORM. " EXPORT_ON_LINE

*&----

*& Form IMPORT_ON_LINE

*&----

FORM IMPORT_ON_LINE.

CLEAR N_MARCA.

CLEAR FLAG_MARC.

IF NOME CS '*' OR NOME CS '?'.

MESSAGE S208(00) WITH 'Erro importar Um a Um'.

STOP.

ENDIF.

REFRESH: REPORT, TEXTOS, ITAB.

CLEAR I.

PERFORM UPLOAD.

DATA FLAG(4) TYPE C.

CLEAR FLAG.

LOOP AT ITAB.

IF ITAB CS '###PROG##'.

MESSAGE S208(00) WITH 'Importando Programa Principal'.

FLAG = 'PROG'.

ENDIF.

IF ITAB CS '###FIM##' AND FLAG = 'PROG'.

INSERT REPORT NOME FROM REPORT. " CRIA PROGRAMA

REFRESH REPORT.

COMMIT WORK.

ENDIF.

IF ITAB CS '###TITLE##'.

FLAG = 'TITL'.

ENDIF.

IF ITAB CS '###FIM##' AND FLAG = 'TITL'.

INSERT TEXTPOOL NOME FROM TEXTOS." CRIA TEXTOS

REFRESH TEXTOS.

COMMIT WORK.

ENDIF.

IF ITAB CS '###TEXT##'.

MESSAGE S208(00) WITH 'Importando Textos'.

FLAG = 'TEXT'.

ENDIF.

IF ITAB CS '###FIM##' AND FLAG = 'TEXT'.

INSERT TEXTPOOL NOME FROM TEXTOS." CRIA TEXTOS

REFRESH TEXTOS.

COMMIT WORK.

ENDIF.

IF ITAB CS '###INCL##'.

NOME2 = ITAB+15(8).

FLAG = 'INCL'.

ENDIF.

IF ITAB CS '###FIM##' AND FLAG = 'INCL'.

MESSAGE S368(00) WITH 'Importando Include :' NOME2.

INSERT REPORT NOME2 FROM REPORT. " CRIA PROGRAMA

REFRESH REPORT.

COMMIT WORK.

ENDIF.

IF ITAB CS '###Tela###'.

FLAG = 'TELA'.

DR_READNAME = ITAB+16.

MESSAGE S368(00) WITH 'Importando Tela :' DR_READNAME-DNUM.

ENDIF.

IF ITAB CS '###FIM##' AND FLAG = 'M'.

EXPORT DYNPRO H F E M ID DR_READNAME.

CLEAR : H, F, E, M.

REFRESH : H, F, E, M.

COMMIT WORK.

REFRESH H_BDC.

N_MARCA = N_MARCA + 1.

PERFORM INSERT_LINE USING:

'X' 'SAPMSEUS' '0100',

' ' 'RS37A-DYNPROG' DR_READNAME-PROG,

' ' 'FELD-DYNNR' DR_READNAME-DNUM,

' ' 'RS37A-FUNHD' 'X',

' ' 'BDC_OKCODE' 'AEND',

'X' 'SAPMSEUS' '0150',

' ' 'RS37A-DTXT' NOME_TELA,

' ' 'BDC_OKCODE' '/11'.

IF N_MARCA = 1.

PERFORM INSERT_LINE USING:

'X' 'SAPLSTRD' '0100',

' ' 'BDC_OKCODE' '/7'.

ENDIF.

PERFORM INSERT_LINE USING:

'X' 'SAPMSEUS' '0150',

' ' 'BDC_OKCODE' 'UPD',

'X' 'SAPMSEUS' '0150',

' ' 'BDC_OKCODE' '/3',

'X' 'SAPMSEUS' '0100',

' ' 'BDC_OKCODE' '/3'.

CALL TRANSACTION 'SE51'

USING H_BDC

MODE 'E'

UPDATE 'S'

MESSAGES INTO MESSTAB.

ENDIF.

IF ITAB CS '###NP###'.

CLEAR NOME_TELA.

NOME_TELA = ITAB+14(60).

ENDIF.

IF ITAB CS '###H###'.

FLAG = 'H'.

ENDIF.

IF ITAB CS '###F###'.

FLAG = 'F'.

ENDIF.

IF ITAB CS '###E###'.

FLAG = 'E'.

ENDIF.

IF ITAB CS '###M###'.

FLAG = 'M'.

ENDIF.

CASE FLAG.

WHEN : 'PROG'.

CHECK NOT ITAB CS '###PROG##'.

CHECK NOT ITAB CS '###FIM##'.

REPORT = ITAB.

APPEND REPORT.

WHEN : 'INCL'.

CHECK NOT ITAB CS '###INCL##'.

CHECK NOT ITAB CS '###FIM##'.

REPORT = ITAB.

APPEND REPORT.

WHEN : 'TITL'.

CHECK NOT ITAB CS '###TITLE##'.

CHECK NOT ITAB CS '###FIM##'.

REFRESH H_BDC.

PERFORM INSERT_LINE USING:

'X' 'SAPMSEU0' '0200',

' ' 'RSEUX-CP' 'X',

' ' 'RSEUX-CP_VALUE' NOME,

' ' 'BDC_OKCODE' 'OBJA',

'X' 'SAPMSSY0' '0120',

' ' 'BDC_OKCODE' '/5',

'X' 'SAPMSEU0' '0220',

' ' 'RSEUX-EP_VALUE' NOME,

' ' 'RSEUX-CPZ' 'X',

' ' 'RSEUX-CPZ_VALUE' ITAB+0(3),

' ' 'BDC_OKCODE' '/5',

'X' 'SAPLSEU0' '0302',

' ' 'RSEU1-TIT_TEXT' ITAB+4(60),

' ' 'BDC_OKCODE' 'SAVE',

'X' 'SAPLSTRD' '0100',

' ' 'KO007-L_DEVCLASS' ' ',

' ' 'BDC_OKCODE' 'TEMP',

'X' 'SAPMSSY0' '0120',

' ' 'BDC_OKCODE' 'TRRT',

'X' 'SAPMSEU0' '0200',

' ' 'BDC_OKCODE' '/3'.

CALL TRANSACTION 'SE80'

USING H_BDC

MODE 'N'

UPDATE 'S'

MESSAGES INTO MESSTAB.

WHEN : 'TEXT'.

CHECK NOT ITAB CS '###TEXT##'.

CHECK NOT ITAB CS '###FIM##'.

TEXTOS = ITAB.

APPEND TEXTOS.

WHEN : 'H'.

CHECK NOT ITAB CS '###H###'.

CHECK NOT ITAB CS '###FIM##'.

HC = ITAB.

H-PROG = HC-PROG.

H-DNUM = HC-DNUM.

H-TYPE = HC-TYPE.

H-FNUM = HC-FNUM.

H-DGRP = HC-DGRP.

H-BZMX = HC-BZMX.

H-BZBR = HC-BZBR.

H-MILI = HC-MILI.

H-MICO = HC-MICO.

H-MALI = HC-MALI.

H-MACO = HC-MACO.

H-NOLI = HC-NOLI.

H-NOCO = HC-NOCO.

H-VALP = HC-VALP.

H-CUAN = HC-CUAN.

H-HDAT = HC-HDAT.

H-SPRA = HC-SPRA.

H-CUPO = HC-CUPO.

H-DGEN = HC-DGEN.

H-TGEN = HC-TGEN.

APPEND H.

WHEN : 'F'.

CHECK NOT ITAB CS '###F###'.

CHECK NOT ITAB CS '###FIM##'.

SPLIT ITAB AT '|' INTO

FNAM DIDX FLG1 FLG2 FLG3 FILL FMB1 FMB2 COLR

LENG LINE COLN LTYP LANF LBLK LREP FMKY PAID

UCNV TYPE AUTH WNAM DMAC GRP1 GRP2 GRP3 GRP4

ITYP AGLT ADEZ STXT.

F-FNAM = FNAM.

F-DIDX = DIDX.

F-FLG1 = FLG1.

F-FLG2 = FLG2.

F-FLG3 = FLG3.

F-FILL = FILL.

F-FMB1 = FMB1.

F-FMB2 = FMB2.

F-COLR = COLR.

F-LENG = LENG.

F-LINE = LINE.

F-COLN = COLN.

F-LTYP = LTYP.

F-LANF = LANF.

F-LBLK = LBLK.

F-LREP = LREP.

F-FMKY = FMKY.

F-PAID = PAID.

F-UCNV = UCNV.

F-TYPE = TYPE.

F-AUTH = AUTH.

F-WNAM = WNAM.

F-DMAC = DMAC.

F-GRP1 = GRP1.

F-GRP2 = GRP2.

F-GRP3 = GRP3.

F-GRP4 = GRP4.

F-ITYP = ITYP.

F-AGLT = AGLT.

F-ADEZ = ADEZ.

F-STXT = STXT.

APPEND F.

CLEAR F.

WHEN : 'E'.

CHECK NOT ITAB CS '###E###'.

CHECK NOT ITAB CS '###FIM##'.

E = ITAB.

APPEND E.

WHEN : 'M'.

CHECK NOT ITAB CS '###M###'.

CHECK NOT ITAB CS '###FIM##'.

M = ITAB.

APPEND M.

ENDCASE.

IF ITAB CS '*INIC_LAST*'.

FLAG_MARC = 'LAST'.

ENDIF.

IF ITAB CS '*FIM_LAST*'.

CLEAR FLAG_MARC.

ENDIF.

IF FLAG_MARC = 'LAST' AND

NOT ITAB CS '*INIC_LAST*' AND

NOT ITAB CS '*FIM_LAST*'.

LAST = ITAB.

ENDIF.

IF ITAB CS '*INIC_STA*'.

MESSAGE S208(00) WITH 'Importando Gui-Status'.

FLAG_MARC = 'STA'.

ENDIF.

IF ITAB CS '*FIM_STA*'.

CLEAR FLAG_MARC.

ENDIF.

IF FLAG_MARC = 'STA' AND

NOT ITAB CS '*INIC_STA*' AND

NOT ITAB CS '*FIM_STA*'.

STA = ITAB.

APPEND STA.

ENDIF.

IF ITAB CS '*INIC_FUN*'.

FLAG_MARC = 'FUN'.

ENDIF.

IF ITAB CS '*FIM_FUN*'.

CLEAR FLAG_MARC.

ENDIF.

IF FLAG_MARC = 'FUN' AND

NOT ITAB CS '*INIC_FUN*' AND

NOT ITAB CS '*FIM_FUN*'.

FUN = ITAB.

APPEND FUN.

ENDIF.

IF ITAB CS '*INIC_MTX*'.

FLAG_MARC = 'MTX'.

ENDIF.

IF ITAB CS '*FIM_MTX*'.

CLEAR FLAG_MARC.

ENDIF.

IF FLAG_MARC = 'MTX' AND

NOT ITAB CS '*INIC_MTX*' AND

NOT ITAB CS '*FIM_MTX*'.

MTX = ITAB.

APPEND MTX.

ENDIF.

IF ITAB CS '*INIC_DOC*'.

FLAG_MARC = 'DOC'.

ENDIF.

IF ITAB CS '*FIM_DOC*'.

CLEAR FLAG_MARC.

ENDIF.

IF FLAG_MARC = 'DOC' AND

NOT ITAB CS '*INIC_DOC*' AND

NOT ITAB CS '*FIM_DOC*'.

DOC = ITAB.

APPEND DOC.

ENDIF.

IF ITAB CS '*INIC_TIT*'.

FLAG_MARC = 'TIT'.

ENDIF.

IF ITAB CS '*FIM_TIT*'.

CLEAR FLAG_MARC.

ENDIF.

IF FLAG_MARC = 'TIT' AND

NOT ITAB CS '*INIC_TIT*' AND

NOT ITAB CS '*FIM_TIT*'.

TIT = ITAB.

APPEND TIT.

ENDIF.

IF ITAB CS '*INIC_MEN*'.

FLAG_MARC = 'MEN'.

ENDIF.

IF ITAB CS '*FIM_MEN*'.

CLEAR FLAG_MARC.

ENDIF.

IF FLAG_MARC = 'MEN' AND

NOT ITAB CS '*INIC_MEN*' AND

NOT ITAB CS '*FIM_MEN*'.

MEN = ITAB.

APPEND MEN.

ENDIF.

IF ITAB CS '*INIC_ACT*'.

FLAG_MARC = 'ACT'.

ENDIF.

IF ITAB CS '*FIM_ACT*'.

CLEAR FLAG_MARC.

ENDIF.

IF FLAG_MARC = 'ACT' AND

NOT ITAB CS '*INIC_ACT*' AND

NOT ITAB CS '*FIM_ACT*'.

ACT = ITAB.

APPEND ACT.

ENDIF.

IF ITAB CS '*INIC_ADM*'.

FLAG_MARC = 'ADM'.

ENDIF.

IF ITAB CS '*FIM_ADM*'.

CLEAR FLAG_MARC.

ENDIF.

IF FLAG_MARC = 'ADM' AND

NOT ITAB CS '*INIC_ADM*' AND

NOT ITAB CS '*FIM_ADM*'.

ADM = ITAB.

ENDIF.

IF ITAB CS '*INIC_BUT*'.

FLAG_MARC = 'BUT'.

ENDIF.

IF ITAB CS '*FIM_BUT*'.

CLEAR FLAG_MARC.

ENDIF.

IF FLAG_MARC = 'BUT' AND

NOT ITAB CS '*INIC_BUT*' AND

NOT ITAB CS '*FIM_BUT*'.

BUT = ITAB.

APPEND BUT.

ENDIF.

IF ITAB CS '*INIC_PFK*'.

FLAG_MARC = 'PFK'.

ENDIF.

IF ITAB CS '*FIM_PFK*'.

CLEAR FLAG_MARC.

ENDIF.

IF FLAG_MARC = 'PFK' AND

NOT ITAB CS '*INIC_PFK*' AND

NOT ITAB CS '*FIM_PFK*'.

PFK = ITAB.

APPEND PFK.

ENDIF.

IF ITAB CS '*INIC_SET*'.

FLAG_MARC = 'SET'.

ENDIF.

IF ITAB CS '*FIM_SET*'.

CLEAR FLAG_MARC.

ENDIF.

IF FLAG_MARC = 'SET' AND

NOT ITAB CS '*INIC_SET*' AND

NOT ITAB CS '*FIM_SET*'.

SET = ITAB.

APPEND SET.

ENDIF.

ENDLOOP.

TRKEY-DEVCLASS = '$TMP'.

TRKEY-OBJ_TYPE = 'PROG'.

TRKEY-OBJ_NAME = NOME.

TRKEY-SUB_TYPE = 'CUAD'.

TRKEY-SUB_NAME = NOME.

CALL FUNCTION 'RS_CUA_INTERNAL_WRITE'

EXPORTING

PROGRAM = NOME

LANGUAGE = SY-LANGU

TR_KEY = TRKEY

ADM = ADM

TABLES

STA = STA

FUN = FUN

MEN = MEN

MTX = MTX

ACT = ACT

BUT = BUT

PFK = PFK

SET = SET

DOC = DOC

TIT = TIT

EXCEPTIONS

NOT_FOUND = 1

OTHERS = 2.

IF SY-SUBRC = 0. ENDIF.

ENDFORM. " IMPORT_ON_LINE

*&----

*& Form EXPORT_RELATORIO

*&----

FORM EXPORT_RELATORIO.

TRANSLATE NOME USING '*%?_'.

I = STRLEN( PATH ) - 1.

MOVE PATH+I(1) TO SLASH.

IF SLASH <> ''.

CONCATENATE PATH '' INTO PATH.

ENDIF.

REFRESH: PROGRAMAS.

SELECT NAME FROM TRDIR INTO TABLE PROGRAMAS

WHERE NAME LIKE NOME.

LOOP AT PROGRAMAS.

REFRESH: REPORT, TEXTOS, ITAB.

READ TEXTPOOL PROGRAMAS INTO TEXTOS LANGUAGE 'P'.

ITAB[] = TEXTOS[].

READ REPORT PROGRAMAS INTO REPORT.

ITAB = SEPARADOR.

APPEND ITAB.

LOOP AT REPORT INTO ITAB.

APPEND ITAB.

ENDLOOP.

CHECK SY-SUBRC = 0.

PERFORM DOWNLOAD.

ENDLOOP.

PERFORM DOWN_LOAD_CATALOGO.

ENDFORM. " EXPORT_RELATORIO

*&----

*& Form IMPORT_RELATORIO

*&----

FORM IMPORT_RELATORIO.

REFRESH: REPORT, TEXTOS, ITAB.

CLEAR I.

PERFORM UPLOAD.

LOOP AT ITAB.

IF ITAB = SEPARADOR.

I = 1.

ENDIF.

CASE I.

WHEN 0.

APPEND ITAB TO TEXTOS.

WHEN 1.

APPEND ITAB TO REPORT.

ENDCASE.

ENDLOOP.

DELETE REPORT INDEX 1.

INSERT TEXTPOOL NOME FROM TEXTOS. " CRIA TEXTOS

INSERT REPORT NOME FROM REPORT. " CRIA PROGRAMA

ENDFORM. " IMPORT_RELATORIO

*&----

*& Form Z_EXPORTA_SAPSCRIPT

*&----

FORM Z_EXPORTA_SAPSCRIPT.

ENDFORM. " Z_EXPORTA_SAPSCRIPT

*&----

*& Form Z_IMPORTA_SAPSCRIPT

*&----

FORM Z_IMPORTA_SAPSCRIPT.

ENDFORM. " Z_IMPORTA_SAPSCRIPT

*&----

*& Form DOWN_LOAD_CATALOGO

*&----

text

*----

--> p1 text
<-- p2 text

*----

FORM DOWN_LOAD_CATALOGO.

DATA : BEGIN OF PRG OCCURS 0,

NOME LIKE RS38M-PROGRAMM,

END OF PRG.

PRG[] = PROGRAMAS[].

SELECT NAME TEXT FROM TRDIRT INTO TABLE ITRDIR

FOR ALL ENTRIES IN PRG

WHERE SPRSL EQ SY-LANGU

AND NAME = PRG-NOME.

DATA: NOMBRE LIKE RLGRAP-FILENAME.

CONCATENATE PATH 'catalogo.TXT' INTO NOMBRE.

MENSSAGEM STA[] 50 'Exportando Programa' 'X'.

CALL FUNCTION 'WS_DOWNLOAD'

EXPORTING

FILENAME = NOMBRE

FILETYPE = 'ASC'

TABLES

DATA_TAB = ITRDIR

EXCEPTIONS

FILE_OPEN_ERROR = 1

FILE_WRITE_ERROR = 2

OTHERS = 3.

IF SY-SUBRC = 0. ENDIF.

ENDFORM. " DOWN_LOAD_CATALOGO

*&----

*& Form Z_SAPSCRIPT

*&----

text

*----

--> p1 text
<-- p2 text

*----

FORM Z_SAPSCRIPT.

REFRESH: TAB_NOME.

IF NOT IMPORT IS INITIAL.

MODE = 'IMPORT'.

IF DATASET CS '%' OR DATASET CS '?'.

MESSAGE E002(TD) WITH OBJ_NAME.

ENDIF.

TAB_NOME = OBJ_NAME.

APPEND TAB_NOME.

ELSE.

TRANSLATE OBJ_NAME USING '*%?_'.

MODE = 'EXPORT'.

SELECT OBJ_NAME FROM *TADIR INTO TABLE TAB_NOME

WHERE OBJECT = OBJECT AND OBJ_NAME LIKE OBJ_NAME.

DATASET_AUX = DATASET.

I = STRLEN( DATASET_AUX ) - 1.

MOVE DATASET_AUX+I(1) TO SLASH.

IF SLASH <> ''.

CONCATENATE DATASET_AUX '' INTO DATASET_AUX.

ENDIF.

LOOP AT TAB_NOME.

OBJ_NAME = TAB_NOME.

CONDENSE OBJ_NAME NO-GAPS.

check OBJECT

CASE OBJECT.

WHEN 'PRIN'. SUFFIX = '.PRI'.

WHEN 'TEXT'. SUFFIX = '.TXT'.

WHEN 'STYL'. SUFFIX = '.STY'.

WHEN 'FORM'. SUFFIX = '.FOR'.

WHEN OTHERS.

WRITE: /

'Fehler, als Objekt ist nur TEXT,STYL,FORM,PRIN möglich'.

EXIT.

ENDCASE.

IF IMPORT IS INITIAL.

CONCATENATE DATASET_AUX TAB_NOME SUFFIX INTO DATASET.

ENDIF.

check MODE

CASE MODE.

WHEN 'EXPORT'.

CORRECTION_CHECK = SPACE. "no check when exporting

WHEN 'IMPORT'.

IF SY-BATCH <> 'X'.

CORRECTION_CHECK = 'X'. "do check when importing

ELSE.

CORRECTION_CHECK = SPACE. "no check in batch

ENDIF.

WHEN 'IMPOR!'.

CORRECTION_CHECK = SPACE.

MODE = 'IMPORT'.

WHEN OTHERS.

WRITE: /

'Fehler, als Modus ist nur EXPORT oder IMPORT möglich'.

EXIT.

ENDCASE.

move DATASET into FILE
if filename is still ********..., replace ******** with obj_name

IF DATASET CS '********'.

REPLACE '********' WITH OBJ_NAME(8) INTO DATASET.

CONDENSE DATASET NO-GAPS.

ENDIF.

if filename is still ....&&&&, replace &&&& with SUFFIX

IF DATASET CS '&&&&'.

REPLACE '&&&&' WITH SUFFIX INTO DATASET.

CONDENSE DATASET NO-GAPS.

ENDIF.

FILE = DATASET.

CONDENSE FILE NO-GAPS.

special treatment for object TEXT, the proper format for a TEXT object
(standard text in this case) is TEXT,<name>,ST,<language>

IF OBJECT = 'TEXT'.

REPLACE '&' WITH SY-LANGU INTO TEXTNAME.

REPLACE '*' WITH OBJ_NAME INTO TEXTNAME.

CONDENSE TEXTNAME NO-GAPS.

no correction check for TEXT

PERFORM RSTXSCRP(ZBACKUP3) USING OBJECT TEXTNAME MODE FILE LISTFILE

PLANGVEC BINFILE.

perform rstxscrp(rstxr3tr) using object textname mode file listfile
plangvec binfile.

ELSE.

correction check

IF CORRECTION_CHECK <> SPACE.

PERFORM CORRECTION_ASK_UPDATE USING OBJECT OBJ_NAME.

CHECK SY-SUBRC = 0.

ENDIF.

PERFORM RSTXSCRP USING OBJECT OBJ_NAME MODE FILE LISTFILE

PLANGVEC BINFILE.

ENDIF.

ask correction system to change printer/form/style
SY-SUBRC: 0 o.k.
1 not o.k.

ENDLOOP.

ENDFORM. " Z_SAPSCRIPT

*&----

*& Form CORRECTION_ASK_UPDATE

*&----

text

*----

-->P_OBJECT text *
-->P_OBJ_NAME text *

*----

FORM CORRECTION_ASK_UPDATE USING VALUE(OBJECT) VALUE(NAME).

TABLES: E071, TADIR, DDERR.

DATA: OBJNAME(16).

OBJNAME = NAME.

CLEAR TADIR.

CASE OBJECT.

WHEN 'TEXT'.

SY-SUBRC = 0. EXIT.

WHEN 'FORM'.

SELECT SINGLE * FROM TADIR WHERE PGMID = 'R3TR'
AND OBJECT = OBJECT
AND OBJ_NAME = OBJNAME.
IF SY-SUBRC = 0. "object exists already, check devclass
IF TADIR-DEVCLASS(1) NA 'YZ'.
IF SY-MANDT <> '000'.
SY-SUBRC = 0. EXIT. "its a SAP object, no check in client>0
ENDIF.
ENDIF.
ENDIF.

WHEN 'STYL'.

SELECT SINGLE * FROM TADIR WHERE PGMID = 'R3TR'
AND OBJECT = OBJECT
AND OBJ_NAME = OBJNAME.
IF SY-SUBRC = 0. "object exists already, check devclass
IF TADIR-DEVCLASS(1) NA 'YZ'.
IF SY-MANDT <> '000'.
SY-SUBRC = 0. EXIT. "its a SAP object, no check in client>0
ENDIF.
ENDIF.
ENDIF.

WHEN 'PRIN'.

WHEN OTHERS.

SY-SUBRC = 1. EXIT.

ENDCASE.

ask correction system

E071-PGMID = 'R3TR'.

E071-OBJECT = OBJECT.

E071-OBJ_NAME = OBJNAME.

PERFORM FCOMMEDITCHECK(RDDINSYS) USING E071 TADIR DDERR.

CASE DDERR-SEVERITY.

WHEN 'N'.

SY-SUBRC = 0.

WHEN OTHERS.

display message

WRITE: / 'Das Objekt darf nicht überschrieben werden'.

SY-SUBRC = 1.

ENDCASE.

ENDFORM. " CORRECTION_ASK_UPDATE

*&----

*& Form RSTXSCRP

*&----

text

*----

-->P_OBJECT text *
-->P_OBJ_NAME text *
-->P_MODE text *
-->P_FILE text *
-->P_LISTFILE text *
-->P_PLANGVEC text *
-->P_BINFILE text *

*----

FORM RSTXSCRP USING OBJECT OBJ_NAME MODE FILE LIST_FILE LANG_VEC

BINFILE_FLAG.

DATA RC LIKE SY-SUBRC.

set list file mode...

IF LIST_FILE = 'X'.

LIST_FILE_CONTENTS = 'X'.

ELSE.

LIST_FILE_CONTENTS = SPACE.

ENDIF.

set file format

CLIPBOARD = TRUE.

IF BINFILE_FLAG = 'X'.

PERFORM SET_BINARY_FILE_FORMAT USING TRUE.

PERFORM FC_INIT. "init compress tables

ELSE.

PERFORM SET_BINARY_FILE_FORMAT USING FALSE.

ENDIF.

set custom langvec...

PERFORM SET_CUSTOM_LANGUAGE_VECTOR USING LANG_VEC.

SUBRC = 0.

END_OF_OBJDATA = FALSE.

END_OF_CLIPBOARD = FALSE.

FILENAME = FILE.

WRITE: / TEXT-019. "Start of SAPscript transporter RSTXR3TR

CASE MODE.

WHEN 'EXPORT'.

E X P O R T ***************

PERFORM GET_BINARY_FILE_FORMAT_FLAG.

IF SY-SUBRC = 0.

BINARY FORMAT export *********

OPEN DATASET FILENAME FOR OUTPUT IN BINARY MODE.

SY-SUBRC = 0.

IF SY-SUBRC NE 0.

WRITE: / TEXT-017, FILENAME. "error opening dataset for writing

EXIT.

ENDIF.

write binary header

PERFORM EXPORT_CLIPBOARD_BIN_HEADER.

ELSE.

old TEXT FORMAT export *********

OPEN DATASET FILENAME FOR OUTPUT IN TEXT MODE.

SY-SUBRC = 0.

IF SY-SUBRC NE 0.

WRITE: / TEXT-017, FILENAME. "error opening dataset for writing

EXIT.

ENDIF.

write header entry S...with object key

PERFORM EXPORT_SAPSCRIPT USING OBJECT OBJ_NAME.

export object

PERFORM EXPORT USING OBJECT OBJ_NAME.

close file

PERFORM GET_BINARY_FILE_FORMAT_FLAG.

IF SY-SUBRC = 0.

PERFORM FC_FLUSH_BUFFER USING FILENAME.

ENDIF.

CLOSE DATASET FILENAME.

NOME = FILENAME.

DATA: NOME_100 LIKE RLGRAP-FILENAME.

NOME_100 = NOME.

CALL FUNCTION 'WS_DOWNLOAD'

EXPORTING

FILENAME = NOME_100

FILETYPE = 'ASC'

TABLES

DATA_TAB = TAB_PC

EXCEPTIONS

FILE_OPEN_ERROR = 1

FILE_WRITE_ERROR = 2

INVALID_FILESIZE = 3

INVALID_TABLE_WIDTH = 4

INVALID_TYPE = 5

NO_BATCH = 6

UNKNOWN_ERROR = 7

OTHERS = 8.

I M P O R T ***************

WHEN 'IMPORT'.

END_OF_CLIPBOARD = FALSE.

PERFORM GET_BINARY_FILE_FORMAT_FLAG.

IF SY-SUBRC = 0.

BINARY FORMAT import *********

OPEN DATASET FILENAME FOR INPUT IN BINARY MODE.

PERFORM UPLOAD_SAPSCRIPT USING FILENAME.

IF SY-SUBRC NE 0.

WRITE: / TEXT-018, FILENAME. "error opening dataset for reading

EXIT.

ENDIF.

read binary header, get file codepage

PERFORM IMPORT_CLIPBOARD_BIN_HEADER USING BINFILE_CODEPAGE.

CASE SY-SUBRC.

WHEN 0.

WRITE: / TEXT-060, BINFILE_CODEPAGE. "contains data in cp..

WHEN 1.

WRITE: / TEXT-061. "no valid binary format

EXIT.

WHEN 2.

WRITE: / TEXT-062, BINFILE_CODEPAGE. "unknown codepage

EXIT.

ENDCASE.

ELSE.

old TEXT FORMAT import *********

OPEN DATASET FILENAME FOR INPUT IN TEXT MODE.

PERFORM UPLOAD_SAPSCRIPT USING FILENAME.

IF SY-SUBRC NE 0.

WRITE: / TEXT-018, FILENAME. "error opening dataset for reading

EXIT.

ENDIF.

read header entry S...with object key

PERFORM IMPORT_SAPSCRIPT USING OBJECT OBJ_NAME RC. "QVN

IF RC <> 0. "QVN

CLOSE DATASET FILENAME. "QVN

EXIT. "QVN

ENDIF. "QVN

loop over import objects

WHILE END_OF_CLIPBOARD = FALSE.

PERFORM IMPORT USING SY-SUBRC.

ENDWHILE.

close file
CLOSE DATASET FILENAME.
inform spooler

IF OBJECT = 'PRIN'.

PERFORM RESET_RSPOGET2_BY_TYPE(SAPMSPAD) USING OBJ_NAME.

WRITE: / 'Der Spooler wurde über die Änderung informiert'.

ENDIF.

ENDCASE.

ENDFORM.

*&----

*& Form UPLOAD_SAPSCRIPT

*&----

text

*----

-->P_FILENAME text *

*----

FORM UPLOAD_SAPSCRIPT USING FILE2 TYPE C.

DATA : FILE LIKE RLGRAP-FILENAME.

FILE = FILE2.

REFRESH TAB_PC.

CLEAR TAB_PC.

CALL FUNCTION 'WS_UPLOAD'

EXPORTING

FILENAME = FILE

FILETYPE = 'ASC'" ARQTYPE

TABLES

DATA_TAB = TAB_PC

EXCEPTIONS

CONVERSION_ERROR = 1

FILE_OPEN_ERROR = 2

FILE_READ_ERROR = 3

INVALID_TABLE_WIDTH = 4

INVALID_TYPE = 5

NO_BATCH = 6

UNKNOWN_ERROR = 7

OTHERS = 8.

CLEAR : INDICE.

ENDFORM. " UPLOAD_SAPSCRIPT

*&----

*& Form IMPORT_CLIPBOARD_BIN_HEADER

*&----

text

*----

-->P_BINFILE_CODEPAGE text *

*----

FORM IMPORT_CLIPBOARD_BIN_HEADER USING CODEPAGE.

STATICS: CP LIKE TCP02-CPCODEPAGE,

HEXCHAR(2) TYPE C,

EOF(1) TYPE C.

PERFORM FC_READ_RECORD USING FILENAME RECORD EOF.

IF EOF = TRUE.

SUBRC = 4.

ENDIF.

IF SUBRC NE 0.

END_OF_CLIPBOARD = TRUE. SY-SUBRC = 3. EXIT.

ENDIF.

check binary header

PERFORM CONV_BIN_2_HEX USING RECORD-TYP HEXCHAR.

IF HEXCHAR <> BINARY_FILE_HEADER_BYTE1.

SY-SUBRC = 1. EXIT.

ENDIF.

PERFORM CONV_BIN_2_HEX USING RECORD-COMMAND(1) HEXCHAR.

IF HEXCHAR <> BINARY_FILE_HEADER_BYTE2.

SY-SUBRC = 1. EXIT.

ENDIF.

PERFORM CONV_BIN_2_HEX USING RECORD-COMMAND+1(1) HEXCHAR.

IF HEXCHAR <> BINARY_FILE_HEADER_BYTE3.

SY-SUBRC = 1. EXIT.

ENDIF.

PERFORM CONV_BIN_2_HEX USING RECORD-COMMAND+2(1) HEXCHAR.

IF HEXCHAR <> BINARY_FILE_HEADER_BYTE4.

SY-SUBRC = 1. EXIT.

ENDIF.

PERFORM CONV_BIN_2_HEX USING RECORD-COMMAND+3(1) HEXCHAR.

IF HEXCHAR <> BINARY_FILE_HEADER_BYTE5.

SY-SUBRC = 1. EXIT.

ENDIF.

get codepage

PERFORM CONVERT_BYTE_TO_DIGIT USING RECORD-DATA(1) CP(1).

PERFORM CONVERT_BYTE_TO_DIGIT USING RECORD-DATA1(1) CP1(1).

PERFORM CONVERT_BYTE_TO_DIGIT USING RECORD-DATA2(1) CP2(1).

PERFORM CONVERT_BYTE_TO_DIGIT USING RECORD-DATA3(1) CP3(1).

SELECT SINGLE * FROM TCP00 WHERE CPCODEPAGE = CP.

IF SY-SUBRC = 0.

CODEPAGE = CP.

ELSE.

SY-SUBRC = 2. EXIT.

ENDIF.

ENDFORM. " IMPORT_CLIPBOARD_BIN_HEADER

*&----

*& Form CONVERT_BYTE_TO_DIGIT

*&----

text

*----

-->P_RECORD_DATA(1) text *
-->P_CP(1) text *

*----

FORM CONVERT_BYTE_TO_DIGIT USING VALUE(BYTE) DIGIT.

STATICS: HEX_CHAR(2) TYPE C.

PERFORM CONV_BIN_2_HEX USING BYTE HEX_CHAR.

CASE HEX_CHAR.

WHEN '31'. DIGIT = '1'.

WHEN '32'. DIGIT = '2'.

WHEN '33'. DIGIT = '3'.

WHEN '34'. DIGIT = '4'.

WHEN '35'. DIGIT = '5'.

WHEN '36'. DIGIT = '6'.

WHEN '37'. DIGIT = '7'.

WHEN '38'. DIGIT = '8'.

WHEN '39'. DIGIT = '9'.

WHEN OTHERS. DIGIT = '0'.

ENDCASE.

ENDFORM. " CONVERT_BYTE_TO_DIGIT

*&----

*& Form CONV_BIN_2_HEX

*&----

text

*----

-->P_RECORD_TYP text *
-->P_HEXCHAR text *

*----

FORM CONV_BIN_2_HEX USING VALUE(BYTECHAR) CHARFIELD.

DATA C2(2) TYPE C.

DATA: BEGIN OF HEXBYTE,

X TYPE X,

END OF HEXBYTE.

DATA: BEGIN OF CHARBYTE,

C TYPE C,

END OF CHARBYTE.

CHARBYTE-C = BYTECHAR.

HEXBYTE = CHARBYTE.

CHARFIELD = HEXBYTE-X.

ENDFORM. " CONV_BIN_2_HEX

*&----

*& Form EXPORT

*&----

text

*----

-->P_OBJECT text *
-->P_OBJ_NAME text *

*----

FORM EXPORT USING EXPORT_OBJECT EXPORT_NAME.

EXPORT_FLAG = TRUE.

SUBRC = 0.

COUNT_ERROR = 0.

COUNT_WARNING = 0.

NOTHING = FALSE.

END_OF_OBJDATA = FALSE.

OBJECT = EXPORT_OBJECT.

NAME = EXPORT_NAME.

object ... ... is presently at work

PERFORM NEWPROT USING NLP_INF NLP_LV2 NLP_MID '093'

OBJECT NAME SPACE SPACE.

check for generic object key

IF NAME CS '*' AND OBJECT NE 'TEXT'.

generic key with * only possible with object TEXT

PERFORM NEWPROT USING NLP_ERR NLP_LV2 NLP_MID '056'

SPACE SPACE SPACE SPACE.

EXIT.

ENDIF.

check object

CASE OBJECT.

WHEN 'FORM'.

PERFORM EXPORT_FORMSTYL USING OBJECT_FORM FALSE. "complete object

WHEN 'FORT'.

PERFORM EXPORT_FORMSTYL USING OBJECT_FORM TRUE. "languages only

WHEN 'PRIN'.

PERFORM EXPORT_PRINTER.

WHEN 'STYL'.

PERFORM EXPORT_FORMSTYL USING OBJECT_STYLE FALSE. "complete object

WHEN 'STYT'.

PERFORM EXPORT_FORMSTYL USING OBJECT_STYLE TRUE. "languages only

WHEN 'TEXT'.

PERFORM EXPORT_TEXTS.

WHEN OTHERS.

the transport object .. is unknown

PERFORM NEWPROT USING NLP_ERR NLP_LV2 NLP_MID '057'

OBJECT SPACE SPACE SPACE.

EXIT.

ENDCASE.

IF NOTHING = FALSE.

IF COUNT_ERROR = 0.

export was o.k.

PERFORM NEWPROT USING NLP_INF NLP_LV3 NLP_MID '052'

SPACE SPACE SPACE SPACE.

ELSE.

export encountered x fatal errors

PERFORM NEWPROT USING NLP_INF NLP_LV3 NLP_MID '058'

COUNT_ERROR SPACE SPACE SPACE.

ENDIF.

IF COUNT_WARNING NE 0.

export encountered x warnings

PERFORM NEWPROT USING NLP_INF NLP_LV3 NLP_MID '059'

COUNT_WARNING SPACE SPACE SPACE.

ENDIF.

ENDFORM. " EXPORT

*&----

*& Form EXPORT_CLIPBOARD_BIN_HEADER

*&----

text

*----

--> p1 text
<-- p2 text

*----

FORM EXPORT_CLIPBOARD_BIN_HEADER.

PERFORM CONV_HEX_2_BIN USING BINARY_FILE_HEADER_BYTE1

RECORD-TYP.

PERFORM CONV_HEX_2_BIN USING BINARY_FILE_HEADER_BYTE2

RECORD-COMMAND(1).

PERFORM CONV_HEX_2_BIN USING BINARY_FILE_HEADER_BYTE3

RECORD-COMMAND+1(1).

PERFORM CONV_HEX_2_BIN USING BINARY_FILE_HEADER_BYTE4

RECORD-COMMAND+2(1).

PERFORM CONV_HEX_2_BIN USING BINARY_FILE_HEADER_BYTE5

RECORD-COMMAND+3(1).

now write system codepage

PERFORM CONVERT_DIGIT_TO_BYTE USING SYSTEM_CODEPAGE(1)

RECORD-DATA(1).

PERFORM CONVERT_DIGIT_TO_BYTE USING SYSTEM_CODEPAGE+1(1)

RECORD-DATA+1(1).

PERFORM CONVERT_DIGIT_TO_BYTE USING SYSTEM_CODEPAGE+2(1)

RECORD-DATA+2(1).

PERFORM CONVERT_DIGIT_TO_BYTE USING SYSTEM_CODEPAGE+3(1)

RECORD-DATA+3(1).

RECORD-DATA+4 = SPACE.

PERFORM EXPORT_CLIPBOARD USING FALSE."not end_of_obj

ENDFORM. " EXPORT_CLIPBOARD_BIN_HEADER

*&----

*& Form CONVERT_DIGIT_TO_BYTE

*&----

text

*----

-->P_SYSTEM_CODEPAGE(1) text *
-->P_RECORD_DATA(1) text *

*----

FORM CONVERT_DIGIT_TO_BYTE USING VALUE(DIGIT) BYTE.

STATICS: HEX_CHAR(2) TYPE C.

CASE DIGIT.

WHEN '1'. HEX_CHAR = '31'.

WHEN '2'. HEX_CHAR = '32'.

WHEN '3'. HEX_CHAR = '33'.

WHEN '4'. HEX_CHAR = '34'.

WHEN '5'. HEX_CHAR = '35'.

WHEN '6'. HEX_CHAR = '36'.

WHEN '7'. HEX_CHAR = '37'.

WHEN '8'. HEX_CHAR = '38'.

WHEN '9'. HEX_CHAR = '39'.

WHEN OTHERS. HEX_CHAR = '30'.

ENDCASE.

PERFORM CONV_HEX_2_BIN USING HEX_CHAR BYTE.

ENDFORM. " CONVERT_DIGIT_TO_BYTE

*&----

*& Form CONV_HEX_2_BIN

*&----

text

*----

-->P_BINARY_FILE_HEADER_BYTE1 text *
-->P_RECORD_TYP text *

*----

FORM CONV_HEX_2_BIN USING VALUE(CHARFIELD) BYTECHAR.

DATA: BEGIN OF HEXBYTE,

X TYPE X,

END OF HEXBYTE.

DATA: BEGIN OF CHARBYTE,

C TYPE C,

END OF CHARBYTE.

HEXBYTE-X = CHARFIELD.

CHARBYTE = HEXBYTE.

BYTECHAR = CHARBYTE-C.

ENDFORM. " CONV_HEX_2_BIN

*&----

*& Form EXPORT_CLIPBOARD

*&----

text

*----

-->P_FALSE text *

*----

FORM EXPORT_CLIPBOARD USING VALUE(END_OF_OBJ).

PERFORM GET_BINARY_FILE_FORMAT_FLAG.

IF SY-SUBRC = 0.

binary mode + compress

PERFORM FC_WRITE_RECORD USING FILENAME RECORD END_OF_OBJ.

ELSE.

text mode
TRANSFER RECORD TO FILENAME.
CONCATENATE RECORD-TYP RECORD-COMMAND RECORD-DATA INTO TAB_PC-LINHA.

TAB_PC-LINHA = RECORD.

APPEND TAB_PC.

CLEAR TAB_PC.

ENDIF.

IF LIST_FILE_CONTENTS = 'X'.

WRITE: / RECORD.

ENDIF.

ENDFORM. " EXPORT_CLIPBOARD

*&----

*& Form EXPORT_FORMSTYL

*&----

text

*----

-->P_OBJECT_FORM text *
-->P_FALSE text *

*----

FORM EXPORT_FORMSTYL USING VALUE(OBJECT_TYPE) VALUE(LANGUAGE_ONLY).

DATA: OLANG LIKE THEAD-TDOSPRAS,

RC LIKE SY-SUBRC,

TRANSTAT LIKE THEAD-TDTRANSTAT,

TDNAME LIKE THEAD-TDNAME,

TDOBJECT LIKE THEAD-TDOBJECT.

CASE OBJECT_TYPE.

WHEN OBJECT_FORM.

TDOBJECT = OBJECT_FORM. TDNAME = NAME(16).

WHEN OBJECT_STYLE.

TDOBJECT = OBJECT_STYLE. TDNAME = NAME(8).

WHEN OTHERS.

NOTHING = TRUE. EXIT.

ENDCASE.

PERFORM GET_LANGUAGE_VECTOR USING LANGUAGE_VECTOR.

IF SY-SUBRC <> 0. "exit if language vector cannot be read

NOTHING = TRUE. EXIT.

ENDIF.

always get DEF part, we need TDTRANSTAT for FORT,STYT

CLEAR HEADER_DEF.

SELECT * FROM STXH WHERE TDOBJECT = TDOBJECT

AND TDNAME = TDNAME

AND TDID = ID_DEF.

MOVE-CORRESPONDING STXH TO HEADER_DEF.

ENDSELECT.

IF SY-DBCNT = 1. "only one DEF part allowed

MOVE-CORRESPONDING STXH TO HEADER_DEF.

OLANG = HEADER_DEF-TDSPRAS. "get original language

TRANSTAT = HEADER_DEF-TDTRANSTAT. "get translation-allowed flag

ELSE. "inconsistent: no or several DEF parts

the object does not exist or is damaged and was not exported

PERFORM NEWPROT USING NLP_ERR NLP_LV2 NLP_MID '074'

SPACE SPACE SPACE SPACE.

PERFORM EXPORT_NOTHING. EXIT.

ENDIF.

get TXT part(s)

REFRESH HEADER_TAB.

SELECT * FROM STXH WHERE TDOBJECT = TDOBJECT

AND TDNAME = TDNAME

AND TDID = ID_TXT.

MOVE-CORRESPONDING STXH TO HEADER_TAB. APPEND HEADER_TAB.

ENDSELECT.

check for consistency of FORM/STYL and use LANGUAGE_VECTOR

PERFORM CHECK_FORMSTYL_FOR_EXPORT USING LANGUAGE_ONLY

OLANG

LANGUAGE_VECTOR

TRANSTAT

RC.

CASE RC.

WHEN 0. " o.k.

WHEN 4. " LANGVEC prohibits export/import

PERFORM EXPORT_NOTHING. EXIT.

WHEN 8. " inconsistent object

the object does not exist or is damaged and was not exported

PERFORM NEWPROT USING NLP_ERR NLP_LV2 NLP_MID '074'

SPACE SPACE SPACE SPACE.

PERFORM EXPORT_NOTHING. EXIT.

ENDCASE.

PERFORM EXPORT_HEADER.

IF LANGUAGE_ONLY = FALSE. "if complete layout set is exported ...

set olanguage in target system

PERFORM EXPORT_DATA USING FUNC_OLANGUAGE OLANG.

delete form in target system if no translations wanted

IF TRANSTAT = TRANSLATION_NOT_WANTED.

IF OBJECT_TYPE = OBJECT_FORM.

PERFORM EXPORT_DATA USING FUNC_DEL_FORM TDNAME.

ELSE.

PERFORM EXPORT_DATA USING FUNC_DEL_STYL TDNAME.

ENDIF.

export DEF part

PERFORM EXPORT_TXT USING HEADER_DEF-TDOBJECT

HEADER_DEF-TDID

HEADER_DEF-TDNAME

HEADER_DEF-TDSPRAS

LANGUAGE_ONLY

RC.

IF RC = 0. "export o.k.

definition ... was exported

PERFORM NEWPROT USING NLP_INF NLP_LV3 NLP_MID '062'

HEADER_DEF-TDSPRAS SPACE SPACE SPACE.

ELSE. "error during export

object ... was not exported

PERFORM NEWPROT USING NLP_INF NLP_LV3 NLP_MID '094'

HEADER_DEF-TDOBJECT HEADER_DEF-TDNAME

HEADER_DEF-TDID HEADER_DEF-TDSPRAS.

EXIT.

ENDIF.

export TXT parts

LOOP AT HEADER_TAB.

PERFORM EXPORT_TXT USING HEADER_TAB-TDOBJECT

HEADER_TAB-TDID

HEADER_TAB-TDNAME

HEADER_TAB-TDSPRAS

LANGUAGE_ONLY

RC.

IF RC = 0. "export o.k.

export was o.k.

IF LANGUAGE_ONLY = FALSE AND HEADER_TAB-TDSPRAS = OLANG.

original language ... was exported

PERFORM NEWPROT USING NLP_INF NLP_LV3 NLP_MID '061'

HEADER_TAB-TDSPRAS SPACE SPACE SPACE.

ELSE.

language ... was exported

PERFORM NEWPROT USING NLP_INF NLP_LV3 NLP_MID '063'

HEADER_TAB-TDSPRAS SPACE SPACE SPACE.

ENDIF.

ELSE. "error during export

object ... was not exported

PERFORM NEWPROT USING NLP_INF NLP_LV3 NLP_MID '094'

HEADER_TAB-TDOBJECT HEADER_TAB-TDNAME

HEADER_TAB-TDID HEADER_TAB-TDSPRAS.

ENDIF.

ENDLOOP.

IF LANGUAGE_ONLY = FALSE.

activate object in target system if complete transport

PERFORM EXPORT_FUNCTION USING FUNC_ACTIVATE.

ENDIF.

PERFORM EXPORT_END.

ENDFORM. " EXPORT_FORMSTYL

*&----

*& Form CHECK_FORMSTYL_FOR_EXPORT

*&----

text

*----

-->P_LANGUAGE_ONLY text *
-->P_OLANG text *
-->P_LANGUAGE_VECTOR text *
-->P_TRANSTAT text *
-->P_RC text *

*----

FORM CHECK_FORMSTYL_FOR_EXPORT USING VALUE(LANGUAGE_ONLY)

VALUE(OLANG)

VALUE(LANGVEC)

VALUE(TRANSTAT)

RC.

DATA: NUMOTXT LIKE SY-INDEX, "number of TXT parts in olang

NUMTXT LIKE SY-INDEX. "number of TXT parts allowed by LANGVEC

RC = 0.

NUMTXT = 0.

IF LANGUAGE_ONLY = TRUE.

FORT/STYT export, only TXT parts must be exported

IF TRANSTAT = TRANSLATION_NOT_WANTED.

no language export since object is not language dependent

PERFORM NEWPROT USING NLP_INF NLP_LV3 NLP_MID '049'

HEADER_TAB-TDSPRAS SPACE SPACE SPACE.

RC = 4. EXIT.

ENDIF.

LOOP AT HEADER_TAB.

IF LANGVEC CA HEADER_TAB-TDSPRAS."spras in LANGVEC

ADD 1 TO NUMTXT.

ELSE. "spras not in LANGVEC

language vector prohibits translation export/import

PERFORM NEWPROT USING NLP_INF NLP_LV3 NLP_MID '083'

HEADER_TAB-TDSPRAS SPACE SPACE SPACE.

DELETE HEADER_TAB.

ENDIF.

ENDLOOP.

ELSE.

FORM/STYL export, complete DEF and TXT export

IF TRANSTAT = TRANSLATION_NOT_WANTED. "no translations wanted

language vector is ignored since object not for translation

PERFORM NEWPROT USING NLP_INF NLP_LV3 NLP_MID '054'

SPACE SPACE SPACE SPACE.

ELSE. "translations wanted

IF LANGVEC NA OLANG. "DEF part not in LANGVEC

language vector prohibits OLANG export/import

PERFORM NEWPROT USING NLP_ERR NLP_LV2 NLP_MID '082'

OLANG SPACE SPACE SPACE.

RC = 4. EXIT.

ENDIF.

NUMOTXT = 0.

LOOP AT HEADER_TAB.

IF HEADER_TAB-TDSPRAS = OLANG.

ADD 1 TO NUMOTXT.

ENDIF.

IF TRANSTAT = TRANSLATION_NOT_WANTED. "no translations wanted

IF HEADER_TAB-TDSPRAS = OLANG. "TXT in OSPRAS

ADD 1 TO NUMTXT.

ELSE. "TXT other than OSPRAS

DELETE HEADER_TAB.

ENDIF.

ELSE. "translations wanted

IF LANGVEC CA HEADER_TAB-TDSPRAS. "spras in LANGVEC

ADD 1 TO NUMTXT.

ELSE. "spras not in LANGVEC

language vector prohibits export

PERFORM NEWPROT USING NLP_WAR NLP_LV3 NLP_MID '083'

HEADER_TAB-TDSPRAS SPACE SPACE SPACE.

DELETE HEADER_TAB.

ENDIF.

ENDLOOP.

IF NUMOTXT <> 1.

RC = 8. EXIT. "0 or several TXT parts in olang

ENDIF.

IF NUMTXT = 0. "no TXT parts to export

RC = 4. EXIT.

ENDIF.

ENDFORM. " CHECK_FORMSTYL_FOR_EXPORT

*&----

*& Form EXPORT_DATA

*&----

text

*----

-->P_FUNC_OLANGUAGE text *
-->P_OLANG text *

*----

FORM EXPORT_DATA USING COMMAND DATA.

CLEAR RECORD.

RECORD-COMMAND = COMMAND.

RECORD-DATA = DATA.

IF CLIPBOARD = TRUE.

PERFORM EXPORT_CLIPBOARD USING FALSE. "not end_of_obj

ELSE.

PERFORM EXPDATA(RDDDIC00) USING RECORD.

ENDIF.

ENDFORM. " EXPORT_DATA

*&----

*& Form EXPORT_END

*&----

text

*----

--> p1 text
<-- p2 text

*----

FORM EXPORT_END.

CLEAR RECORD.

RECORD-TYP = 'E'.

IF CLIPBOARD = TRUE.

PERFORM EXPORT_CLIPBOARD USING TRUE. "end_of_obj

ELSE.

PERFORM EXPDATA(RDDDIC00) USING RECORD.

ENDIF.

ENDFORM. " EXPORT_END

*&----

*& Form EXPORT_FUNCTION

*&----

text

*----

-->P_FUNC_ACTIVATE text *

*----

FORM EXPORT_FUNCTION USING FUNCTION.

RECORD-TYP = SPACE.

RECORD-COMMAND = FUNCTION.

RECORD-DATA = STATUS_SAP. "QVN always use SAP, never CUS

IF CLIPBOARD = TRUE.

PERFORM EXPORT_CLIPBOARD USING FALSE. "not end_of_obj

ELSE.

PERFORM EXPDATA(RDDDIC00) USING RECORD.

ENDIF.

ENDFORM. " EXPORT_FUNCTION

*&----

*& Form EXPORT_HEADER

*&----

text

*----

--> p1 text
<-- p2 text

*----

FORM EXPORT_HEADER.

RECORD-TYP = 'H'.

RECORD-COMMAND = OBJECT.

RECORD-DATA = NAME.

IF CLIPBOARD = TRUE.

PERFORM EXPORT_CLIPBOARD USING FALSE. "not end_of_obj

ELSE.

PERFORM EXPDATA(RDDDIC00) USING RECORD.

ENDIF.

ENDFORM. " EXPORT_HEADER

*&----

*& Form EXPORT_NOTHING

*&----

text

*----

--> p1 text
<-- p2 text

*----

FORM EXPORT_NOTHING.

NOTHING = TRUE.

don't send a message it's done by caller of EXPORT_NOTHING

PERFORM EXPORT_HEADER.

PERFORM EXPORT_FUNCTION USING FUNC_NOTHING.

PERFORM EXPORT_END.

ENDFORM. " EXPORT_NOTHING

*&----

*& Form EXPORT_PRINTER

*&----

text

*----

--> p1 text
<-- p2 text

*----

FORM EXPORT_PRINTER.

TSP0A Printer

SELECT SINGLE * FROM TSP0A WHERE PATYPE = NAME(8).

IF SY-SUBRC NE 0.

the object does not exist or is damaged and was not exported

PERFORM NEWPROT USING NLP_ERR NLP_LV2 NLP_MID '074'

SPACE SPACE SPACE SPACE.

PERFORM EXPORT_NOTHING. EXIT.

ENDIF.

Driver

SELECT SINGLE * FROM TSP09 WHERE DRIVER = TSP0A-DRIVER.

IF SY-SUBRC NE 0.

SAPscript driver ... is missing in table TSP09

PERFORM NEWPROT USING NLP_ERR NLP_LV2 NLP_MID '064'

TSP0A-DRIVER SPACE SPACE SPACE.

EXIT.

ENDIF.

PERFORM EXPORT_HEADER.

PERFORM EXPORT_DATA USING 'SP09' TSP09.

PERFORM EXPORT_DATA USING 'SP0A' TSP0A.

TFO03 Printer-Fonts

SELECT * FROM TFO03 WHERE TDPRINTER = NAME(8).

TFO03_LINE-CPI = TFO03-TDCPI.

TFO03_LINE-ALL = TFO03.

TFO03_LINE-ALL+21(3) = SPACE. " TFO03-TDCPI NE ASCII

PERFORM EXPORT_DATA USING 'FO03' TFO03_LINE.

ENDSELECT.

TFO01 Font-Families
do not transport TFO01 any more B20K022408

TFO06 Printer-Barcodes

SELECT * FROM TFO06 WHERE TDPRINTER = NAME(8).

PERFORM EXPORT_DATA USING 'FO06' TFO06.

ENDSELECT.

TFO05 system barcodes
do not transport TFO05 any more B20K022408

T022D Print-Controls

SELECT * FROM T022D WHERE TYP = NAME(8).

PERFORM EXPORT_DATA USING '022D' T022D.

ENDSELECT.

spooler formats

CLEAR PAPER.

SELECT * FROM TSP06 WHERE PDPTYPE = NAME(8).

IF PAPER-PDPAPER NE TSP06-PDPAPER.

PAPER-PDPTYPE = TSP06-PDPTYPE.

PAPER-PDPAPER = TSP06-PDPAPER.

PERFORM EXPORT_DATA USING FUNC_DEL_PAPER PAPER.

SELECT SINGLE * FROM TSP1D WHERE PAPART = PAPER-PDPAPER.

IF SY-SUBRC = 0.

PERFORM EXPORT_DATA USING 'SP1D' TSP1D.

do not export texts any longer B20K022408
SELECT * FROM TSP1T WHERE PAPART = PAPER-PDPAPER.
PERFORM EXPORT_DATA USING 'SP1T' TSP1T.
ENDSELECT.

ELSE.

CLEAR PAPER.

ENDIF.

CHECK PAPER NE SPACE.

TSP06_LINE-PDLFDNR = TSP06-PDLFDNR.

TSP06_LINE-PDDATALEN = TSP06-PDDATALEN.

TSP06_LINE-ALL = TSP06.

TSP06_LINE-ALL+32(2) = SPACE. " PDLFDNR,PDDATALEN ne ASCII

PERFORM EXPORT_DATA USING 'SP06' TSP06_LINE.

ENDSELECT.

TFO04 Printer-Metrics

SELECT * FROM TFO04 WHERE TDPRINTER = NAME(8).

PERFORM EXPORT_DATA USING 'FO04' TFO04.

ENDSELECT.

PERFORM EXPORT_END.

ENDFORM. " EXPORT_PRINTER

*&----

*& Form EXPORT_SAPSCRIPT

*&----

text

*----

-->P_OBJECT text *
-->P_OBJ_NAME text *

*----

FORM EXPORT_SAPSCRIPT USING OBJECT OBJ_NAME.

RECORD-TYP = 'S'.

RECORD-COMMAND = OBJECT.

RECORD-DATA = OBJ_NAME.

PERFORM EXPORT_CLIPBOARD USING FALSE. "not end_of_obj

ENDFORM. " EXPORT_SAPSCRIPT

*&----

*& Form EXPORT_TEXTS

*&----

text

*----

--> p1 text
<-- p2 text

*----

FORM EXPORT_TEXTS.

DATA: FILL LIKE SY-TFILL,

RC LIKE SY-SUBRC.

PERFORM GET_LANGUAGE_VECTOR USING LANGUAGE_VECTOR.

IF SY-SUBRC <> 0. "exit if language vector cannot be read

NOTHING = TRUE. EXIT.

ENDIF.

PERFORM NAME_TO_TEXTKEY. "get text key components into TEXTLOW-...

REFRESH HEADER_TAB.

CALL FUNCTION 'SELECT_TEXT'

EXPORTING

CLIENT = SY-MANDT

DATABASE_ONLY = 'X'

ID = TEXTLOW-TDID

LANGUAGE = TEXTLOW-TDSPRAS

NAME = TEXTLOW-TDNAME

OBJECT = TEXTLOW-TDOBJECT

TEXTMEMORY_ONLY = ' '
ARCHIVE_HANDLE = 0

IMPORTING

ENTRIES = FILL

TABLES

SELECTIONS = HEADER_TAB

EXCEPTIONS

WRONG_ACCESS_TO_ARCHIVE = 1

OTHERS = 2.

eliminate some entries...

LOOP AT HEADER_TAB.

IF HEADER_TAB-TDOBJECT = OBJECT_FORM OR

HEADER_TAB-TDOBJECT = OBJECT_STYLE.

DELETE HEADER_TAB.

ELSE.

IF LANGUAGE_VECTOR NA HEADER_TAB-TDSPRAS.

language vector prohibits OLANG export/import

PERFORM NEWPROT USING NLP_WAR NLP_LV2 NLP_MID '082'

HEADER_TAB-TDSPRAS SPACE SPACE SPACE.

DELETE HEADER_TAB.

ENDIF.

ENDLOOP.

DESCRIBE TABLE HEADER_TAB LINES FILL.

IF FILL = 0.

the object does not exist or is damaged and was not exported

PERFORM NEWPROT USING NLP_ERR NLP_LV2 NLP_MID '074'

SPACE SPACE SPACE SPACE.

PERFORM EXPORT_NOTHING. EXIT.

ENDIF.

PERFORM EXPORT_HEADER.

LOOP AT HEADER_TAB.

export TEXT object

PERFORM EXPORT_TXT USING HEADER_TAB-TDOBJECT

HEADER_TAB-TDID

HEADER_TAB-TDNAME

HEADER_TAB-TDSPRAS

FALSE RC.

IF RC = 0.

text object ... was exported

PERFORM NEWPROT USING NLP_INF NLP_LV3 NLP_MID '086'

HEADER_TAB-TDOBJECT

HEADER_TAB-TDNAME

HEADER_TAB-TDID

HEADER_TAB-TDSPRAS.

ELSE.

text object ... was not exported

PERFORM NEWPROT USING NLP_INF NLP_LV3 NLP_MID '091'

HEADER_TAB-TDOBJECT

HEADER_TAB-TDNAME

HEADER_TAB-TDID

HEADER_TAB-TDSPRAS.

ENDIF.

ENDLOOP.

PERFORM EXPORT_END.

ENDFORM. " EXPORT_TEXTS

*&----

*& Form EXPORT_TXT

*&----

text

*----

-->P_HEADER_DEF_TDOBJECT text *
-->P_HEADER_DEF_TDID text *
-->P_HEADER_DEF_TDNAME text *
-->P_HEADER_DEF_TDSPRAS text *
-->P_LANGUAGE_ONLY text *
-->P_RC text *

*----

FORM EXPORT_TXT USING VALUE(OBJECT) VALUE(ID)

VALUE(NAME) VALUE(LANGUAGE)

VALUE(LANGUAGE_ONLY) RC.

CALL FUNCTION 'READ_TEXT'

EXPORTING OBJECT = OBJECT

ID = ID

NAME = NAME

LANGUAGE = LANGUAGE

IMPORTING HEADER = HEADER

TABLES LINES = LINES

EXCEPTIONS ID = 1

LANGUAGE = 2

NAME = 3

NOT_FOUND = 4

OBJECT = 5

REFERENCE_CHECK = 6

OTHERS = 7.

IF SY-SUBRC = 0.

READ_TEXT o.k.

IF HEADER-TDOBJECT = OBJECT_STYLE OR

HEADER-TDOBJECT = OBJECT_FORM. "this is a style/layout set

IF LANGUAGE_ONLY = TRUE.

HEADER-TDNAME+16(3) = SPACE. "export and import ACT state

ELSE.

HEADER-TDNAME+16(3) = STATUS_SAP. "export and import MOD state

ENDIF.

ELSE. "this is a text

IF HEADER-TDTEXTTYPE <> SPACE.

convert LINES data from binary to ascii

PERFORM CONVERT_LINES_BIN_2_ASCII.

ENDIF.

PERFORM EXPORT_DATA USING 'HEAD' HEADER.

LOOP AT LINES.

PERFORM EXPORT_DATA USING 'LINE' LINES.

ENDLOOP.

PERFORM EXPORT_DATA USING 'END ' SPACE.

RC = 0.

ELSE.

READ_TEXT(...) failed

PERFORM NEWPROT USING NLP_ERR NLP_LV2 NLP_MID '090'

OBJECT NAME ID LANGUAGE.

get sapscript's error message number and pass it on

CALL FUNCTION 'SAPSCRIPT_MESSAGE_GET_NO'

IMPORTING NO = ITCRS-MSGNO

V1 = ITCRS-MSGV1

V2 = ITCRS-MSGV2

V3 = ITCRS-MSGV3

V4 = ITCRS-MSGV4.

PERFORM NEWPROT USING NLP_INF NLP_LV2 NLP_MID ITCRS-MSGNO

ITCRS-MSGV1 ITCRS-MSGV2

ITCRS-MSGV3 ITCRS-MSGV4.

RC = 1.

ENDIF.

ENDFORM. " EXPORT_TXT

*&----

*& Form CONVERT_LINES_BIN_2_ASCII

*&----

text

*----

--> p1 text
<-- p2 text

*----

FORM CONVERT_LINES_BIN_2_ASCII.

DATA BEGIN OF L OCCURS 100.

INCLUDE STRUCTURE TLINE.

DATA END OF L.

FIELD-SYMBOLS

REFRESH L.

LOOP AT LINES.

convert format

CLEAR L.

PERFORM CONV_BIN_2_HEX USING LINES-TDFORMAT(1) L-TDFORMAT.

ASSIGN L-TDLINE(2) TO

.
PERFORM CONV_BIN_2_HEX USING LINES-TDFORMAT+1(1)

convert line(1..65)

DO 65 TIMES.

ASSIGN

+2(2) TO

.
PERFORM CONV_BIN_2_HEX USING LINES-TDLINE(1)

SHIFT LINES-TDLINE.

ENDDO.

APPEND L. CLEAR L.

convert line(66)

PERFORM CONV_BIN_2_HEX USING LINES-TDLINE(1) L-TDFORMAT.

SHIFT LINES-TDLINE.

convert line(67)

ASSIGN L-TDLINE(2) TO

.
PERFORM CONV_BIN_2_HEX USING LINES-TDLINE(1)

SHIFT LINES-TDLINE.

convert line(68..132)

DO 65 TIMES.

ASSIGN

+2(2) TO

.
PERFORM CONV_BIN_2_HEX USING LINES-TDLINE(1)

SHIFT LINES-TDLINE.

ENDDO.

APPEND L.

ENDLOOP.

REFRESH LINES.

LOOP AT L.

LINES = L. APPEND LINES.

ENDLOOP.

FREE L.

ENDFORM. " CONVERT_LINES_BIN_2_ASCII

*&----

*& Form FC_FLUSH_BUFFER

*&----

text

*----

-->P_FILENAME text *

*----

FORM FC_FLUSH_BUFFER USING VALUE(DATASET_NAME).

IF FC_FULL_TAB_LINES > 0.

PERFORM FC_COMPRESS_TAB.

PERFORM FC_OUTPUT_COMP_TAB USING DATASET_NAME.

FC_FULL_TAB_LINES = 0. REFRESH FC_FULL_TAB.

ENDIF.

ENDFORM. " FC_FLUSH_BUFFER

*&----

*& Form FC_COMPRESS_TAB

*&----

text

*----

--> p1 text
<-- p2 text

*----

FORM FC_COMPRESS_TAB.

CALL FUNCTION 'TABLE_COMPRESS'

IMPORTING
COMPRESSED_SIZE =

TABLES

IN = FC_FULL_TAB

OUT = FC_COMP_TAB

EXCEPTIONS

COMPRESS_ERROR = 1

OTHERS = 2.

IF SY-SUBRC <> 0.

WRITE: / 'Fehler bei TABLE_COMPRESS'(200), SY-SUBRC.

STOP.

ENDIF.

DESCRIBE TABLE FC_COMP_TAB LINES FC_COMP_TAB_LINES.

ENDFORM. " FC_COMPRESS_TAB

*&----

*& Form FC_INIT

*&----

text

*----

--> p1 text
<-- p2 text

*----

FORM FC_INIT.

REFRESH FC_FULL_TAB. FREE FC_FULL_TAB.

FC_FULL_TAB_LINES = 0.

REFRESH FC_COMP_TAB. FREE FC_COMP_TAB.

FC_COMP_TAB_LINES = 0.

ENDFORM. " FC_INIT

*&----

*& Form FC_OUTPUT_COMP_TAB

*&----

text

*----

-->P_DATASET_NAME text *

*----

FORM FC_OUTPUT_COMP_TAB USING VALUE(DATASET_NAME).

DESCRIBE TABLE FC_COMP_TAB LINES FC_COMP_TAB_LINES.

CHECK FC_COMP_TAB_LINES > 0.

PERFORM FC_WRITE_COMPHEADER USING DATASET_NAME FC_COMP_TAB_LINES.

LOOP AT FC_COMP_TAB.

TRANSFER FC_COMP_TAB-RECORD TO DATASET_NAME.

TAB_PC-LINHA = FC_COMP_TAB-RECORD.

APPEND TAB_PC.

CLEAR TAB_PC.

ENDLOOP.

FC_COMP_TAB_LINES = 0.

REFRESH FC_COMP_TAB. FREE FC_COMP_TAB.

ENDFORM. " FC_OUTPUT_COMP_TAB

*&----

*& Form FC_READ_RECORD

*&----

text

*----

-->P_FILENAME text *
-->P_RECORD text *
-->P_EOF text *

*----

FORM FC_READ_RECORD USING VALUE(DATASET_NAME) REC EOF.

IF FC_FULL_TAB_LINES = 0.

read next block

PERFORM FC_INPUT_COMP_TAB USING DATASET_NAME EOF.

IF EOF = TRUE.

EXIT.

ENDIF.

PERFORM FC_DECOMPRESS_TAB.

ENDIF.

READ TABLE FC_FULL_TAB INDEX 1.

IF SY-SUBRC <> 0.

WRITE: / 'Fehler: Entkomprimierte Tabelle ist leer'(204). STOP.

ENDIF.

REC = FC_FULL_TAB-RECORD.

DELETE FC_FULL_TAB INDEX 1.

FC_FULL_TAB_LINES = FC_FULL_TAB_LINES - 1.

ENDFORM.

*&----

*& Form FC_DECOMPRESS_TAB

*&----

text

*----

--> p1 text
<-- p2 text

*----

FORM FC_DECOMPRESS_TAB.

CHECK FC_COMP_TAB_LINES > 0.

CALL FUNCTION 'TABLE_DECOMPRESS'

TABLES

IN = FC_COMP_TAB

OUT = FC_FULL_TAB

EXCEPTIONS

COMPRESS_ERROR = 1

TABLE_NOT_COMPRESSED = 2

OTHERS = 3.

IF SY-SUBRC <> 0.

WRITE: / 'Fehler bei TABLE_DECOMPRESS'(201), SY-SUBRC.

STOP.

ENDIF.

DESCRIBE TABLE FC_FULL_TAB LINES FC_FULL_TAB_LINES.

ENDFORM. " FC_DECOMPRESS_TAB

*&----

*& Form FC_INPUT_COMP_TAB

*&----

text

*----

-->P_DATASET_NAME text *
-->P_EOF text *

*----

FORM FC_INPUT_COMP_TAB USING VALUE(DATASET_NAME) EOF.

EOF = FALSE.

REFRESH FC_COMP_TAB.

PERFORM FC_READ_COMPHEADER USING DATASET_NAME FC_COMP_TAB_LINES.

IF SY-SUBRC <> 0.

WRITE: / 'Fehler: Ungültige Blockkennung, falsches Dateiformat'(202).

STOP.

ENDIF.

IF FC_COMP_TAB_LINES = 0.

EOF = TRUE. EXIT.

ENDIF.

DO FC_COMP_TAB_LINES TIMES.

READ DATASET DATASET_NAME INTO FC_COMP_TAB-RECORD.

ADD 1 TO INDICE.

READ TABLE TAB_PC INDEX INDICE INTO FC_COMP_TAB-RECORD.

ADD 1 TO INDICE.

IF SY-SUBRC = 0.

APPEND FC_COMP_TAB.

ELSE.

WRITE: /

'Fehler: Zu wenige komprimierte Blöcke, Datei unvollständig'(203).

WRITE: /

'Soll-Anzahl:', FC_COMP_TAB_LINES.

DESCRIBE TABLE FC_COMP_TAB LINES FC_COMP_TAB_LINES.

WRITE: /

'Ist-Anzahl:', FC_COMP_TAB_LINES.

STOP.

ENDIF.

ENDDO.

DESCRIBE TABLE FC_COMP_TAB LINES FC_COMP_TAB_LINES.

ENDFORM. " FC_INPUT_COMP_TAB

*&----

*& Form FC_READ_COMPHEADER

*&----

text

*----

-->P_DATASET_NAME text *
-->P_FC_COMP_TAB_LINES text *

*----

FORM FC_READ_COMPHEADER USING VALUE(DATASET_NAME) NUMRECORDS.

STATICS: COMPHEADER(50),

NUMREC(6) TYPE N,

HEXCHAR(2) TYPE C.

*READ DATASET DATASET_NAME INTO COMPHEADER.

ADD 1 TO INDICE.

READ TABLE TAB_PC INDEX INDICE INTO COMPHEADER.

*ADD 1 TO INDICE.

IF SY-SUBRC <> 0.

NUMRECORDS = 0. SY-SUBRC = 0. EXIT.

ENDIF.

read binary header id

PERFORM CONV_BIN_2_HEX USING COMPHEADER(1) HEXCHAR.

IF HEXCHAR <> BINARY_FILE_HEADER_BYTE1.

SY-SUBRC = 1. EXIT.

ENDIF.

PERFORM CONV_BIN_2_HEX USING COMPHEADER+1(1) HEXCHAR.

IF HEXCHAR <> BINARY_FILE_HEADER_BYTE2.

SY-SUBRC = 1. EXIT.

ENDIF.

PERFORM CONV_BIN_2_HEX USING COMPHEADER+2(1) HEXCHAR.

IF HEXCHAR <> BINARY_FILE_HEADER_BYTE3.

SY-SUBRC = 1. EXIT.

ENDIF.

PERFORM CONV_BIN_2_HEX USING COMPHEADER+3(1) HEXCHAR.

IF HEXCHAR <> BINARY_FILE_HEADER_BYTE4.

SY-SUBRC = 1. EXIT.

ENDIF.

PERFORM CONV_BIN_2_HEX USING COMPHEADER+4(1) HEXCHAR.

IF HEXCHAR <> BINARY_FILE_HEADER_BYTE5.

SY-SUBRC = 1. EXIT.

ENDIF.

read block size

PERFORM CONVERT_BYTE_TO_DIGIT USING COMPHEADER+5(1) NUMREC(1).

PERFORM CONVERT_BYTE_TO_DIGIT USING COMPHEADER6(1) NUMREC1(1).

PERFORM CONVERT_BYTE_TO_DIGIT USING COMPHEADER7(1) NUMREC2(1).

PERFORM CONVERT_BYTE_TO_DIGIT USING COMPHEADER8(1) NUMREC3(1).

PERFORM CONVERT_BYTE_TO_DIGIT USING COMPHEADER9(1) NUMREC4(1).

PERFORM CONVERT_BYTE_TO_DIGIT USING COMPHEADER10(1) NUMREC5(1).

NUMRECORDS = NUMREC.

ENDFORM. " FC_READ_COMPHEADER

*&----

*& Form FC_WRITE_COMPHEADER

*&----

text

*----

-->P_DATASET_NAME text *
-->P_FC_COMP_TAB_LINES text *

*----

FORM FC_WRITE_COMPHEADER USING VALUE(DATASET_NAME) VALUE(NUMRECORDS).

STATICS: COMPHEADER(50),

NUMREC(6) TYPE N.

NUMREC = NUMRECORDS.

PERFORM CONV_HEX_2_BIN USING BINARY_FILE_HEADER_BYTE1

COMPHEADER(1).

PERFORM CONV_HEX_2_BIN USING BINARY_FILE_HEADER_BYTE2

COMPHEADER+1(1).

PERFORM CONV_HEX_2_BIN USING BINARY_FILE_HEADER_BYTE3

COMPHEADER+2(1).

PERFORM CONV_HEX_2_BIN USING BINARY_FILE_HEADER_BYTE4

COMPHEADER+3(1).

PERFORM CONV_HEX_2_BIN USING BINARY_FILE_HEADER_BYTE5

COMPHEADER+4(1).

PERFORM CONVERT_DIGIT_TO_BYTE USING NUMREC(1) COMPHEADER+5(1).

PERFORM CONVERT_DIGIT_TO_BYTE USING NUMREC1(1) COMPHEADER6(1).

PERFORM CONVERT_DIGIT_TO_BYTE USING NUMREC2(1) COMPHEADER7(1).

PERFORM CONVERT_DIGIT_TO_BYTE USING NUMREC3(1) COMPHEADER8(1).

PERFORM CONVERT_DIGIT_TO_BYTE USING NUMREC4(1) COMPHEADER9(1).

PERFORM CONVERT_DIGIT_TO_BYTE USING NUMREC5(1) COMPHEADER10(1).

COMPHEADER+11 = SPACE.

*TRANSFER COMPHEADER TO DATASET_NAME.

TAB_PC-LINHA = COMPHEADER.

APPEND TAB_PC.

CLEAR TAB_PC.

ENDFORM. " FC_WRITE_COMPHEADER

*&----

*& Form FC_WRITE_RECORD

*&----

text

*----

-->P_FILENAME text *
-->P_RECORD text *
-->P_END_OF_OBJ text *

*----

FORM FC_WRITE_RECORD USING VALUE(DATASET_NAME) VALUE(REC)

VALUE(END_OF_OBJ).

FC_FULL_TAB-RECORD = REC.

APPEND FC_FULL_TAB.

ADD 1 TO FC_FULL_TAB_LINES.

IF FC_FULL_TAB_LINES >= FC_FULL_TAB_MAXLINES AND END_OF_OBJ = TRUE.

PERFORM FC_COMPRESS_TAB.

REFRESH FC_FULL_TAB.

FC_FULL_TAB_LINES = 0.

PERFORM FC_OUTPUT_COMP_TAB USING DATASET_NAME.

ENDIF.

ENDFORM. " FC_WRITE_RECORD

*&----

*& Form GET_BINARY_FILE_FORMAT_FLAG

*&----

text

*----

--> p1 text
<-- p2 text

*----

FORM GET_BINARY_FILE_FORMAT_FLAG.

IF BINARY_FILE_FORMAT_VALID = BINARY_FILE_FORMAT_MAGIC.

SY-SUBRC = 0.

ELSE.

SY-SUBRC = 1.

ENDIF.

ENDFORM. " GET_BINARY_FILE_FORMAT_FLAG

*&----

*& Form GET_LANGUAGE_VECTOR

*&----

text

*----

-->P_LANGUAGE_VECTOR text *

*----

FORM GET_LANGUAGE_VECTOR CHANGING LANGVEC.

do we have a custom langvec that overrides system vector?

IF CUSTOM_LANGUAGE_VECTOR_VALID = CUSTOM_LANGUAGE_VECTOR_MAGIC.

LANGVEC = CUSTOM_LANGUAGE_VECTOR.

SY-SUBRC = 0.

ELSE.

CALL FUNCTION 'SYSTEM_INSTALLED_LANGUAGES'

IMPORTING

LANGUAGES = LANGVEC

EXCEPTIONS

SAPGPARAM_ERROR = 01.

ENDIF.

IF SY-SUBRC = 0.

used language vector: ...

PERFORM NEWPROT USING NLP_INF NLP_LV3 NLP_MID '080'

LANGVEC SPACE SPACE SPACE.

SY-SUBRC = 0.

ELSE.

error when reading language vector

PERFORM NEWPROT USING NLP_ERR NLP_LV2 NLP_MID '098'

SPACE SPACE SPACE SPACE.

SY-SUBRC = 1.

ENDIF.

ENDFORM. " GET_LANGUAGE_VECTOR

*&----

*& Form IMPORT

*&----

text

*----

-->P_SY_SUBRC text *

*----

FORM IMPORT USING IMPORT_SUBRC.

DATA MSGNO LIKE T100-MSGNR.

EXPORT_FLAG = FALSE.

SUBRC = 0.

COUNT_ERROR = 0.

COUNT_WARNING = 0.

NOTHING = FALSE.

END_OF_DATA = FALSE.

END_OF_OBJDATA = FALSE.

ACTIVATE_OBJECT = FALSE.

ACTIVATE_OBJECT_OK = FALSE.

IMPORT_OK = TRUE.

read header entry of transport object
sets OBJECT, NAME

PERFORM IMPORT_HEADER. "may set SUBRC > 0 if error

IF SUBRC <> 0.

skip remaining records

PERFORM SKIP_UNREAD_RECORDS.

IMPORT_SUBRC = 4.

EXIT.

ENDIF.

call IMPORT subroutines depending on object

CASE OBJECT.

WHEN 'FORM'.

PERFORM IMPORT_FORMSTYL USING OBJECT_FORM FALSE. "complete object

WHEN 'FORT'.

PERFORM IMPORT_FORMSTYL USING OBJECT_FORM TRUE. "languages only

WHEN 'PRIN'.

PERFORM IMPORT_PRIN.

WHEN 'STYL'.

PERFORM IMPORT_FORMSTYL USING OBJECT_STYLE FALSE. "complete object

WHEN 'STYT'.

PERFORM IMPORT_FORMSTYL USING OBJECT_STYLE TRUE. "languages only

WHEN 'TEXT'.

PERFORM IMPORT_TEXT.

ENDCASE.

save SUBRC

IMPORT_SUBRC = SUBRC.

skip remaining records...

PERFORM SKIP_UNREAD_RECORDS.

send final message about success, errors or warnings...

IF NOTHING = FALSE.

IF IMPORT_OK = TRUE.

IF ACTIVATE_OBJECT = FALSE.

the object was imported successfully

PERFORM NEWPROT USING NLP_INF NLP_LV3 NLP_MID '071'

SPACE SPACE SPACE SPACE.

ELSE.

IF ACTIVATE_OBJECT_OK = TRUE.

the object was imported and activated successfully

PERFORM NEWPROT USING NLP_INF NLP_LV3 NLP_MID '088'

SPACE SPACE SPACE SPACE.

ELSE.

the object was imported successfully but not activated

PERFORM NEWPROT USING NLP_INF NLP_LV3 NLP_MID '089'

SPACE SPACE SPACE SPACE.

ENDIF.

IF COUNT_ERROR > 0.

... fatal errors were encountered during import

PERFORM NEWPROT USING NLP_INF NLP_LV3 NLP_MID '072'

COUNT_ERROR SPACE SPACE SPACE.

ENDIF.

IF COUNT_WARNING > 0.

... warnings were encountered during import

PERFORM NEWPROT USING NLP_INF NLP_LV3 NLP_MID '073'

COUNT_WARNING SPACE SPACE SPACE.

ENDIF.

ENDFORM. " IMPORT

*&----

*& Form IMPORT_FORMSTYL

*&----

text

*----

-->P_OBJECT_FORM text *
-->P_FALSE text *

*----

FORM IMPORT_FORMSTYL USING VALUE(OBJECT_TYPE) VALUE(LANGUAGE_ONLY).

DATA: RC LIKE SY-SUBRC,

OLANG LIKE THEAD-TDOSPRAS,

TRANSTAT LIKE THEAD-TDTRANSTAT.

PERFORM GET_LANGUAGE_VECTOR USING LANGUAGE_VECTOR.

IF SY-SUBRC <> 0. "exit if language vector cannot be read

NOTHING = TRUE. SUBRC = 4. EXIT.

ENDIF.

invalidate HEADER,LINES

CLEAR HEADER. REFRESH LINES.

CLEAR OLANG.

TRANSTAT = TRANSLATION_WANTED. "default

PERFORM IMPORT_RECORD.

WHILE END_OF_OBJDATA = FALSE AND SUBRC = 0.

CASE RECORD-COMMAND.

header data

WHEN 'HEAD'.

HEADER = RECORD-DATA. REFRESH LINES.

lines data

WHEN 'LINE'.

LINES = RECORD-DATA. APPEND LINES.

end of header & lines

WHEN 'END'.

check if LANGVEC allows import

PERFORM CHECK_FORMSTYL_FOR_IMPORT USING HEADER

LANGUAGE_ONLY

OLANG

LANGUAGE_VECTOR

TRANSTAT

RC.

CASE RC.

WHEN 0. "o.k. to import

PERFORM SAVE_TEXT USING RC.

CASE RC.

WHEN 0. "SAVE_TEXT o.k.

WHEN 2. "BAD_LANGUAGE

IF HEADER-TDSPRAS = HEADER-TDOSPRAS.

IMPORT_OK = FALSE. "suppress 'successful import' message

ENDIF.

WHEN OTHERS. "other error

IMPORT_OK = FALSE. "should not happen

ENDCASE.

WHEN 4. "TXT not in langvec -> cannot import language

no action, only info

WHEN 8. "DEF not in langvec -> cannot import complete object

IMPORT_OK = FALSE.

NOTHING = TRUE. "no final message on warnings/errors/success

ENDCASE.

invalidate HEADER,LINES

CLEAR HEADER. REFRESH LINES.

delete command FORM

WHEN FUNC_DEL_FORM.

IF LANGUAGE_ONLY = FALSE. "complete import

PERFORM DELETE_OBJECT USING OBJECT_FORM RECORD-DATA(16).

ENDIF.

delete command STYLE

WHEN FUNC_DEL_STYL.

IF LANGUAGE_ONLY = FALSE. "complete import

PERFORM DELETE_OBJECT USING OBJECT_STYLE RECORD-DATA(8).

ENDIF.

activate command

WHEN FUNC_ACTIVATE.

IF LANGUAGE_ONLY = FALSE. "complete import

IF IMPORT_OK = TRUE. "DEF was imported

PERFORM ACTIVATE_OBJECT.

ENDIF.

set original language command

WHEN FUNC_OLANGUAGE.

OLANG = RECORD-DATA(1).

IF LANGUAGE_ONLY = FALSE. "complete import

PERFORM SET_OLANGUAGE USING OBJECT_TYPE OLANG LANGUAGE_VECTOR.

ENDIF.

nothing data (dummy export)

WHEN FUNC_NOTHING.

nothing was imported

PERFORM NEWPROT USING NLP_WAR NLP_LV3 NLP_MID '069'

SPACE SPACE SPACE SPACE.

NOTHING = TRUE.

unknown command

WHEN OTHERS.

format ... is unknown and will be ignored

PERFORM NEWPROT USING NLP_WAR NLP_LV3 NLP_MID '070'

RECORD-COMMAND SPACE SPACE SPACE.

ENDCASE.

PERFORM IMPORT_RECORD.

ENDWHILE.

ENDFORM. " IMPORT_FORMSTYL

*&----

*& Form ACTIVATE_OBJECT

*&----

text

*----

--> p1 text
<-- p2 text

*----

FORM ACTIVATE_OBJECT.

DATA: STYLE LIKE ITCDA-TDSTYLE,

FORM LIKE ITCTA-TDFORM.

ACTIVATE_OBJECT = TRUE.

CASE OBJECT.

WHEN 'STYL'. STYLE = NAME(8).

CALL FUNCTION 'ACTIVATE_STYLE'

EXPORTING STYLE = STYLE

STATUS = STATUS_SAP

IMPORTING RESULT = ITCRS.

WHEN 'FORM'. FORM = NAME(16).

CALL FUNCTION 'ACTIVATE_FORM'

EXPORTING FORM = FORM

STATUS = STATUS_SAP

IMPORTING RESULT = ITCRS.

WHEN OTHERS. EXIT.

ENDCASE.

check result of activating object...

IF ITCRS-SUBRC = 0.

ACTIVATE_OBJECT_OK = TRUE.

ELSE.

object could not be activated

PERFORM NEWPROT USING NLP_WAR NLP_LV3 NLP_MID '081'

SPACE SPACE SPACE SPACE.

pass on error message from ITCRS structure, ID is 'TD'

PERFORM NEWPROT USING NLP_INF NLP_LV3 'TD' ITCRS-MSGNO

ITCRS-MSGV1 ITCRS-MSGV2

ITCRS-MSGV3 ITCRS-MSGV4.

ACTIVATE_OBJECT_OK = FALSE.

ENDIF.

ENDFORM. " ACTIVATE_OBJECT

*&----

*& Form CHECK_FORMSTYL_FOR_IMPORT

*&----

text

*----

-->P_HEADER text *
-->P_LANGUAGE_ONLY text *
-->P_OLANG text *
-->P_LANGUAGE_VECTOR text *
-->P_TRANSTAT text *
-->P_RC text *

*----

FORM CHECK_FORMSTYL_FOR_IMPORT USING VALUE(HEADER) STRUCTURE THEAD

VALUE(LANGUAGE_ONLY)

VALUE(OLANG)

VALUE(LANGVEC)

TRANSTAT

RC.

RC = 0.

IF LANGUAGE_ONLY = TRUE.

FORT/STYT import, import only TXT parts, do NOT import anything if
object is language independent!!!
check if DEF exists

SELECT * FROM STXH WHERE TDOBJECT = HEADER-TDOBJECT

AND TDNAME = HEADER-TDNAME

AND TDID = ID_DEF.

ENDSELECT.

IF SY-DBCNT = 1. "o.k., one DEF part exists, check TDTRANSTAT

IF STXH-TDTRANSTAT = TRANSLATION_NOT_WANTED. "not language dependent

language .. not imported since object is language independent

PERFORM NEWPROT USING NLP_WAR NLP_LV3 NLP_MID '050'

HEADER-TDSPRAS SPACE SPACE SPACE.

RC = 4. EXIT.

ENDIF.

ELSE. "no or several DEF parts -> no import

language .. not imported since DEF is missing

PERFORM NEWPROT USING NLP_WAR NLP_LV2 NLP_MID '055'

HEADER-TDSPRAS SPACE SPACE SPACE.

RC = 4. EXIT.

ENDIF.

IF LANGVEC NA HEADER-TDSPRAS.

language vector prohibits translation export/import

PERFORM NEWPROT USING NLP_WAR NLP_LV3 NLP_MID '083'

HEADER-TDSPRAS SPACE SPACE SPACE.

RC = 4. EXIT.

ENDIF.

ELSE.

FORM/STYL import, import DEF and TXT parts

IF HEADER-TDID = ID_DEF. "def part contains transtat info, use it

TRANSTAT = HEADER-TDTRANSTAT.

IF TRANSTAT = TRANSLATION_NOT_WANTED.

language vector is ignored since object not for translation

PERFORM NEWPROT USING NLP_INF NLP_LV3 NLP_MID '054'

SPACE SPACE SPACE SPACE.

ENDIF.

IF TRANSTAT = TRANSLATION_NOT_WANTED. "no translation

no action, always import

ELSE. "translations wanted

IF LANGVEC NA OLANG. "DEF not in langvec

language vector prohibits OLANG export/import

PERFORM NEWPROT USING NLP_WAR NLP_LV2 NLP_MID '082'

OLANG SPACE SPACE SPACE.

RC = 8. EXIT.

ENDIF.

IF LANGVEC NA HEADER-TDSPRAS. "TXT not in langvec

language vector prohibits translation export/import

PERFORM NEWPROT USING NLP_WAR NLP_LV3 NLP_MID '083'

HEADER-TDSPRAS SPACE SPACE SPACE.

RC = 4. EXIT.

ENDIF.

ENDFORM. " CHECK_FORMSTYL_FOR_IMPORT

*&----

*& Form DELETE_OBJECT

*&----

text

*----

-->P_OBJECT_FORM text *
-->P_RECORD_DATA(16) text *

*----

FORM DELETE_OBJECT USING VALUE(OBJECT) VALUE(NAME).

DATA: FORMNAME LIKE ITCTA-TDFORM,

STYLENAME LIKE ITCDA-TDSTYLE,

FOUND.

FOUND = FALSE.

CASE OBJECT.

WHEN OBJECT_FORM.

FORMNAME = NAME.

CALL FUNCTION 'DELETE_FORM'

EXPORTING FORM = FORMNAME

LANGUAGE = '*'

IMPORTING FOUND = FOUND.

WHEN OBJECT_STYLE.

STYLENAME = NAME.

CALL FUNCTION 'DELETE_STYLE'

EXPORTING STYLE = STYLENAME

LANGUAGE = '*'

IMPORTING FOUND = FOUND.

ENDCASE.

IF FOUND = TRUE.

object ... ... was deleted

PERFORM NEWPROT USING NLP_INF NLP_LV3 NLP_MID '097'

OBJECT NAME SPACE SPACE.

ENDIF.

ENDFORM. " DELETE_OBJECT

*&----

*& Form IMPORT_HEADER

*&----

text

*----

--> p1 text
<-- p2 text

*----

FORM IMPORT_HEADER.

invalidate transport object, we are looking for a new one

CLEAR OBJECT. CLEAR NAME.

IF CLIPBOARD = TRUE.

PERFORM IMPORT_CLIPBOARD.

ELSE.

PERFORM CALL_IMPDATA USING RECORD SUBRC.

ENDIF.

IF SUBRC NE 0.

???
illegal end of transportfile
PERFORM NEWPROT USING NLP_ERR NLP_LV2 NLP_MID '078'
SPACE SPACE SPACE SPACE.

EXIT.

ENDIF.

IF RECORD-TYP NE 'H'.

SAPscript transport header (HTEXT,HSTYL, ...) was not found

PERFORM NEWPROT USING NLP_ERR NLP_LV2 NLP_MID '085'

RECORD-TYP 'H' SPACE SPACE.

EXIT.

ENDIF.

OBJECT = RECORD-COMMAND.

NAME = RECORD-DATA.

CASE OBJECT.

WHEN 'PRIN'.

WHEN 'STYL'.

WHEN 'STYT'. "style languages only

WHEN 'FORM'.

WHEN 'FORT'. "form languages only

WHEN 'TEXT'.

WHEN OTHERS.

the transport object ... is invalid

PERFORM NEWPROT USING NLP_ERR NLP_LV2 NLP_MID '077'

OBJECT SPACE SPACE SPACE.

EXIT.

ENDCASE.

object ... ... is presently at work

PERFORM NEWPROT USING NLP_INF NLP_LV2 NLP_MID '093'

OBJECT NAME SPACE SPACE.

ENDFORM. " IMPORT_HEADER

*&----

*& Form CALL_IMPDATA

*&----

text

*----

-->P_RECORD text *
-->P_SUBRC text *

*----

FORM CALL_IMPDATA USING REC RC.

PERFORM IMPDATA(RDDDIC10) USING REC RC.

IF RC <> 0.

END_OF_DATA = TRUE.

ENDIF.

ENDFORM. " CALL_IMPDATA

*&----

*& Form IMPORT_CLIPBOARD

*&----

text

*----

--> p1 text
<-- p2 text

*----

FORM IMPORT_CLIPBOARD.

STATICS: EOF.

IF BINARY_FILE_FORMAT_VALID = BINARY_FILE_FORMAT_MAGIC.

binary and compressed file

PERFORM FC_READ_RECORD USING FILENAME RECORD EOF.

IF EOF = TRUE.

SUBRC = 4.

END_OF_CLIPBOARD = TRUE.

EXIT.

ENDIF.

codepage conversion...

IF BINFILE_CODEPAGE <> SYSTEM_CODEPAGE.

TRANSLATE RECORD FROM CODE PAGE BINFILE_CODEPAGE.

ENDIF.

ELSE.

text mode file
READ DATASET FILENAME INTO RECORD.

ADD 1 TO INDICE.

READ TABLE TAB_PC INDEX INDICE INTO RECORD.

SUBRC = SY-SUBRC.

IF SUBRC NE 0.

END_OF_CLIPBOARD = TRUE.

EXIT.

ENDIF.

IF LIST_FILE_CONTENTS = 'X'.

WRITE: / RECORD.

ENDIF.

ENDFORM. " IMPORT_CLIPBOARD

*&----

*& Form IMPORT_PRIN

*&----

text

*----

--> p1 text
<-- p2 text

*----

FORM IMPORT_PRIN.

DATA: VERSION LIKE TSP0A-PVERS,

PRINTER LIKE TSP0A-PATYPE,

ALLCLIENTS LIKE SY-MANDT VALUE '* '.

refresh buffer tables

REFRESH: BUF_T022D, BUF_TSP06, BUF_TFO03, BUF_TFO04, BUF_TFO06.

PERFORM IMPORT_RECORD.

WHILE END_OF_OBJDATA = FALSE AND SUBRC = 0.

CASE RECORD-COMMAND.

print controls T022D (REPLACE ALL)

WHEN '022D'.

T022D = RECORD-DATA.
INSERT T022D. IF SY-SUBRC > 0. UPDATE T022D. ENDIF.

BUF_T022D = RECORD-DATA.

APPEND BUF_T022D.

font families TFO01 (REPLACE ONLY TRANSPORTED)

WHEN 'FO01'.

do not transport TFO01 any more B20K022408

printer fonts TFO03 (REPLACE ALL)

WHEN 'FO03'.

TFO03_LINE = RECORD-DATA.

TFO03 = TFO03_LINE-ALL.
TFO03-TDCPI = TFO03_LINE-CPI.
INSERT TFO03. IF SY-SUBRC > 0. UPDATE TFO03. ENDIF.

BUF_TFO03 = TFO03_LINE-ALL.

BUF_TFO03-TDCPI = TFO03_LINE-CPI.

APPEND BUF_TFO03.

printer font metrics TFO04 (REPLACE ALL)

WHEN 'FO04'.

TFO04 = RECORD-DATA.
INSERT TFO04. IF SY-SUBRC > 0. UPDATE TFO04. ENDIF.

BUF_TFO04 = RECORD-DATA.

APPEND BUF_TFO04.

system barcodes TFO05 (REPLACE ONLY TRANSPORTED)

WHEN 'FO05'.

do not transport TFO05 any more B20K022408

printer barcodes TFO06 (REPLACE ALL)

WHEN 'FO06'.

TFO06 = RECORD-DATA.
INSERT TFO06. IF SY-SUBRC > 0. UPDATE TFO06. ENDIF.

BUF_TFO06 = RECORD-DATA.

APPEND BUF_TFO06.

printer aufbereitung TSP06 (REPLACE ALL)

WHEN 'SP06'.

TSP06_LINE = RECORD-DATA.

TSP06 = TSP06_LINE-ALL.
TSP06-PDLFDNR = TSP06_LINE-PDLFDNR.
TSP06-PDDATALEN = TSP06_LINE-PDDATALEN.
INSERT TSP06.

BUF_TSP06 = TSP06_LINE-ALL.

BUF_TSP06-PDLFDNR = TSP06_LINE-PDLFDNR.

BUF_TSP06-PDDATALEN = TSP06_LINE-PDDATALEN.

APPEND BUF_TSP06.

spooler formats TSP1D (REPLACE ONLY TRANSPORTED)

WHEN 'SP1D'.

TSP1D = RECORD-DATA.

INSERT TSP1D. IF SY-SUBRC > 0. UPDATE TSP1D. ENDIF.

spooler format texts TSP1T (REPLACE ONLY TRANSPORTED)

WHEN 'SP1T'.

do NOT import texts any more B20K022408

printer type TSP0A (REPLACE 1 ENTRY)

WHEN 'SP0A'.

TSP0A = RECORD-DATA.

PRINTER = TSP0A-PATYPE.

increment printer version

SELECT SINGLE * FROM TSP0A WHERE PATYPE = PRINTER.

IF SY-SUBRC = 0. "printer exists, increment existing version

VERSION = TSP0A-PVERS.

IF VERSION = 99999. VERSION = 0. ENDIF.

ELSE.

VERSION = 0.

ENDIF.

TSP0A = RECORD-DATA.

TSP0A-PVERS = VERSION + 1.

the printer, font, style, form load is deleted in FORM IMPORT

INSERT TSP0A. IF SY-SUBRC > 0. UPDATE TSP0A. ENDIF.

SAPscript drivers (INSERT 1 ENTRY)

WHEN 'SP09'.

TSP09 = RECORD-DATA.

INSERT TSP09.

do nothing, if driver exists already, no update!
we do not want to change the ABAP/C flag

WHEN FUNC_DEL_PAPER.

PAPER = RECORD-DATA.

DELETE FROM TSP06 WHERE PDPTYPE = PAPER-PDPTYPE

AND PDPAPER = PAPER-PDPAPER.

WHEN FUNC_NOTHING.

nothing was imported

PERFORM NEWPROT USING NLP_WAR NLP_LV3 NLP_MID '069' "QVN

SPACE SPACE SPACE SPACE. "QVN

NOTHING = TRUE.

WHEN OTHERS.

format ... is unknown and will be ignored

PERFORM NEWPROT USING NLP_WAR NLP_LV3 NLP_MID '070' "QVN

RECORD-COMMAND SPACE SPACE SPACE. "QVN

ENDCASE.

PERFORM IMPORT_RECORD.

ENDWHILE.

update database tables from buffers

PERFORM UPDATE_PRIN_TABLES_FROM_BUFFER USING PRINTER.

delete complete load
this will take longer if a single object is imported, but saves a
lot of time if several objects are imported in a put

CALL FUNCTION 'SAPSCRIPT_DELETE_LOAD'

EXPORTING ALL = 'X'

CLIENT = ALLCLIENTS

DELETE = 'X'

WRITE = ' '.

ENDFORM. " IMPORT_PRIN

*&----

*& Form IMPORT_RECORD

*&----

text

*----

--> p1 text
<-- p2 text

*----

FORM IMPORT_RECORD.

DATA: RC LIKE SY-SUBRC.

CHECK SUBRC = 0 AND END_OF_OBJDATA = FALSE.

IF CLIPBOARD = TRUE.

PERFORM IMPORT_CLIPBOARD.

ELSE.

PERFORM CALL_IMPDATA USING RECORD SUBRC.

ENDIF.

IF SUBRC NE 0.

???
illegal end of transportfile
PERFORM NEWPROT USING NLP_ERR NLP_LV2 NLP_MID '078' "QVN
SPACE SPACE SPACE SPACE. "QVN

EXIT.

ENDIF.

IF RECORD-TYP = 'E'.

we have read our own "end marker" in the transport file

END_OF_OBJDATA = TRUE.

if this is the "official" transporter, make sure that this is the
end of the data

IF CLIPBOARD <> TRUE.

PERFORM CALL_IMPDATA USING RECORD RC.

IF RC = 0. "there is some data left...

end of transportfile was expected

PERFORM NEWPROT USING NLP_WAR NLP_LV2 NLP_MID '079' "QVN

SPACE SPACE SPACE SPACE. "QVN

ELSE.

there is no data left, that's what we expected

ENDIF.

ELSE.

no action necessary for clipboard import

ENDIF.

SUBRC = 0.

ENDFORM. " IMPORT_RECORD

*&----

*& Form IMPORT_SAPSCRIPT

*&----

text

*----

-->P_OBJECT text *
-->P_OBJ_NAME text *
-->P_RC text *

*----

FORM IMPORT_SAPSCRIPT USING OBJECT OBJ_NAME RC.

RC = 0.

PERFORM IMPORT_CLIPBOARD.

IF SUBRC NE 0.

illegal end of transportfile

PERFORM NEWPROT USING NLP_ERR NLP_LV2 NLP_MID '078'

RECORD-TYP RECORD-COMMAND SPACE SPACE.

RC = 1.

EXIT.

ENDIF.

IF RECORD-TYP NE 'S' OR RECORD-COMMAND NE OBJECT.

illegal header: ... instead of ...

PERFORM NEWPROT USING NLP_ERR NLP_LV2 NLP_MID '084'

RECORD-TYP RECORD-COMMAND 'S' OBJECT.

RC = 1.

EXIT.

ENDIF.

IF RECORD-DATA NE OBJ_NAME.

transport object ... and content of file ... differ

PERFORM NEWPROT USING NLP_ERR NLP_LV2 NLP_MID '092'

OBJ_NAME RECORD-DATA SPACE SPACE.

RC = 1.

EXIT.

ENDIF.

ENDFORM. " IMPORT_SAPSCRIPT

*&----

*& Form IMPORT_TEXT

*&----

text

*----

--> p1 text
<-- p2 text

*----

FORM IMPORT_TEXT.

DATA: RC LIKE SY-SUBRC.

PERFORM GET_LANGUAGE_VECTOR USING LANGUAGE_VECTOR.

IF SY-SUBRC <> 0. "exit if language vector cannot be read

NOTHING = TRUE. SUBRC = 4. EXIT.

ENDIF.

invalidate HEADER,LINES

CLEAR HEADER.

REFRESH LINES.

PERFORM IMPORT_RECORD.

WHILE END_OF_OBJDATA = FALSE AND SUBRC = 0.

CASE RECORD-COMMAND.

WHEN 'HEAD'.

HEADER = RECORD-DATA. REFRESH LINES.

WHEN 'LINE'.

LINES = RECORD-DATA. APPEND LINES.

WHEN 'END'.

IF LANGUAGE_VECTOR CA HEADER-TDSPRAS.

PERFORM SAVE_TEXT USING RC.

CASE RC.

WHEN 0. "SAVE_TEXT o.k.

WHEN 2. "BAD_LANGUAGE

IMPORT_OK = FALSE. "suppress 'successful import' message

WHEN OTHERS. "other ERROR

IMPORT_OK = FALSE. "should not happen

ENDCASE.

ELSE.

language vector prohibits OLANG export/import

PERFORM NEWPROT USING NLP_WAR NLP_LV2 NLP_MID '082'

HEADER-TDSPRAS SPACE SPACE SPACE.

IMPORT_OK = FALSE. "suppress 'successful import' message

ENDIF.

invalidate HEADER,LINES

CLEAR HEADER. REFRESH LINES.

WHEN FUNC_NOTHING.

nothing was imported

PERFORM NEWPROT USING NLP_WAR NLP_LV3 NLP_MID '069'

SPACE SPACE SPACE SPACE.

NOTHING = TRUE.

WHEN OTHERS.

format ... is unknown and will be ignored

PERFORM NEWPROT USING NLP_WAR NLP_LV3 NLP_MID '070'

RECORD-COMMAND SPACE SPACE SPACE.

ENDCASE.

PERFORM IMPORT_RECORD.

ENDWHILE.

ENDFORM. " IMPORT_TEXT

*&----

*& Form NAME_TO_TEXTKEY

*&----

text

*----

--> p1 text
<-- p2 text

*----

FORM NAME_TO_TEXTKEY.

ASSIGN NAME(1) TO .

NAME_POS = 1.

PERFORM TEXTKEY USING 10 TEXTLOW-TDOBJECT.

PERFORM TEXTKEY USING 70 TEXTLOW-TDNAME.

PERFORM TEXTKEY USING 4 TEXTLOW-TDID.

PERFORM TEXTKEY USING 1 TEXTLOW-TDSPRAS.

ENDFORM. " NAME_TO_TEXTKEY

*&----

*& Form NEWPROT

*&----

text

*----

-->P_NLP_INF text *
-->P_NLP_LV2 text *
-->P_NLP_MID text *
-->P_5041 text *
-->P_OBJECT text *
-->P_NAME text *
-->P_SPACE text *
-->P_SPACE text *

*----

FORM NEWPROT USING VALUE(SEVERITY) VALUE(LEVEL) VALUE(MESGID)

VALUE(NUM) VALUE(P1) VALUE(P2) VALUE(P3) VALUE(P4).

CASE SEVERITY.

WHEN NLP_ERR. ADD 1 TO COUNT_ERROR. SUBRC = 4. IMPORT_OK = FALSE.

WHEN NLP_WAR. ADD 1 TO COUNT_WARNING.

WHEN OTHERS. SEVERITY = NLP_INF.

ENDCASE.

CASE LEVEL.

WHEN NLP_LV1. "ok

WHEN NLP_LV2. "ok

WHEN NLP_LV3. "ok

WHEN OTHERS. LEVEL = NLP_LV3. "default is level 3

ENDCASE.

IF CLIPBOARD = TRUE.

transport online via RSTXR3TR

WRITE: / SPACE.

DO LEVEL TIMES.

WRITE ' '.

ENDDO.

PERFORM WRITE_MSG USING MESGID NUM P1 P2 P3 P4.

ELSE.

transport via official TRANSPORT

IF EXPORT_FLAG = TRUE.

PERFORM NEW_LOGPROT(RDDDIC00) USING LEVEL SEVERITY NLP_LAN

MESGID NUM NLP_NOB

P1 P2 P3 P4.

ELSE.

PERFORM NEW_LOGPROT(RDDDIC10) USING LEVEL SEVERITY NLP_LAN

MESGID NUM NLP_NOB

P1 P2 P3 P4.

ENDIF.

ENDFORM. " NEWPROT

*&----

*& Form SAVE_TEXT

*&----

text

*----

-->P_RC text *

*----

FORM SAVE_TEXT USING RC.

IF HEADER-TDOBJECT = OBJECT_STYLE OR

HEADER-TDOBJECT = OBJECT_FORM. "this is a style/layout set

no action

ELSE. "this is a text

IF HEADER-TDTEXTTYPE <> SPACE.

convert LINES data from ascii to binary

PERFORM CONVERT_LINES_ASCII_2_BIN.

ENDIF.

call SAVE_TEXT

CALL FUNCTION 'SAVE_TEXT'

EXPORTING HEADER = HEADER

SAVEMODE_DIRECT = 'X'

TABLES LINES = LINES

EXCEPTIONS ID = 1

LANGUAGE = 2

NAME = 3

OBJECT = 4

OTHERS = 5.

RC = SY-SUBRC.

CASE RC.

WHEN 0.

SAVE_TEXT o.k.

IF HEADER-TDOBJECT = OBJECT_FORM OR HEADER-TDOBJECT = OBJECT_STYLE.

style/layout set

CASE HEADER-TDID.

WHEN ID_DEF.

definition ... was imported

PERFORM NEWPROT USING NLP_INF NLP_LV3 NLP_MID '066'

HEADER-TDSPRAS SPACE SPACE SPACE.

WHEN ID_TXT.

IF HEADER-TDSPRAS = HEADER-TDOSPRAS.

original language ... was imported

PERFORM NEWPROT USING NLP_INF NLP_LV3 NLP_MID '065'

HEADER-TDSPRAS SPACE SPACE SPACE.

ELSE.

language ... was imported

PERFORM NEWPROT USING NLP_INF NLP_LV3 NLP_MID '067'

HEADER-TDSPRAS SPACE SPACE SPACE.

ENDIF.

ENDCASE.

ELSE.

normal text
TEXT object ..... was imported

PERFORM NEWPROT USING NLP_INF NLP_LV3 NLP_MID '087'

HEADER-TDOBJECT HEADER-TDNAME

HEADER-TDID HEADER-TDSPRAS.

ENDIF.

WHEN 2.

BAD_LANGUAGE exception

IF HEADER-TDOBJECT = OBJECT_FORM OR HEADER-TDOBJECT = OBJECT_STYLE.

style/layout set: WARNING

IF HEADER-TDSPRAS = HEADER-TDOSPRAS.

object not imported since language & does not exist

PERFORM NEWPROT USING NLP_WAR NLP_LV2 NLP_MID '095'

HEADER-TDSPRAS SPACE SPACE SPACE.

ELSE.

language & not imported since language does not exist

PERFORM NEWPROT USING NLP_WAR NLP_LV3 NLP_MID '096'

HEADER-TDSPRAS SPACE SPACE SPACE.

ENDIF.

ELSE.

normal text: WARNING
object not imported since language & does not exist

PERFORM NEWPROT USING NLP_WAR NLP_LV3 NLP_MID '095'

HEADER-TDSPRAS SPACE SPACE SPACE.

ENDIF.

WHEN OTHERS.

get sapscript's error message number+parameters into ITCRS

CALL FUNCTION 'SAPSCRIPT_MESSAGE_GET_NO'

IMPORTING NO = ITCRS-MSGNO

V1 = ITCRS-MSGV1

V2 = ITCRS-MSGV2

V3 = ITCRS-MSGV3

V4 = ITCRS-MSGV4.

SAVE_TEXT(...) failed

PERFORM NEWPROT USING NLP_ERR NLP_LV2 NLP_MID '068'

HEADER-TDOBJECT HEADER-TDNAME

HEADER-TDID HEADER-TDSPRAS.

pass on error message from SAVE_TEXT

PERFORM NEWPROT USING NLP_INF NLP_LV2 NLP_MID ITCRS-MSGNO

ITCRS-MSGV1 ITCRS-MSGV2

ITCRS-MSGV3 ITCRS-MSGV4.

ENDCASE.

ENDFORM. " SAVE_TEXT

*&----

*& Form CONVERT_LINES_ASCII_2_BIN

*&----

text

*----

--> p1 text
<-- p2 text

*----

FORM CONVERT_LINES_ASCII_2_BIN.

DATA BEGIN OF L OCCURS 100.

INCLUDE STRUCTURE TLINE.

DATA END OF L.

FIELD-SYMBOLS

DATA L_OFFS TYPE I.

REFRESH L.

L_OFFS = 0.

LOOP AT LINES.

IF L_OFFS = 0. "begin of a L-line

CLEAR L.

convert l-format

PERFORM CONV_HEX_2_BIN USING LINES-TDFORMAT L-TDFORMAT(1).

PERFORM CONV_HEX_2_BIN USING LINES-TDLINE(2) L-TDFORMAT+1(1).

SHIFT LINES-TDLINE BY 2 PLACES.

convert l-line(1..65)

ASSIGN L-TDLINE(1) TO

.
DO 65 TIMES.
PERFORM CONV_HEX_2_BIN USING LINES-TDLINE(2)

.
SHIFT LINES-TDLINE BY 2 PLACES.
ASSIGN

+1(1) TO

.
ENDDO.
L_OFFS = 65.
ELSE. "middle of a l-line
ASSIGN L-TDLINE+65(1) TO

convert LINES-TDFORMAT

PERFORM CONV_HEX_2_BIN USING LINES-TDFORMAT

convert LINES-TDLINE

DO 66 TIMES.

ASSIGN

+1(1) TO

.
PERFORM CONV_HEX_2_BIN USING LINES-TDLINE(2)

SHIFT LINES-TDLINE BY 2 PLACES.

ENDDO.

APPEND L.

L_OFFS = 0.

ENDIF.

ENDLOOP.

REFRESH LINES.

LOOP AT L.

LINES = L. APPEND LINES.

ENDLOOP.

FREE L.

ENDFORM. " CONVERT_LINES_ASCII_2_BIN

*&----

*& Form SET_BINARY_FILE_FORMAT

*&----

text

*----

-->P_TRUE text *

*----

FORM SET_BINARY_FILE_FORMAT USING VALUE(BINFILE_FLAG).

STATICS: CP_C4(4),

APPL_SYSCP LIKE TCP00-CPCODEPAGE.

IF BINFILE_FLAG = TRUE.

CALL FUNCTION 'SYSTEM_CODEPAGE'

IMPORTING

CODEPAGE = APPL_SYSCP.

CALL 'CUR_LCL' ID 'CODEPAGE' FIELD CP_C4. "B30K010965

SYSTEM_CODEPAGE = CP_C4.

IF APPL_SYSCP <> SYSTEM_CODEPAGE.

PERFORM NEWPROT USING NLP_INF NLP_LV3 NLP_MID '048'

SYSTEM_CODEPAGE APPL_SYSCP SPACE SPACE.

ENDIF.

BINFILE_CODEPAGE = '0000'.

BINARY_FILE_FORMAT_VALID = BINARY_FILE_FORMAT_MAGIC.

ELSE.

BINARY_FILE_FORMAT_VALID = SPACE.

ENDIF.

ENDFORM. " SET_BINARY_FILE_FORMAT

*&----

*& Form SET_CUSTOM_LANGUAGE_VECTOR

*&----

text

*----

-->P_LANG_VEC text *

*----

FORM SET_CUSTOM_LANGUAGE_VECTOR USING VALUE(LANGVEC).

STATICS: LEN LIKE SY-FDPOS.

IF LANGVEC = SPACE.

CUSTOM_LANGUAGE_VECTOR_VALID = SPACE. "invalidate custom langvec

ELSE.

CONDENSE LANGVEC NO-GAPS. "no blanks in langvec

CUSTOM_LANGUAGE_VECTOR = LANGVEC.

CUSTOM_LANGUAGE_VECTOR_VALID = CUSTOM_LANGUAGE_VECTOR_MAGIC.

LEN = STRLEN( CUSTOM_LANGUAGE_VECTOR ).

IF LEN = 1.

SET LOCALE LANGUAGE CUSTOM_LANGUAGE_VECTOR(1). "B30K011012

ENDIF.

ENDFORM. " SET_CUSTOM_LANGUAGE_VECTOR

*&----

*& Form SET_OLANGUAGE

*&----

text

*----

-->P_OBJECT_TYPE text *
-->P_OLANG text *
-->P_LANGUAGE_VECTOR text *

*----

FORM SET_OLANGUAGE USING VALUE(OBJECT) VALUE(OLANG) VALUE(LANGVEC).

DATA: TDNAME LIKE THEAD-TDNAME,

TDOBJECT LIKE THEAD-TDOBJECT,

TDOLANG LIKE THEAD-TDSPRAS.

CASE OBJECT.

WHEN OBJECT_STYLE. TDOBJECT = OBJECT_STYLE. TDNAME = NAME(8).

WHEN OBJECT_FORM. TDOBJECT = OBJECT_FORM. TDNAME = NAME(16).

WHEN OTHERS. EXIT.

ENDCASE.

TDOLANG = OLANG.

IF LANGVEC CA TDOLANG. "if OLANG in langvec...

CALL FUNCTION 'SAPSCRIPT_CHANGE_OLANGUAGE'

EXPORTING FORCED = TRUE

OBJECT = TDOBJECT

NAME = TDNAME

OLANGUAGE = TDOLANG

EXCEPTIONS OTHERS = 1.

IF SY-SUBRC = 0.

original language was changed to ...

PERFORM NEWPROT USING NLP_INF NLP_LV3 NLP_MID '053'

TDOLANG SPACE SPACE SPACE.

ENDIF.

ENDFORM. " SET_OLANGUAGE

*&----

*& Form SKIP_UNREAD_RECORDS

*&----

text

*----

--> p1 text
<-- p2 text

*----

FORM SKIP_UNREAD_RECORDS.

DATA: COUNT LIKE SY-INDEX.

IF CLIPBOARD <> TRUE.

COUNT = 0.

WHILE END_OF_DATA = FALSE AND COUNT < 9000.

PERFORM IMPDATA(RDDDIC10) USING RECORD RC.

PERFORM CALL_IMPDATA USING RECORD RC. "QVN B20K005546

ADD 1 TO COUNT.

ENDWHILE.

ELSE.

no action necessary for CLIPBOARD import

ENDIF.

ENDFORM. " SKIP_UNREAD_RECORDS

*&----

*& Form TEXTKEY

*&----

text

*----

-->P_10 text *
-->P_TEXTLOW_TDOBJECT text *

*----

FORM TEXTKEY USING VALUE(LEN) LOW.

DATA N LIKE NAME.

FIELD-SYMBOLS . ADD 1 TO NAME_POS.

ENDIF.

LOW = N.

ENDFORM. " TEXTKEY

*&----

*& Form UPDATE_PRIN_TABLES_FROM_BUFFER

*&----

text

*----

-->P_PRINTER text *

*----

FORM UPDATE_PRIN_TABLES_FROM_BUFFER USING VALUE(PRINTER).

I use abap's array insert. this will give a runtime-error if any
record exists already in the db table. so I better make sure
that the keys for delete and insert match!

DELETE FROM T022D WHERE TYP = PRINTER.

LOOP AT BUF_T022D. "avoid runtime-error from ARRAY INSERT

BUF_T022D-TYP = PRINTER. MODIFY BUF_T022D.

ENDLOOP.

INSERT T022D FROM TABLE BUF_T022D.

DELETE FROM TFO03 WHERE TDPRINTER = PRINTER.

LOOP AT BUF_TFO03. "avoid runtime-error from ARRAY INSERT

BUF_TFO03-TDPRINTER = PRINTER. MODIFY BUF_TFO03.

ENDLOOP.

INSERT TFO03 FROM TABLE BUF_TFO03.

DELETE FROM TFO04 WHERE TDPRINTER = PRINTER.

LOOP AT BUF_TFO04. "avoid runtime-error from ARRAY INSERT

BUF_TFO04-TDPRINTER = PRINTER. MODIFY BUF_TFO04.

ENDLOOP.

INSERT TFO04 FROM TABLE BUF_TFO04.

DELETE FROM TFO06 WHERE TDPRINTER = PRINTER.

LOOP AT BUF_TFO06. "avoid runtime-error from ARRAY INSERT

BUF_TFO06-TDPRINTER = PRINTER. MODIFY BUF_TFO06.

ENDLOOP.

INSERT TFO06 FROM TABLE BUF_TFO06.

DELETE FROM TSP06 WHERE PDPTYPE = PRINTER.

LOOP AT BUF_TSP06. "avoid runtime-error from ARRAY INSERT

BUF_TSP06-PDPTYPE = PRINTER. MODIFY BUF_TSP06.

ENDLOOP.

INSERT TSP06 FROM TABLE BUF_TSP06.

ENDFORM. " UPDATE_PRIN_TABLES_FROM_BUFFER

*&----

*& Form WRITE_MSG

*&----

text

*----

-->P_MESGID text *
-->P_NUM text *
-->P_P1 text *
-->P_P2 text *
-->P_P3 text *
-->P_P4 text *

*----

FORM WRITE_MSG USING VALUE(ABG) VALUE(NUM)

VALUE(P1) VALUE(P2) VALUE(P3) VALUE(P4).

DATA LN(250) TYPE C.

SELECT SINGLE * FROM T100 WHERE SPRSL = SY-LANGU

AND ARBGB = ABG

AND MSGNR = NUM.

IF SY-SUBRC = 0.

message exists

LN = T100-TEXT.

REPLACE '&' WITH P1 INTO LN. CONDENSE LN.

REPLACE '&' WITH P2 INTO LN. CONDENSE LN.

REPLACE '&' WITH P3 INTO LN. CONDENSE LN.

REPLACE '&' WITH P4 INTO LN. CONDENSE LN.

WRITE LN(120).

ELSE.

message not found, write info message

LN = 'Die Nachricht & Nummer & Sprache & ist nicht gepflegt'.

REPLACE '&' WITH ABG INTO LN. CONDENSE LN.

REPLACE '&' WITH NUM INTO LN. CONDENSE LN.

REPLACE '&' WITH SY-LANGU INTO LN. CONDENSE LN.

WRITE LN(120).

ENDIF.

ENDFORM. " WRITE_MSG

Message was edited by: Alexandre Nogueira

topic save/download program to client-pc in Application Development and Automation Discussions

save/download program to client-pc

Re: save/download program to client-pc

Re: save/download program to client-pc

Re: save/download program to client-pc

Re: save/download program to client-pc