昨天在google收索到了批量下载程序和表定义的文章,感觉这些小工具挺好用的。但是在日常的业务中sap script form也是经常要用到和备份的。虽然sap 提供了一个下载的功能,但是一次只能下载一个。于是受到启发,决定做一个可以批量下载的程序。
步骤:
1、使用SE38将附件中的程序上传到SAP系统中,开发类选择$TMP即可。
2、执行程序 ZSAPSCRIPFORMEXP,然后根据条件输入参数。点击执行(或者按F8)
部分参数说明:
P_DIR为输出目录
DEVCLASS为form的开发类
OBJ表示对象名称
文件上传好像有点问题,直接贴代码了。
ZRSTXR3TR.txt
*
* R3TR R3-Transport Utilities SAPscript ADO objects
*
* QVN B20K004565 - adapted to new protocol interface NEW_LOGPROT...
* QVN B20K005515 - skip records only at ERROR
* QVN B20K005546 - skip records only if not already at end of object...
* QVN B20K005854 - increase performance with PRIN, use array insert...
*
* QCJ B20K006933 - load of PRIN is deleted for all clients
* load of FORM, STYLE is deleted by activation
* QVN B20K008770 - use SAVEMODE_DIRECT = X for Verbuchungstexte
* B20K009048 allow to override the default filename
* /usr/sap/trans/clipboard/RSTXR3TR.sy-uname
* B20K011772 - no error but warning when import fails since language
* of object does not exist in target system
* QVN B20K014424 - do NOT ignore leading blanks in name,obj,id in
* R3TR TEXT obj,name,id,s
* Allow max.length of text name to be 70 characters
* instead of 50.
* QVN B20K015825 - make sure that for layout sets/styles only text IDs
* DEF and TXT are transported
* QVN B20K016101 Allow max.length of text key to be 88 characters:
* R3TR TEXT object,name,id,l
* where len(object) <= 10
* len(name) <= 70
* len(id) <= 4
* len(l) = 1
* QVN B20K018550 Increase maximum record length from 255 to 370
* QVN B20K022408 do not transport short texts TSP1T
* do not transport font families TFO01
* do not transport system barcodes TFO05
* QVN B20K022630 if TRANSTAT=1, no export of styl/form translations
* and import deletes form/style translations
* QVN B20K025470 prepare LANGUAGE VECTOR control and FORT/STYT
* TRANSPORT OBJECTS FOR LANGUAGE TRANSPORT
* prevent EXPORT of non-SAPscript texts (i.e. word)
* transport ALL translations of FORM/STYL,ignore
* TDTRANSTAT
* QVN B20K025858 activate LANGUAGE VECTOR control on FORM/STYL/TEXT
* export/import
* allow for FORT/STYT objects
* QVN B20K026137 add LANGVEC as report parameter
* QVN B20K026627 allow FORT/STYT in direct RSTXR3TR call
* QVN B20K026700 ignore LANGVEC when layout set/style has attribute
* TRANSLATION_NOT_WANTED
* QVN B20K027316 allow transport of non-sapscript texs using hex
* conversion (TDTEXTTYPE)
* QVN B20K030020 correct FORT/STYT error, could not import these
* QVN B20K030170 make dummy export (EXPORT_NOTHING) for TEXT/STYx/FORx
* when language vector prohibits export
* QVN B20K032381 inform spooler after uploading PRIN with RSTXSCRP
* QVN B20K037787 use SELECT_TEXT to get generic text entries
* QVN B20K040519 R3TR FORT,R3TR STYT: prevent export and import of
* any language if TDTRANSTAT=1
* QVN B20K043010 - add binary file format and codepage conversion
* option
* increase record length from 370 to 512
* QVN B20K046925 TDTRANSTAT=1 -> export TXT part only in OSPRAS
* QVN B20K047847 RSTXSCRP: add binary file format
* QVN B20K049141 Replace SYSTEM_CODEPAGE with current codepage
* QVN B20K049191 SET LOCALE LANGUAGE for LANGVEC with single language
* so syscp will be correct for language export/import
* QVN B20K051883 hardcoded translate codepage for AS/400 lang imp
* QVN B20K053928 allow GUI file upload/download
* QVN B20K055867 add no-display parameter EXTPROT
* QVN B20K057010 allow deleting device types if deleted in source
* QVN B20K057147 new export routinge EXPORT_31 for masterlang only
* FORM/STYL: check against langvec during export
* only when MASTERLANG_ONLY mode
* QVN B20K060611 TSP1D import: only INSERT, no UPDATE->new fields
* QVN B20K061027 new selection screen
* QVN B20K061850 new spool table TSP06A for aggregated device formats
* QVN B20K064895 don't export/import DPAP cmd (don't delete TSP1D)
* B20K065126 output T100 messages in initial SY-LANGU
* B20K067651 use RSPO_PTYPE_FLUSH to inform spool of devtype import
* B20K068290 use msg 085 instead of 084
* B20K070087 use TR_READ_COMM to get objects from transport request
* B20K086195 new fields in TSP1D, TSP0A, TSP06A
* B20K089520 binary file format for GUI-upload/download
* B20K8A03QU dataset like rlgrap-filename " length 128
* B20K8A0IS4 replace DOWNLOAD/UPLOAD by GUI_DOWNLOAD/UPLOAD
* B20K8A0JDO bad param type for TRANSLATE_FROM(..)
*
REPORT ZRSTXR3TR LINE-SIZE 132 NO STANDARD PAGE HEADING MESSAGE-ID TD.
INCLUDE RSTXDATA.
* R3TR R3-Transport Utilities SAPscript ADO objects
*
* QVN B20K004565 - adapted to new protocol interface NEW_LOGPROT...
* QVN B20K005515 - skip records only at ERROR
* QVN B20K005546 - skip records only if not already at end of object...
* QVN B20K005854 - increase performance with PRIN, use array insert...
*
* QCJ B20K006933 - load of PRIN is deleted for all clients
* load of FORM, STYLE is deleted by activation
* QVN B20K008770 - use SAVEMODE_DIRECT = X for Verbuchungstexte
* B20K009048 allow to override the default filename
* /usr/sap/trans/clipboard/RSTXR3TR.sy-uname
* B20K011772 - no error but warning when import fails since language
* of object does not exist in target system
* QVN B20K014424 - do NOT ignore leading blanks in name,obj,id in
* R3TR TEXT obj,name,id,s
* Allow max.length of text name to be 70 characters
* instead of 50.
* QVN B20K015825 - make sure that for layout sets/styles only text IDs
* DEF and TXT are transported
* QVN B20K016101 Allow max.length of text key to be 88 characters:
* R3TR TEXT object,name,id,l
* where len(object) <= 10
* len(name) <= 70
* len(id) <= 4
* len(l) = 1
* QVN B20K018550 Increase maximum record length from 255 to 370
* QVN B20K022408 do not transport short texts TSP1T
* do not transport font families TFO01
* do not transport system barcodes TFO05
* QVN B20K022630 if TRANSTAT=1, no export of styl/form translations
* and import deletes form/style translations
* QVN B20K025470 prepare LANGUAGE VECTOR control and FORT/STYT
* TRANSPORT OBJECTS FOR LANGUAGE TRANSPORT
* prevent EXPORT of non-SAPscript texts (i.e. word)
* transport ALL translations of FORM/STYL,ignore
* TDTRANSTAT
* QVN B20K025858 activate LANGUAGE VECTOR control on FORM/STYL/TEXT
* export/import
* allow for FORT/STYT objects
* QVN B20K026137 add LANGVEC as report parameter
* QVN B20K026627 allow FORT/STYT in direct RSTXR3TR call
* QVN B20K026700 ignore LANGVEC when layout set/style has attribute
* TRANSLATION_NOT_WANTED
* QVN B20K027316 allow transport of non-sapscript texs using hex
* conversion (TDTEXTTYPE)
* QVN B20K030020 correct FORT/STYT error, could not import these
* QVN B20K030170 make dummy export (EXPORT_NOTHING) for TEXT/STYx/FORx
* when language vector prohibits export
* QVN B20K032381 inform spooler after uploading PRIN with RSTXSCRP
* QVN B20K037787 use SELECT_TEXT to get generic text entries
* QVN B20K040519 R3TR FORT,R3TR STYT: prevent export and import of
* any language if TDTRANSTAT=1
* QVN B20K043010 - add binary file format and codepage conversion
* option
* increase record length from 370 to 512
* QVN B20K046925 TDTRANSTAT=1 -> export TXT part only in OSPRAS
* QVN B20K047847 RSTXSCRP: add binary file format
* QVN B20K049141 Replace SYSTEM_CODEPAGE with current codepage
* QVN B20K049191 SET LOCALE LANGUAGE for LANGVEC with single language
* so syscp will be correct for language export/import
* QVN B20K051883 hardcoded translate codepage for AS/400 lang imp
* QVN B20K053928 allow GUI file upload/download
* QVN B20K055867 add no-display parameter EXTPROT
* QVN B20K057010 allow deleting device types if deleted in source
* QVN B20K057147 new export routinge EXPORT_31 for masterlang only
* FORM/STYL: check against langvec during export
* only when MASTERLANG_ONLY mode
* QVN B20K060611 TSP1D import: only INSERT, no UPDATE->new fields
* QVN B20K061027 new selection screen
* QVN B20K061850 new spool table TSP06A for aggregated device formats
* QVN B20K064895 don't export/import DPAP cmd (don't delete TSP1D)
* B20K065126 output T100 messages in initial SY-LANGU
* B20K067651 use RSPO_PTYPE_FLUSH to inform spool of devtype import
* B20K068290 use msg 085 instead of 084
* B20K070087 use TR_READ_COMM to get objects from transport request
* B20K086195 new fields in TSP1D, TSP0A, TSP06A
* B20K089520 binary file format for GUI-upload/download
* B20K8A03QU dataset like rlgrap-filename " length 128
* B20K8A0IS4 replace DOWNLOAD/UPLOAD by GUI_DOWNLOAD/UPLOAD
* B20K8A0JDO bad param type for TRANSLATE_FROM(..)
*
REPORT ZRSTXR3TR LINE-SIZE 132 NO STANDARD PAGE HEADING MESSAGE-ID TD.
INCLUDE RSTXDATA.
TABLES:
DDERR, STXH,
ITCRS, T100,
TFO03, TFO04, TSP06, TSP1D, TSP06A,
TSP0A, TSP09, T022D, TFO06, TCP00.
DDERR, STXH,
ITCRS, T100,
TFO03, TFO04, TSP06, TSP1D, TSP06A,
TSP0A, TSP09, T022D, TFO06, TCP00.
DATA E071_TAB LIKE E071 OCCURS 100 WITH HEADER LINE. "B20K070087
DATA: DUMMY(80).
DUMMY = 'Auftragsselektion und Modussteuerung'(021).
SELECTION-SCREEN BEGIN OF BLOCK PAR_OBJ WITH FRAME TITLE TEXT-021.
PARAMETERS:
TRKORR LIKE E071-TRKORR,
MODE(6) DEFAULT 'EXPORT'.
SELECTION-SCREEN END OF BLOCK PAR_OBJ.
DUMMY = 'Steuerparameter f黵 Datei-Operation'(022).
SELECTION-SCREEN BEGIN OF BLOCK PAR_FIL WITH FRAME TITLE TEXT-022.
PARAMETERS:
SERVFIL RADIOBUTTON GROUP FSRC DEFAULT 'X',
LOCALFIL RADIOBUTTON GROUP FSRC,
DATASET LIKE RLGRAP-FILENAME DEFAULT 'c:/temp/RSTXR3TR.****',
BINFILE AS CHECKBOX DEFAULT SPACE, " if =X, binary format
LISTFILE AS CHECKBOX DEFAULT SPACE. "if =X, list dataset lines
SELECTION-SCREEN END OF BLOCK PAR_FIL.
DUMMY = 'Kontrolle 黚er Sprachversionen'(023).
SELECTION-SCREEN BEGIN OF BLOCK PAR_LAN WITH FRAME TITLE TEXT-023.
PARAMETERS:
PLANGVEC(60) DEFAULT SPACE, "custom language vector
MASTLANG AS CHECKBOX DEFAULT SPACE. "if =X, export masterlang only
SELECTION-SCREEN END OF BLOCK PAR_LAN.
* "B20K055867
PARAMETERS:
EXTPROT(1) DEFAULT SPACE NO-DISPLAY. "use external protocol interf.?
DUMMY = 'Auftragsselektion und Modussteuerung'(021).
SELECTION-SCREEN BEGIN OF BLOCK PAR_OBJ WITH FRAME TITLE TEXT-021.
PARAMETERS:
TRKORR LIKE E071-TRKORR,
MODE(6) DEFAULT 'EXPORT'.
SELECTION-SCREEN END OF BLOCK PAR_OBJ.
DUMMY = 'Steuerparameter f黵 Datei-Operation'(022).
SELECTION-SCREEN BEGIN OF BLOCK PAR_FIL WITH FRAME TITLE TEXT-022.
PARAMETERS:
SERVFIL RADIOBUTTON GROUP FSRC DEFAULT 'X',
LOCALFIL RADIOBUTTON GROUP FSRC,
DATASET LIKE RLGRAP-FILENAME DEFAULT 'c:/temp/RSTXR3TR.****',
BINFILE AS CHECKBOX DEFAULT SPACE, " if =X, binary format
LISTFILE AS CHECKBOX DEFAULT SPACE. "if =X, list dataset lines
SELECTION-SCREEN END OF BLOCK PAR_FIL.
DUMMY = 'Kontrolle 黚er Sprachversionen'(023).
SELECTION-SCREEN BEGIN OF BLOCK PAR_LAN WITH FRAME TITLE TEXT-023.
PARAMETERS:
PLANGVEC(60) DEFAULT SPACE, "custom language vector
MASTLANG AS CHECKBOX DEFAULT SPACE. "if =X, export masterlang only
SELECTION-SCREEN END OF BLOCK PAR_LAN.
* "B20K055867
PARAMETERS:
EXTPROT(1) DEFAULT SPACE NO-DISPLAY. "use external protocol interf.?
DATA BEGIN OF HEADER.
INCLUDE STRUCTURE THEAD.
DATA END OF HEADER.
INCLUDE STRUCTURE THEAD.
DATA END OF HEADER.
DATA BEGIN OF HEADER_TAB OCCURS 20.
INCLUDE STRUCTURE THEAD.
DATA END OF HEADER_TAB.
INCLUDE STRUCTURE THEAD.
DATA END OF HEADER_TAB.
DATA BEGIN OF HEADER_DEF.
INCLUDE STRUCTURE THEAD.
DATA END OF HEADER_DEF.
INCLUDE STRUCTURE THEAD.
DATA END OF HEADER_DEF.
DATA BEGIN OF LINES OCCURS 50.
INCLUDE STRUCTURE TLINE.
DATA END OF LINES.
INCLUDE STRUCTURE TLINE.
DATA END OF LINES.
DATA:BEGIN OF TFO03_LINE,
CPI(10),
ALL(240),
END OF TFO03_LINE.
CPI(10),
ALL(240),
END OF TFO03_LINE.
DATA:BEGIN OF TSP1DX_LINE, "SP1X holds new info from TSP1D
PAPART LIKE TSP1D-PAPART,
LISTAREA LIKE TSP1D-LISTAREA,
MRG_TOP(6) TYPE N,
MRG_LEFT(6) TYPE N,
MRG_BOT(6) TYPE N,
MRG_RIGHT(6) TYPE N,
END OF TSP1DX_LINE.
PAPART LIKE TSP1D-PAPART,
LISTAREA LIKE TSP1D-LISTAREA,
MRG_TOP(6) TYPE N,
MRG_LEFT(6) TYPE N,
MRG_BOT(6) TYPE N,
MRG_RIGHT(6) TYPE N,
END OF TSP1DX_LINE.
DATA:BEGIN OF TSP06_LINE,
PDLFDNR(3) TYPE N,
PDDATALEN(3) TYPE N,
ALL(240),
END OF TSP06_LINE.
PDLFDNR(3) TYPE N,
PDDATALEN(3) TYPE N,
ALL(240),
END OF TSP06_LINE.
DATA:BEGIN OF TSP06A_LINE, "SP6A holds old info from TSP06A
PTYPE LIKE TSP06A-PTYPE,
PAPER LIKE TSP06A-PAPER,
base like tsp06a-base,
version like tsp06a-version,
convflag like tsp06a-convflag,
convcodep like tsp06a-convcodep,
postflag like tsp06a-postflag,
listdriver like tsp06a-listdriver,
extension like tsp06a-extension,
chgname1 like tsp06a-chgname1,
chgtstmp1 like tsp06a-chgtstmp1,
chgsaprel1 like tsp06a-chgsaprel1,
chgsapsys1 like tsp06a-chgsapsys1,
chgname2 like tsp06a-chgname2,
chgtstmp2 like tsp06a-chgtstmp2,
chgsaprel2 like tsp06a-chgsaprel2,
chgsapsys2 like tsp06a-chgsapsys2,
chgname3 like tsp06a-chgname3,
chgtstmp3 like tsp06a-chgtstmp3,
chgsaprel3 like tsp06a-chgsaprel3,
chgsapsys3 like tsp06a-chgsapsys3,
END OF TSP06A_LINE.
PTYPE LIKE TSP06A-PTYPE,
PAPER LIKE TSP06A-PAPER,
base like tsp06a-base,
version like tsp06a-version,
convflag like tsp06a-convflag,
convcodep like tsp06a-convcodep,
postflag like tsp06a-postflag,
listdriver like tsp06a-listdriver,
extension like tsp06a-extension,
chgname1 like tsp06a-chgname1,
chgtstmp1 like tsp06a-chgtstmp1,
chgsaprel1 like tsp06a-chgsaprel1,
chgsapsys1 like tsp06a-chgsapsys1,
chgname2 like tsp06a-chgname2,
chgtstmp2 like tsp06a-chgtstmp2,
chgsaprel2 like tsp06a-chgsaprel2,
chgsapsys2 like tsp06a-chgsapsys2,
chgname3 like tsp06a-chgname3,
chgtstmp3 like tsp06a-chgtstmp3,
chgsaprel3 like tsp06a-chgsaprel3,
chgsapsys3 like tsp06a-chgsapsys3,
END OF TSP06A_LINE.
DATA:BEGIN OF TSP06AX_LINE, "SP6X holds new info from TSP06A
PTYPE LIKE TSP06A-PTYPE,
PAPER LIKE TSP06A-PAPER,
LSTDRIVER LIKE TSP06A-LSTDRIVER,
LSTSUBTYPE LIKE TSP06A-LSTSUBTYPE,
DRIVERINFO LIKE TSP06A-DRIVERINFO,
SPACEMODE LIKE TSP06A-SPACEMODE,
CHARWIDTH(5) TYPE N,
FONTSIZE LIKE TSP06A-FONTSIZE,
END OF TSP06AX_LINE.
PTYPE LIKE TSP06A-PTYPE,
PAPER LIKE TSP06A-PAPER,
LSTDRIVER LIKE TSP06A-LSTDRIVER,
LSTSUBTYPE LIKE TSP06A-LSTSUBTYPE,
DRIVERINFO LIKE TSP06A-DRIVERINFO,
SPACEMODE LIKE TSP06A-SPACEMODE,
CHARWIDTH(5) TYPE N,
FONTSIZE LIKE TSP06A-FONTSIZE,
END OF TSP06AX_LINE.
DATA:BEGIN OF TSP1D_LINE,
papart LIKE TSP1d-papart,
pformat like tsp1d-pformat,
orient like tsp1d-orient,
type like tsp1d-type,
outcolumns like tsp1d-outcolumns,
outrows like tsp1d-outrows,
chgname1 like tsp1d-chgname1,
chgtstmp1 like tsp1d-chgtstmp1,
chgsaprel1 like tsp1d-chgsaprel1,
chgsapsys1 like tsp1d-chgsapsys1,
chgname2 like tsp1d-chgname2,
chgtstmp2 like tsp1d-chgtstmp2,
chgsaprel2 like tsp1d-chgsaprel2,
chgsapsys2 like tsp1d-chgsapsys2,
chgname3 like tsp1d-chgname3,
chgtstmp3 like tsp1d-chgtstmp3,
chgsaprel3 like tsp1d-chgsaprel3,
chgsapsys3 like tsp1d-chgsapsys3,
END OF TSP1D_LINE.
papart LIKE TSP1d-papart,
pformat like tsp1d-pformat,
orient like tsp1d-orient,
type like tsp1d-type,
outcolumns like tsp1d-outcolumns,
outrows like tsp1d-outrows,
chgname1 like tsp1d-chgname1,
chgtstmp1 like tsp1d-chgtstmp1,
chgsaprel1 like tsp1d-chgsaprel1,
chgsapsys1 like tsp1d-chgsapsys1,
chgname2 like tsp1d-chgname2,
chgtstmp2 like tsp1d-chgtstmp2,
chgsaprel2 like tsp1d-chgsaprel2,
chgsapsys2 like tsp1d-chgsapsys2,
chgname3 like tsp1d-chgname3,
chgtstmp3 like tsp1d-chgtstmp3,
chgsaprel3 like tsp1d-chgsaprel3,
chgsapsys3 like tsp1d-chgsapsys3,
END OF TSP1D_LINE.
* internal tables for T022D, TSP06, TSP06A, TFO03, TFO04, TFO06
DATA BUF_T022D LIKE T022D OCCURS 50 WITH HEADER LINE.
DATA BUF_TSP06 LIKE TSP06 OCCURS 200 WITH HEADER LINE.
DATA BUF_TSP06A LIKE TSP06A OCCURS 200 WITH HEADER LINE.
DATA BUF_TFO03 LIKE TFO03 OCCURS 20 WITH HEADER LINE.
DATA BUF_TFO04 LIKE TFO04 OCCURS 1000 WITH HEADER LINE.
DATA BUF_TFO06 LIKE TFO06 OCCURS 10 WITH HEADER LINE.
DATA BUF_TSP1D LIKE TSP1D OCCURS 10 WITH HEADER LINE.
DATA BUF_T022D LIKE T022D OCCURS 50 WITH HEADER LINE.
DATA BUF_TSP06 LIKE TSP06 OCCURS 200 WITH HEADER LINE.
DATA BUF_TSP06A LIKE TSP06A OCCURS 200 WITH HEADER LINE.
DATA BUF_TFO03 LIKE TFO03 OCCURS 20 WITH HEADER LINE.
DATA BUF_TFO04 LIKE TFO04 OCCURS 1000 WITH HEADER LINE.
DATA BUF_TFO06 LIKE TFO06 OCCURS 10 WITH HEADER LINE.
DATA BUF_TSP1D LIKE TSP1D OCCURS 10 WITH HEADER LINE.
FIELD-SYMBOLS: <NAME>.
DATA:
BEGIN OF TEXTLOW,
TDOBJECT LIKE THEAD-TDOBJECT,
TDNAME LIKE THEAD-TDNAME,
TDID LIKE THEAD-TDID,
TDSPRAS LIKE THEAD-TDSPRAS,
END OF TEXTLOW,
BEGIN OF TEXTLOW,
TDOBJECT LIKE THEAD-TDOBJECT,
TDNAME LIKE THEAD-TDNAME,
TDID LIKE THEAD-TDID,
TDSPRAS LIKE THEAD-TDSPRAS,
END OF TEXTLOW,
**filename(60),
FILENAME LIKE RLGRAP-FILENAME,
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
FUNC_DEL_PRIN(4) VALUE 'DPRI', "B20K057010
CLIPBOARD LIKE BOOLEAN,
EXPORT_FLAG LIKE BOOLEAN,
SUBRC LIKE SY-SUBRC,
BEGIN OF RECORD OCCURS 0,
TYP(1),
COMMAND(4),
DATA(507), "B20K043010
END OF RECORD,
record_nostruct(512).
FILENAME LIKE RLGRAP-FILENAME,
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
FUNC_DEL_PRIN(4) VALUE 'DPRI', "B20K057010
CLIPBOARD LIKE BOOLEAN,
EXPORT_FLAG LIKE BOOLEAN,
SUBRC LIKE SY-SUBRC,
BEGIN OF RECORD OCCURS 0,
TYP(1),
COMMAND(4),
DATA(507), "B20K043010
END OF RECORD,
record_nostruct(512).
CONSTANTS: C_RECORD_NUMCHARS TYPE I VALUE 512.
* infos for UNICODE, binary file handling
DATA:
RECORD_NUMBYTES TYPE I,
R3_INTERNAL_CHARSET(1).
CONSTANTS: C_CHARSET_ASCII VALUE 'A',
C_CHARSET_EBCDIC VALUE 'E',
C_CHARSET_UNICODE VALUE 'U'.
* GUI file table
DATA: BEGIN OF GUI_FILE_TEXT OCCURS 0,
L(512) TYPE C, "number of bytes must fit one CHAR RECORD
END OF GUI_FILE_TEXT.
DATA: GUI_FILE_TEXT_CUR_LINE_INDEX LIKE SY-TABIX.
DATA: BEGIN OF GUI_FILE_BIN OCCURS 0,
L(512) TYPE X,
END OF GUI_FILE_BIN.
DATA: GUI_FILE_BIN_CUR_LINE_INDEX LIKE SY-TABIX,
GUI_FILE_BIN_CUR_LINEOFS TYPE I,
GUI_FILE_BIN_TOTAL_BYTES TYPE I.
CONSTANTS: C_GUIFILE_BIN_NUMBYTES TYPE I VALUE 512,
C_GUIFILE_BIN_CODEPAGE LIKE TCP00-CPCODEPAGE VALUE '1100'.
*
DATA:
* the following flag is TRUE when IMPDATA returned RC <> 0 ONCE
END_OF_DATA LIKE BOOLEAN,
* the following flag is TRUE when our "E" marker is read from the file
END_OF_OBJDATA LIKE BOOLEAN,
* the following flag is TRUE when READ on transport dataset fails
END_OF_CLIPBOARD LIKE BOOLEAN,
* the following flag is TRUE when a dummy object was exported/imported
NOTHING LIKE BOOLEAN,
* the following flag is TRUE when object import was successful
IMPORT_OK LIKE BOOLEAN,
* counts number of fatal error messages
COUNT_ERROR(3) TYPE N,
* counts number of warning messages
COUNT_WARNING(3) TYPE N,
OBJECT(10) TYPE C,
* max len of NAME will be 10+1+70+1+4+1+1 = 88 "B20K016101
NAME_LEN LIKE INTEGER VALUE 88, "B20K016101
NAME_POS LIKE INTEGER,
NAME(89) TYPE C, "B20K016101
* language vector to be used for export/import
* LANGUAGE_VECTOR LIKE LCOLOBJ-LANGVECTOR. "not transported yet
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',
* flag if dataset contents should be printed with the protocol
LIST_FILE_CONTENTS(1) TYPE C,
* flags for GUI upload/download
FILE_SOURCE_LOCAL(5) TYPE C VALUE SPACE, "B20K053928
FILE_SOURCE_LOCAL_MAGIC(5) TYPE C VALUE 'Local', "#EC NOTEXT
* flags for MASTERLANG_ONLY transport
MASTERLANG_ONLY_FLAG(5) TYPE C VALUE SPACE, "B20K057147
MASTERLANG_ONLY_MAGIC(5) TYPE C VALUE 'MastO',
**********************************************************
* data for binary file and compression
*
* binfile flag and codepage
BINARY_FILE_FORMAT_VALID(7) TYPE C VALUE SPACE,
BINARY_FILE_FORMAT_MAGIC(7) TYPE C VALUE 'BinFile',
BINFILE_CODEPAGE LIKE TCP02-CPCODEPAGE VALUE '0000',
SYSTEM_CODEPAGE LIKE TCP02-CPCODEPAGE.
CONSTANTS:
BINARY_FILE_HEADER_BYTE1 TYPE X VALUE '52', "R
BINARY_FILE_HEADER_BYTE2 TYPE X VALUE '53', "S
BINARY_FILE_HEADER_BYTE3 TYPE X VALUE '54', "T
BINARY_FILE_HEADER_BYTE4 TYPE X VALUE '58', "X
BINARY_FILE_HEADER_BYTE5 TYPE X VALUE '40'. "@
* compression tables and data
DATA: BEGIN OF FC_FULL_TAB OCCURS 0,
RECORD(512) TYPE X,
END OF FC_FULL_TAB.
DATA: FC_FULL_TAB_LINES LIKE SY-TABIX.
DATA: BEGIN OF FC_COMP_TAB OCCURS 0,
RECORD(1024) TYPE X,
END OF FC_COMP_TAB.
CONSTANTS: FC_COMP_TAB_NUMBYTES TYPE I VALUE 1024.
DATA: FC_COMP_TAB_LINES LIKE SY-TABIX.
CONSTANTS: FC_FULL_TAB_MAXLINES LIKE SY-TABIX VALUE 5000.
**********************************************************
DATA BEGIN OF PAPER.
DATA PDPAPER LIKE TSP06-PDPAPER.
DATA PDPTYPE LIKE TSP06-PDPTYPE.
DATA END OF PAPER.
* constants for new protocol interface NEW_LOGPROT
DATA: 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?
* variables for new protocol interface NEW_LOGPROT
DATA: ACTIVATE_OBJECT LIKE BOOLEAN, "tried to activate object
ACTIVATE_OBJECT_OK LIKE BOOLEAN, "activate o.k.
EXTERNAL_PROTOCOL(1) VALUE SPACE, "langimp->use ext.protocol?
MESSAGE_LANGUAGE LIKE SY-LANGU VALUE SPACE. "B20K065126
* infos for UNICODE, binary file handling
DATA:
RECORD_NUMBYTES TYPE I,
R3_INTERNAL_CHARSET(1).
CONSTANTS: C_CHARSET_ASCII VALUE 'A',
C_CHARSET_EBCDIC VALUE 'E',
C_CHARSET_UNICODE VALUE 'U'.
* GUI file table
DATA: BEGIN OF GUI_FILE_TEXT OCCURS 0,
L(512) TYPE C, "number of bytes must fit one CHAR RECORD
END OF GUI_FILE_TEXT.
DATA: GUI_FILE_TEXT_CUR_LINE_INDEX LIKE SY-TABIX.
DATA: BEGIN OF GUI_FILE_BIN OCCURS 0,
L(512) TYPE X,
END OF GUI_FILE_BIN.
DATA: GUI_FILE_BIN_CUR_LINE_INDEX LIKE SY-TABIX,
GUI_FILE_BIN_CUR_LINEOFS TYPE I,
GUI_FILE_BIN_TOTAL_BYTES TYPE I.
CONSTANTS: C_GUIFILE_BIN_NUMBYTES TYPE I VALUE 512,
C_GUIFILE_BIN_CODEPAGE LIKE TCP00-CPCODEPAGE VALUE '1100'.
*
DATA:
* the following flag is TRUE when IMPDATA returned RC <> 0 ONCE
END_OF_DATA LIKE BOOLEAN,
* the following flag is TRUE when our "E" marker is read from the file
END_OF_OBJDATA LIKE BOOLEAN,
* the following flag is TRUE when READ on transport dataset fails
END_OF_CLIPBOARD LIKE BOOLEAN,
* the following flag is TRUE when a dummy object was exported/imported
NOTHING LIKE BOOLEAN,
* the following flag is TRUE when object import was successful
IMPORT_OK LIKE BOOLEAN,
* counts number of fatal error messages
COUNT_ERROR(3) TYPE N,
* counts number of warning messages
COUNT_WARNING(3) TYPE N,
OBJECT(10) TYPE C,
* max len of NAME will be 10+1+70+1+4+1+1 = 88 "B20K016101
NAME_LEN LIKE INTEGER VALUE 88, "B20K016101
NAME_POS LIKE INTEGER,
NAME(89) TYPE C, "B20K016101
* language vector to be used for export/import
* LANGUAGE_VECTOR LIKE LCOLOBJ-LANGVECTOR. "not transported yet
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',
* flag if dataset contents should be printed with the protocol
LIST_FILE_CONTENTS(1) TYPE C,
* flags for GUI upload/download
FILE_SOURCE_LOCAL(5) TYPE C VALUE SPACE, "B20K053928
FILE_SOURCE_LOCAL_MAGIC(5) TYPE C VALUE 'Local', "#EC NOTEXT
* flags for MASTERLANG_ONLY transport
MASTERLANG_ONLY_FLAG(5) TYPE C VALUE SPACE, "B20K057147
MASTERLANG_ONLY_MAGIC(5) TYPE C VALUE 'MastO',
**********************************************************
* data for binary file and compression
*
* binfile flag and codepage
BINARY_FILE_FORMAT_VALID(7) TYPE C VALUE SPACE,
BINARY_FILE_FORMAT_MAGIC(7) TYPE C VALUE 'BinFile',
BINFILE_CODEPAGE LIKE TCP02-CPCODEPAGE VALUE '0000',
SYSTEM_CODEPAGE LIKE TCP02-CPCODEPAGE.
CONSTANTS:
BINARY_FILE_HEADER_BYTE1 TYPE X VALUE '52', "R
BINARY_FILE_HEADER_BYTE2 TYPE X VALUE '53', "S
BINARY_FILE_HEADER_BYTE3 TYPE X VALUE '54', "T
BINARY_FILE_HEADER_BYTE4 TYPE X VALUE '58', "X
BINARY_FILE_HEADER_BYTE5 TYPE X VALUE '40'. "@
* compression tables and data
DATA: BEGIN OF FC_FULL_TAB OCCURS 0,
RECORD(512) TYPE X,
END OF FC_FULL_TAB.
DATA: FC_FULL_TAB_LINES LIKE SY-TABIX.
DATA: BEGIN OF FC_COMP_TAB OCCURS 0,
RECORD(1024) TYPE X,
END OF FC_COMP_TAB.
CONSTANTS: FC_COMP_TAB_NUMBYTES TYPE I VALUE 1024.
DATA: FC_COMP_TAB_LINES LIKE SY-TABIX.
CONSTANTS: FC_FULL_TAB_MAXLINES LIKE SY-TABIX VALUE 5000.
**********************************************************
DATA BEGIN OF PAPER.
DATA PDPAPER LIKE TSP06-PDPAPER.
DATA PDPTYPE LIKE TSP06-PDPTYPE.
DATA END OF PAPER.
* constants for new protocol interface NEW_LOGPROT
DATA: 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?
* variables for new protocol interface NEW_LOGPROT
DATA: ACTIVATE_OBJECT LIKE BOOLEAN, "tried to activate object
ACTIVATE_OBJECT_OK LIKE BOOLEAN, "activate o.k.
EXTERNAL_PROTOCOL(1) VALUE SPACE, "langimp->use ext.protocol?
MESSAGE_LANGUAGE LIKE SY-LANGU VALUE SPACE. "B20K065126
data: l_authority_check like boolean value 'X'.
********************************
*
* main program used by report RSTXR3TR
*
********************************
START-OF-SELECTION.
DATA RC LIKE SY-SUBRC.
********************************
*
* main program used by report RSTXR3TR
*
********************************
START-OF-SELECTION.
DATA RC LIKE SY-SUBRC.
PERFORM SET_MESSAGE_LANGUAGE USING SY-LANGU. "B20K065126
* set list file mode...
IF LISTFILE = 'X'.
LIST_FILE_CONTENTS = 'X'.
ELSE.
LIST_FILE_CONTENTS = SPACE.
ENDIF.
* set custom langvec...
PERFORM SET_CUSTOM_LANGUAGE_VECTOR USING PLANGVEC.
* set masterlanguage mode
PERFORM SET_MASTERLANG_ONLY_FLAG USING MASTLANG. "B20K057147
* set record source/target to file
CLIPBOARD = TRUE.
* set log protocol target
IF EXTPROT = TRUE. "B20K055867
EXTERNAL_PROTOCOL = 'X'.
ELSE.
EXTERNAL_PROTOCOL = SPACE.
ENDIF.
* set file format
IF BINFILE = 'X'.
PERFORM SET_BINARY_FILE_FORMAT USING TRUE.
PERFORM FC_INIT. "init compress tables
ELSE.
PERFORM SET_BINARY_FILE_FORMAT USING FALSE.
ENDIF.
* set file source
IF LOCALFIL = SPACE OR SY-BATCH = 'X'. "B20K053928
PERFORM SET_FILE_SOURCE USING FALSE.
ELSE.
PERFORM SET_FILE_SOURCE USING TRUE.
ENDIF.
* the default dataset name is /usr/sap/trans/clipboard/RSTXR3TR.sy-uname
IF DATASET CS '****'.
REPLACE '****' WITH SY-UNAME INTO DATASET.
CONDENSE DATASET NO-GAPS.
ENDIF.
FILENAME = DATASET.
CONDENSE FILENAME NO-GAPS.
CASE MODE.
************************** E X P O R T ***************
WHEN 'EXPORT'.
FORMAT COLOR COL_GROUP.
WRITE: /
'*************** Start SAPscript Transport RSTXR3TR ************'(019).
PERFORM GET_TA.
* open file
PERFORM GET_BINARY_FILE_FORMAT_FLAG.
IF SY-SUBRC = 0.
PERFORM FILE_OPEN USING FILENAME 'O' 'B'. "binary
CHECK SY-SUBRC = 0.
PERFORM EXPORT_CLIPBOARD_BIN_HEADER.
ELSE.
PERFORM FILE_OPEN USING FILENAME 'O' 'T'. "text
CHECK SY-SUBRC = 0.
ENDIF.
* write header entry TCOMM...with transport number
PERFORM EXPORT_TA.
* loop over export objects
LOOP AT E071_TAB WHERE PGMID = 'R3TR'.
PERFORM EXPORT USING E071_TAB-OBJECT E071_TAB-OBJ_NAME.
ENDLOOP.
* close file
PERFORM GET_BINARY_FILE_FORMAT_FLAG.
IF SY-SUBRC = 0. "binary format
PERFORM FC_FLUSH_BUFFER USING FILENAME.
ENDIF.
PERFORM FILE_CLOSE USING FILENAME 'O'.
* EXIT.
* set list file mode...
IF LISTFILE = 'X'.
LIST_FILE_CONTENTS = 'X'.
ELSE.
LIST_FILE_CONTENTS = SPACE.
ENDIF.
* set custom langvec...
PERFORM SET_CUSTOM_LANGUAGE_VECTOR USING PLANGVEC.
* set masterlanguage mode
PERFORM SET_MASTERLANG_ONLY_FLAG USING MASTLANG. "B20K057147
* set record source/target to file
CLIPBOARD = TRUE.
* set log protocol target
IF EXTPROT = TRUE. "B20K055867
EXTERNAL_PROTOCOL = 'X'.
ELSE.
EXTERNAL_PROTOCOL = SPACE.
ENDIF.
* set file format
IF BINFILE = 'X'.
PERFORM SET_BINARY_FILE_FORMAT USING TRUE.
PERFORM FC_INIT. "init compress tables
ELSE.
PERFORM SET_BINARY_FILE_FORMAT USING FALSE.
ENDIF.
* set file source
IF LOCALFIL = SPACE OR SY-BATCH = 'X'. "B20K053928
PERFORM SET_FILE_SOURCE USING FALSE.
ELSE.
PERFORM SET_FILE_SOURCE USING TRUE.
ENDIF.
* the default dataset name is /usr/sap/trans/clipboard/RSTXR3TR.sy-uname
IF DATASET CS '****'.
REPLACE '****' WITH SY-UNAME INTO DATASET.
CONDENSE DATASET NO-GAPS.
ENDIF.
FILENAME = DATASET.
CONDENSE FILENAME NO-GAPS.
CASE MODE.
************************** E X P O R T ***************
WHEN 'EXPORT'.
FORMAT COLOR COL_GROUP.
WRITE: /
'*************** Start SAPscript Transport RSTXR3TR ************'(019).
PERFORM GET_TA.
* open file
PERFORM GET_BINARY_FILE_FORMAT_FLAG.
IF SY-SUBRC = 0.
PERFORM FILE_OPEN USING FILENAME 'O' 'B'. "binary
CHECK SY-SUBRC = 0.
PERFORM EXPORT_CLIPBOARD_BIN_HEADER.
ELSE.
PERFORM FILE_OPEN USING FILENAME 'O' 'T'. "text
CHECK SY-SUBRC = 0.
ENDIF.
* write header entry TCOMM...with transport number
PERFORM EXPORT_TA.
* loop over export objects
LOOP AT E071_TAB WHERE PGMID = 'R3TR'.
PERFORM EXPORT USING E071_TAB-OBJECT E071_TAB-OBJ_NAME.
ENDLOOP.
* close file
PERFORM GET_BINARY_FILE_FORMAT_FLAG.
IF SY-SUBRC = 0. "binary format
PERFORM FC_FLUSH_BUFFER USING FILENAME.
ENDIF.
PERFORM FILE_CLOSE USING FILENAME 'O'.
* EXIT.
************************** I M P O R T ***************
WHEN 'IMPORT'.
FORMAT COLOR COL_GROUP.
WRITE / TEXT-019. "Start SAPscript transport
END_OF_CLIPBOARD = FALSE.
* authority-check: IMPORT
if l_authority_check eq 'X'.
call function 'TRINT_TP_CHECK_AUTHORITY'
exporting iv_tp_command = 'IMPORT'
exceptions permission_denied = 1
others = 2.
if sy-subrc <> 0.
write: / 'keine Berechtigung f黵 IMPORT'(080).
PERFORM NEWPROT USING sy-msgty NLP_LV2 sy-msgid sy-msgno
sy-msgv1 sy-msgv2 sy-msgv3 sy-msgv4.
* PERFORM NEWPROT USING NLP_ERR NLP_LV2 NLP_MID '342' '' '' '' ''.
EXIT.
endif.
endif.
* open file
PERFORM GET_BINARY_FILE_FORMAT_FLAG.
IF SY-SUBRC = 0.
PERFORM FILE_OPEN USING FILENAME 'I' 'B'.
CHECK SY-SUBRC = 0.
* read binary header, get file codepage
PERFORM IMPORT_CLIPBOARD_BIN_HEADER USING BINFILE_CODEPAGE.
CASE SY-SUBRC.
WHEN 0.
FORMAT COLOR COL_TOTAL.
WRITE: /
'Bin鋜es Dataset enth鋖t Daten in Codepage'(060), BINFILE_CODEPAGE.
WHEN 1.
FORMAT COLOR COL_NEGATIVE.
WRITE: /
'Dataset enth鋖t kein korrektes Bin鋜format'(061).
EXIT.
WHEN 2.
FORMAT COLOR COL_NEGATIVE.
WRITE: /
'Dataset enth鋖t eine unbekannte Codepage'(062), BINFILE_CODEPAGE.
EXIT.
ENDCASE.
ELSE.
PERFORM FILE_OPEN USING FILENAME 'I' 'T'.
CHECK SY-SUBRC = 0.
ENDIF.
* read header entry with transport number
PERFORM IMPORT_TA USING RC.
IF RC <> 0.
PERFORM FILE_CLOSE USING FILENAME 'I'.
EXIT.
ENDIF.
* loop over import-objects
WHILE END_OF_CLIPBOARD = FALSE.
PERFORM IMPORT USING SY-SUBRC.
ENDWHILE.
* close file
PERFORM FILE_CLOSE USING FILENAME 'I'.
WHEN OTHERS.
FORMAT COLOR COL_NEGATIVE.
WRITE: /
'ERROR - Als Modus-Parameter nur EXPORT oder IMPORT verwenden'(051).
EXIT.
ENDCASE.
FORMAT COLOR COL_GROUP.
WRITE: /
'*************** Ende SAPscript Transport RSTXR3TR *************'(020).
WHEN 'IMPORT'.
FORMAT COLOR COL_GROUP.
WRITE / TEXT-019. "Start SAPscript transport
END_OF_CLIPBOARD = FALSE.
* authority-check: IMPORT
if l_authority_check eq 'X'.
call function 'TRINT_TP_CHECK_AUTHORITY'
exporting iv_tp_command = 'IMPORT'
exceptions permission_denied = 1
others = 2.
if sy-subrc <> 0.
write: / 'keine Berechtigung f黵 IMPORT'(080).
PERFORM NEWPROT USING sy-msgty NLP_LV2 sy-msgid sy-msgno
sy-msgv1 sy-msgv2 sy-msgv3 sy-msgv4.
* PERFORM NEWPROT USING NLP_ERR NLP_LV2 NLP_MID '342' '' '' '' ''.
EXIT.
endif.
endif.
* open file
PERFORM GET_BINARY_FILE_FORMAT_FLAG.
IF SY-SUBRC = 0.
PERFORM FILE_OPEN USING FILENAME 'I' 'B'.
CHECK SY-SUBRC = 0.
* read binary header, get file codepage
PERFORM IMPORT_CLIPBOARD_BIN_HEADER USING BINFILE_CODEPAGE.
CASE SY-SUBRC.
WHEN 0.
FORMAT COLOR COL_TOTAL.
WRITE: /
'Bin鋜es Dataset enth鋖t Daten in Codepage'(060), BINFILE_CODEPAGE.
WHEN 1.
FORMAT COLOR COL_NEGATIVE.
WRITE: /
'Dataset enth鋖t kein korrektes Bin鋜format'(061).
EXIT.
WHEN 2.
FORMAT COLOR COL_NEGATIVE.
WRITE: /
'Dataset enth鋖t eine unbekannte Codepage'(062), BINFILE_CODEPAGE.
EXIT.
ENDCASE.
ELSE.
PERFORM FILE_OPEN USING FILENAME 'I' 'T'.
CHECK SY-SUBRC = 0.
ENDIF.
* read header entry with transport number
PERFORM IMPORT_TA USING RC.
IF RC <> 0.
PERFORM FILE_CLOSE USING FILENAME 'I'.
EXIT.
ENDIF.
* loop over import-objects
WHILE END_OF_CLIPBOARD = FALSE.
PERFORM IMPORT USING SY-SUBRC.
ENDWHILE.
* close file
PERFORM FILE_CLOSE USING FILENAME 'I'.
WHEN OTHERS.
FORMAT COLOR COL_NEGATIVE.
WRITE: /
'ERROR - Als Modus-Parameter nur EXPORT oder IMPORT verwenden'(051).
EXIT.
ENDCASE.
FORMAT COLOR COL_GROUP.
WRITE: /
'*************** Ende SAPscript Transport RSTXR3TR *************'(020).
********************************
*
* entry routine for report RSTXSCRP
*
********************************
FORM RSTXSCRP USING OBJECT OBJ_NAME MODE FILE LIST_FILE LANG_VEC
BINFILE_FLAG LOCALFILE_FLAG MASTLANG_FLAG.
DATA RC LIKE SY-SUBRC.
STATICS DEVTYPE LIKE TSP03-PATYPE.
*
* entry routine for report RSTXSCRP
*
********************************
FORM RSTXSCRP USING OBJECT OBJ_NAME MODE FILE LIST_FILE LANG_VEC
BINFILE_FLAG LOCALFILE_FLAG MASTLANG_FLAG.
DATA RC LIKE SY-SUBRC.
STATICS DEVTYPE LIKE TSP03-PATYPE.
PERFORM SET_MESSAGE_LANGUAGE USING SY-LANGU. "B20K065126
* set list file mode...
IF LIST_FILE = 'X'.
LIST_FILE_CONTENTS = 'X'.
ELSE.
LIST_FILE_CONTENTS = SPACE.
ENDIF.
* set record source/target to file
CLIPBOARD = TRUE.
* set log protocol target to report list
EXTERNAL_PROTOCOL = SPACE. "B20K055867
* set file format
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 file source
IF LOCALFILE_FLAG = SPACE OR SY-BATCH = 'X'. "B20K053928
PERFORM SET_FILE_SOURCE USING FALSE.
ELSE.
PERFORM SET_FILE_SOURCE USING TRUE.
ENDIF.
* set custom langvec...
PERFORM SET_CUSTOM_LANGUAGE_VECTOR USING LANG_VEC.
* set masterlanguage mode
PERFORM SET_MASTERLANG_ONLY_FLAG USING MASTLANG_FLAG. "B20K057147
SUBRC = 0.
END_OF_OBJDATA = FALSE.
END_OF_CLIPBOARD = FALSE.
FILENAME = FILE.
FORMAT COLOR COL_GROUP.
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.
PERFORM FILE_OPEN USING FILENAME 'O' 'B'. "binary
CHECK SY-SUBRC = 0.
PERFORM EXPORT_CLIPBOARD_BIN_HEADER.
ELSE.
PERFORM FILE_OPEN USING FILENAME 'O' 'T'. "text
CHECK SY-SUBRC = 0.
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.
PERFORM FILE_CLOSE USING FILENAME 'O'.
* LEAVE PROGRAM.
************************** I M P O R T ***************
WHEN 'IMPORT'.
END_OF_CLIPBOARD = FALSE.
PERFORM GET_BINARY_FILE_FORMAT_FLAG.
IF SY-SUBRC = 0.
PERFORM FILE_OPEN USING FILENAME 'I' 'B'.
CHECK SY-SUBRC = 0.
* read binary header, get file codepage
PERFORM IMPORT_CLIPBOARD_BIN_HEADER USING BINFILE_CODEPAGE.
CASE SY-SUBRC.
WHEN 0.
FORMAT COLOR COL_TOTAL.
WRITE: / TEXT-060, BINFILE_CODEPAGE. "contains data in cp..
WHEN 1.
FORMAT COLOR COL_NEGATIVE.
WRITE: / TEXT-061. "no valid binary format
EXIT.
WHEN 2.
FORMAT COLOR COL_NEGATIVE.
WRITE: / TEXT-062, BINFILE_CODEPAGE. "unknown codepage
EXIT.
ENDCASE.
ELSE.
PERFORM FILE_OPEN USING FILENAME 'I' 'T'.
CHECK SY-SUBRC = 0.
ENDIF.
* read header entry S...with object key
PERFORM IMPORT_SAPSCRIPT USING OBJECT OBJ_NAME RC.
IF RC <> 0.
PERFORM FILE_CLOSE USING FILENAME 'I'.
EXIT.
ENDIF.
* loop over import objects
WHILE END_OF_CLIPBOARD = FALSE.
PERFORM IMPORT USING SY-SUBRC.
ENDWHILE.
* close file
PERFORM FILE_CLOSE USING FILENAME 'I'.
* inform spooler
IF OBJECT = 'PRIN'.
DEVTYPE = OBJ_NAME.
CALL FUNCTION 'RSPO_PTYPE_FLUSH'
EXPORTING
PTYPE = DEVTYPE
EXCEPTIONS
CALL_ERROR = 1
OPERATION_FAILED = 2
OTHERS = 3.
FORMAT COLOR COL_TOTAL.
WRITE: / 'Der Spooler wurde 黚er die 膎derung informiert'(057).
ENDIF.
ENDCASE.
ENDFORM.
* set list file mode...
IF LIST_FILE = 'X'.
LIST_FILE_CONTENTS = 'X'.
ELSE.
LIST_FILE_CONTENTS = SPACE.
ENDIF.
* set record source/target to file
CLIPBOARD = TRUE.
* set log protocol target to report list
EXTERNAL_PROTOCOL = SPACE. "B20K055867
* set file format
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 file source
IF LOCALFILE_FLAG = SPACE OR SY-BATCH = 'X'. "B20K053928
PERFORM SET_FILE_SOURCE USING FALSE.
ELSE.
PERFORM SET_FILE_SOURCE USING TRUE.
ENDIF.
* set custom langvec...
PERFORM SET_CUSTOM_LANGUAGE_VECTOR USING LANG_VEC.
* set masterlanguage mode
PERFORM SET_MASTERLANG_ONLY_FLAG USING MASTLANG_FLAG. "B20K057147
SUBRC = 0.
END_OF_OBJDATA = FALSE.
END_OF_CLIPBOARD = FALSE.
FILENAME = FILE.
FORMAT COLOR COL_GROUP.
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.
PERFORM FILE_OPEN USING FILENAME 'O' 'B'. "binary
CHECK SY-SUBRC = 0.
PERFORM EXPORT_CLIPBOARD_BIN_HEADER.
ELSE.
PERFORM FILE_OPEN USING FILENAME 'O' 'T'. "text
CHECK SY-SUBRC = 0.
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.
PERFORM FILE_CLOSE USING FILENAME 'O'.
* LEAVE PROGRAM.
************************** I M P O R T ***************
WHEN 'IMPORT'.
END_OF_CLIPBOARD = FALSE.
PERFORM GET_BINARY_FILE_FORMAT_FLAG.
IF SY-SUBRC = 0.
PERFORM FILE_OPEN USING FILENAME 'I' 'B'.
CHECK SY-SUBRC = 0.
* read binary header, get file codepage
PERFORM IMPORT_CLIPBOARD_BIN_HEADER USING BINFILE_CODEPAGE.
CASE SY-SUBRC.
WHEN 0.
FORMAT COLOR COL_TOTAL.
WRITE: / TEXT-060, BINFILE_CODEPAGE. "contains data in cp..
WHEN 1.
FORMAT COLOR COL_NEGATIVE.
WRITE: / TEXT-061. "no valid binary format
EXIT.
WHEN 2.
FORMAT COLOR COL_NEGATIVE.
WRITE: / TEXT-062, BINFILE_CODEPAGE. "unknown codepage
EXIT.
ENDCASE.
ELSE.
PERFORM FILE_OPEN USING FILENAME 'I' 'T'.
CHECK SY-SUBRC = 0.
ENDIF.
* read header entry S...with object key
PERFORM IMPORT_SAPSCRIPT USING OBJECT OBJ_NAME RC.
IF RC <> 0.
PERFORM FILE_CLOSE USING FILENAME 'I'.
EXIT.
ENDIF.
* loop over import objects
WHILE END_OF_CLIPBOARD = FALSE.
PERFORM IMPORT USING SY-SUBRC.
ENDWHILE.
* close file
PERFORM FILE_CLOSE USING FILENAME 'I'.
* inform spooler
IF OBJECT = 'PRIN'.
DEVTYPE = OBJ_NAME.
CALL FUNCTION 'RSPO_PTYPE_FLUSH'
EXPORTING
PTYPE = DEVTYPE
EXCEPTIONS
CALL_ERROR = 1
OPERATION_FAILED = 2
OTHERS = 3.
FORMAT COLOR COL_TOTAL.
WRITE: / 'Der Spooler wurde 黚er die 膎derung informiert'(057).
ENDIF.
ENDCASE.
ENDFORM.
* new 3.1G export routine for exporting master language ONLY
* B20K057147
FORM EXPORT_31 USING EXPORT_OBJECT EXPORT_NAME VALUE(MASTERLANG_ONLY).
IF MASTERLANG_ONLY = 'X'.
PERFORM SET_MASTERLANG_ONLY_FLAG USING TRUE.
ELSE.
PERFORM SET_MASTERLANG_ONLY_FLAG USING FALSE.
ENDIF.
PERFORM EXPORT USING EXPORT_OBJECT EXPORT_NAME.
ENDFORM.
* B20K057147
FORM EXPORT_31 USING EXPORT_OBJECT EXPORT_NAME VALUE(MASTERLANG_ONLY).
IF MASTERLANG_ONLY = 'X'.
PERFORM SET_MASTERLANG_ONLY_FLAG USING TRUE.
ELSE.
PERFORM SET_MASTERLANG_ONLY_FLAG USING FALSE.
ENDIF.
PERFORM EXPORT USING EXPORT_OBJECT EXPORT_NAME.
ENDFORM.
********************************
*
* global entry for transport routines: object EXPORT
*
********************************
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 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.
ENDIF.
ENDFORM.
*
* global entry for transport routines: object EXPORT
*
********************************
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 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.
ENDIF.
ENDFORM.
* export object TEXT, expanding generic entries
FORM EXPORT_TEXTS.
DATA: FILL LIKE SY-TFILL,
RC LIKE SY-SUBRC.
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.
* B20K057147 - no check against langvec during export
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.
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.
* B20K057147 - no check against langvec during export
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.
* get single text key components into TEXTLOW-...
FORM NAME_TO_TEXTKEY.
ASSIGN NAME(1) TO <NAME>.
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.
FORM NAME_TO_TEXTKEY.
ASSIGN NAME(1) TO <NAME>.
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.
FORM TEXTKEY USING VALUE(LEN) LOW.
DATA N LIKE NAME.
FIELD-SYMBOLS <N>.
DATA N LIKE NAME.
FIELD-SYMBOLS <N>.
ASSIGN N(1) TO <N>.
WHILE <NAME> NE ',' AND LEN > 0 AND
NAME_POS <= NAME_LEN.
<N> = <NAME>. SUBTRACT 1 FROM LEN.
IF LEN >= 1.
ASSIGN <N>+1 TO <N>.
ENDIF.
ASSIGN <NAME>+1 TO <NAME>. ADD 1 TO NAME_POS.
ENDWHILE.
IF <NAME> = ',' AND NAME_POS <= NAME_LEN.
ASSIGN <NAME>+1 TO <NAME>. ADD 1 TO NAME_POS.
ENDIF.
LOW = N.
ENDFORM.
WHILE <NAME> NE ',' AND LEN > 0 AND
NAME_POS <= NAME_LEN.
<N> = <NAME>. SUBTRACT 1 FROM LEN.
IF LEN >= 1.
ASSIGN <N>+1 TO <N>.
ENDIF.
ASSIGN <NAME>+1 TO <NAME>. ADD 1 TO NAME_POS.
ENDWHILE.
IF <NAME> = ',' AND NAME_POS <= NAME_LEN.
ASSIGN <NAME>+1 TO <NAME>. ADD 1 TO NAME_POS.
ENDIF.
LOW = N.
ENDFORM.
* check FORM/STYL before exporting
* HEADER_DEF contains DEF part header
* HEADER_TAB table contains TXT part headers
* TRANSTAT is always valid, since DEF part is also read for STYT/FORT
* RC = 0 if o.k. to export
* = 4 if langvec prohibits export
* = 8 if inconsistent object
FORM CHECK_FORMSTYL_FOR_EXPORT USING VALUE(LANGUAGE_ONLY)
VALUE(OLANG)
VALUE(LANGVEC)
VALUE(TRANSTAT)
RC.
DATA: NUMOTXT LIKE INTEGER, "number of TXT parts in olang
NUMTXT LIKE INTEGER. "number of TXT parts allowed by LANGVEC
STATICS: MASTERLANG_ONLY LIKE BOOLEAN. "B20K057147
* HEADER_DEF contains DEF part header
* HEADER_TAB table contains TXT part headers
* TRANSTAT is always valid, since DEF part is also read for STYT/FORT
* RC = 0 if o.k. to export
* = 4 if langvec prohibits export
* = 8 if inconsistent object
FORM CHECK_FORMSTYL_FOR_EXPORT USING VALUE(LANGUAGE_ONLY)
VALUE(OLANG)
VALUE(LANGVEC)
VALUE(TRANSTAT)
RC.
DATA: NUMOTXT LIKE INTEGER, "number of TXT parts in olang
NUMTXT LIKE INTEGER. "number of TXT parts allowed by LANGVEC
STATICS: MASTERLANG_ONLY LIKE BOOLEAN. "B20K057147
PERFORM GET_MASTERLANG_ONLY_FLAG. "B20K057147
IF SY-SUBRC = 0. "
MASTERLANG_ONLY = TRUE. "
ELSE. "
MASTERLANG_ONLY = FALSE. "
ENDIF. "
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
* B20K057147 - check against language vector only for masterlang mode
IF MASTERLANG_ONLY = TRUE.
IF LANGVEC NA OLANG. "spras in LANGVEC
* language vector prohibits orig lang export/import
PERFORM NEWPROT USING NLP_INF NLP_LV3 NLP_MID '082'
OLANG SPACE SPACE SPACE.
RC = 4. EXIT.
* msg TD 054 is unused now...
ENDIF.
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.
DELETE HEADER_TAB. "TXT other than OSPRAS
ENDIF.
ELSE. "translations wanted
IF MASTERLANG_ONLY = TRUE. "B20K057147
IF HEADER_TAB-TDSPRAS <> OLANG. "
DELETE HEADER_TAB. "export only masterlanguage
ELSE. "
ADD 1 TO NUMTXT.
ENDIF. "
ELSE. "
* B20K057147 - no check against langvec during export
ADD 1 TO NUMTXT. "
* msg TD 083 is unused now...
ENDIF. "B20K057147
ENDIF.
ENDLOOP.
IF NUMOTXT <> 1.
RC = 8. EXIT. "0 or several TXT parts in olang
ENDIF.
ENDIF.
IF NUMTXT = 0. "no TXT parts to export
RC = 4. EXIT.
ENDIF.
ENDFORM.
IF SY-SUBRC = 0. "
MASTERLANG_ONLY = TRUE. "
ELSE. "
MASTERLANG_ONLY = FALSE. "
ENDIF. "
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
* B20K057147 - check against language vector only for masterlang mode
IF MASTERLANG_ONLY = TRUE.
IF LANGVEC NA OLANG. "spras in LANGVEC
* language vector prohibits orig lang export/import
PERFORM NEWPROT USING NLP_INF NLP_LV3 NLP_MID '082'
OLANG SPACE SPACE SPACE.
RC = 4. EXIT.
* msg TD 054 is unused now...
ENDIF.
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.
DELETE HEADER_TAB. "TXT other than OSPRAS
ENDIF.
ELSE. "translations wanted
IF MASTERLANG_ONLY = TRUE. "B20K057147
IF HEADER_TAB-TDSPRAS <> OLANG. "
DELETE HEADER_TAB. "export only masterlanguage
ELSE. "
ADD 1 TO NUMTXT.
ENDIF. "
ELSE. "
* B20K057147 - no check against langvec during export
ADD 1 TO NUMTXT. "
* msg TD 083 is unused now...
ENDIF. "B20K057147
ENDIF.
ENDLOOP.
IF NUMOTXT <> 1.
RC = 8. EXIT. "0 or several TXT parts in olang
ENDIF.
ENDIF.
IF NUMTXT = 0. "no TXT parts to export
RC = 4. EXIT.
ENDIF.
ENDFORM.
* export a FORM or STYL
* only ACTIVE versions are exported
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.
* only ACTIVE versions are exported
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.
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.
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.
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.
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.
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 a printer definition
FORM EXPORT_PRINTER.
* TSP0A Printer
SELECT SINGLE * FROM TSP0A WHERE PATYPE = NAME(8).
IF SY-SUBRC NE 0.
* the object does not exist and will be deleted in target system
PERFORM NEWPROT USING NLP_WAR NLP_LV2 NLP_MID '056' "B20K057010
OBJECT NAME(8) SPACE SPACE. "
PERFORM EXPORT_HEADER. "
PERFORM EXPORT_FUNCTION USING FUNC_DEL_PRIN. "
PERFORM EXPORT_END. "
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.
clear tfo03_line-all.
tfo03_line-all(8) = tfo03-tdprinter.
tfo03_line-all+8(8) = tfo03-tdfamily.
tfo03_line-all+16(3) = tfo03-tdfontsize.
tfo03_line-all+19(1) = tfo03-tdbold.
tfo03_line-all+20(1) = tfo03-tditalic.
TFO03_LINE-ALL+21(3) = SPACE. " TFO03-TDCPI NE ASCII
tfo03_line-all+24(30) = tfo03-tdpprintid.
tfo03_line-all+54(30) = tfo03-tdlprintid.
tfo03_line-all+84(1) = tfo03-tdafmflag.
tfo03_line-all+85(1) = tfo03-tdcpselect.
PERFORM EXPORT_DATA USING 'FO03' TFO03_LINE.
ENDSELECT.
* TFO06 Printer-Barcodes
SELECT * FROM TFO06 WHERE TDPRINTER = NAME(8).
PERFORM EXPORT_DATA USING 'FO06' TFO06.
ENDSELECT.
* T022D Print-Controls
SELECT * FROM T022D WHERE TYP = NAME(8).
PERFORM EXPORT_DATA USING '022D' T022D.
ENDSELECT.
* TSP06A device format - summary
SELECT * FROM TSP06A WHERE PTYPE = NAME(8).
* PERFORM EXPORT_DATA USING 'SP6A' TSP06A.
clear tsp06a_line.
move-corresponding tsp06a to tsp06a_line.
PERFORM EXPORT_DATA USING 'SP6A' tsp06a_line.
FORM EXPORT_PRINTER.
* TSP0A Printer
SELECT SINGLE * FROM TSP0A WHERE PATYPE = NAME(8).
IF SY-SUBRC NE 0.
* the object does not exist and will be deleted in target system
PERFORM NEWPROT USING NLP_WAR NLP_LV2 NLP_MID '056' "B20K057010
OBJECT NAME(8) SPACE SPACE. "
PERFORM EXPORT_HEADER. "
PERFORM EXPORT_FUNCTION USING FUNC_DEL_PRIN. "
PERFORM EXPORT_END. "
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.
clear tfo03_line-all.
tfo03_line-all(8) = tfo03-tdprinter.
tfo03_line-all+8(8) = tfo03-tdfamily.
tfo03_line-all+16(3) = tfo03-tdfontsize.
tfo03_line-all+19(1) = tfo03-tdbold.
tfo03_line-all+20(1) = tfo03-tditalic.
TFO03_LINE-ALL+21(3) = SPACE. " TFO03-TDCPI NE ASCII
tfo03_line-all+24(30) = tfo03-tdpprintid.
tfo03_line-all+54(30) = tfo03-tdlprintid.
tfo03_line-all+84(1) = tfo03-tdafmflag.
tfo03_line-all+85(1) = tfo03-tdcpselect.
PERFORM EXPORT_DATA USING 'FO03' TFO03_LINE.
ENDSELECT.
* TFO06 Printer-Barcodes
SELECT * FROM TFO06 WHERE TDPRINTER = NAME(8).
PERFORM EXPORT_DATA USING 'FO06' TFO06.
ENDSELECT.
* T022D Print-Controls
SELECT * FROM T022D WHERE TYP = NAME(8).
PERFORM EXPORT_DATA USING '022D' T022D.
ENDSELECT.
* TSP06A device format - summary
SELECT * FROM TSP06A WHERE PTYPE = NAME(8).
* PERFORM EXPORT_DATA USING 'SP6A' TSP06A.
clear tsp06a_line.
move-corresponding tsp06a to tsp06a_line.
PERFORM EXPORT_DATA USING 'SP6A' tsp06a_line.
TSP06AX_LINE-PTYPE = TSP06A-PTYPE.
TSP06AX_LINE-PAPER = TSP06A-PAPER.
TSP06AX_LINE-LSTDRIVER = TSP06A-LSTDRIVER.
TSP06AX_LINE-LSTSUBTYPE = TSP06A-LSTSUBTYPE.
TSP06AX_LINE-DRIVERINFO = TSP06A-DRIVERINFO.
TSP06AX_LINE-SPACEMODE = TSP06A-SPACEMODE.
TSP06AX_LINE-CHARWIDTH = TSP06A-CHARWIDTH.
TSP06AX_LINE-FONTSIZE = TSP06A-FONTSIZE.
PERFORM EXPORT_DATA USING 'SP6X' TSP06AX_LINE.
ENDSELECT.
* TSP06 device format - details
CLEAR PAPER.
SELECT * FROM TSP06 WHERE PDPTYPE = NAME(8).
IF PAPER-PDPAPER NE TSP06-PDPAPER.
PAPER-PDPTYPE = TSP06-PDPTYPE.
PAPER-PDPAPER = TSP06-PDPAPER.
* export current device format entry
SELECT SINGLE * FROM TSP1D WHERE PAPART = PAPER-PDPAPER.
IF SY-SUBRC = 0.
* PERFORM EXPORT_DATA USING 'SP1D' TSP1D.
clear tsp1d_line.
move-corresponding tsp1d to tsp1d_line.
perform export_data using 'SP1D' tsp1d_line.
TSP06AX_LINE-PAPER = TSP06A-PAPER.
TSP06AX_LINE-LSTDRIVER = TSP06A-LSTDRIVER.
TSP06AX_LINE-LSTSUBTYPE = TSP06A-LSTSUBTYPE.
TSP06AX_LINE-DRIVERINFO = TSP06A-DRIVERINFO.
TSP06AX_LINE-SPACEMODE = TSP06A-SPACEMODE.
TSP06AX_LINE-CHARWIDTH = TSP06A-CHARWIDTH.
TSP06AX_LINE-FONTSIZE = TSP06A-FONTSIZE.
PERFORM EXPORT_DATA USING 'SP6X' TSP06AX_LINE.
ENDSELECT.
* TSP06 device format - details
CLEAR PAPER.
SELECT * FROM TSP06 WHERE PDPTYPE = NAME(8).
IF PAPER-PDPAPER NE TSP06-PDPAPER.
PAPER-PDPTYPE = TSP06-PDPTYPE.
PAPER-PDPAPER = TSP06-PDPAPER.
* export current device format entry
SELECT SINGLE * FROM TSP1D WHERE PAPART = PAPER-PDPAPER.
IF SY-SUBRC = 0.
* PERFORM EXPORT_DATA USING 'SP1D' TSP1D.
clear tsp1d_line.
move-corresponding tsp1d to tsp1d_line.
perform export_data using 'SP1D' tsp1d_line.
TSP1DX_LINE-PAPART = TSP1D-PAPART.
TSP1DX_LINE-LISTAREA = TSP1D-LISTAREA.
TSP1DX_LINE-MRG_TOP = TSP1D-MRG_TOP.
TSP1DX_LINE-MRG_LEFT = TSP1D-MRG_LEFT.
TSP1DX_LINE-MRG_BOT = TSP1D-MRG_BOT.
TSP1DX_LINE-MRG_RIGHT = TSP1D-MRG_RIGHT.
PERFORM EXPORT_DATA USING 'SP1X' TSP1DX_LINE.
ELSE.
CLEAR PAPER.
ENDIF.
ENDIF.
CHECK PAPER NE SPACE.
TSP06_LINE-PDLFDNR = TSP06-PDLFDNR.
TSP06_LINE-PDDATALEN = TSP06-PDDATALEN.
* TSP06_LINE-ALL = TSP06.
clear tsp06_line-all.
tsp06_line-all(8) = tsp06-pdptype.
tsp06_line-all+8(16) = tsp06-pdpaper.
tsp06_line-all+24(8) = tsp06-pdname.
TSP06_LINE-ALL+32(2) = SPACE. " PDLFDNR,PDDATALEN ne ASCII
tsp06_line-all+34(72) = tsp06-pddata.
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.
TSP1DX_LINE-LISTAREA = TSP1D-LISTAREA.
TSP1DX_LINE-MRG_TOP = TSP1D-MRG_TOP.
TSP1DX_LINE-MRG_LEFT = TSP1D-MRG_LEFT.
TSP1DX_LINE-MRG_BOT = TSP1D-MRG_BOT.
TSP1DX_LINE-MRG_RIGHT = TSP1D-MRG_RIGHT.
PERFORM EXPORT_DATA USING 'SP1X' TSP1DX_LINE.
ELSE.
CLEAR PAPER.
ENDIF.
ENDIF.
CHECK PAPER NE SPACE.
TSP06_LINE-PDLFDNR = TSP06-PDLFDNR.
TSP06_LINE-PDDATALEN = TSP06-PDDATALEN.
* TSP06_LINE-ALL = TSP06.
clear tsp06_line-all.
tsp06_line-all(8) = tsp06-pdptype.
tsp06_line-all+8(16) = tsp06-pdpaper.
tsp06_line-all+24(8) = tsp06-pdname.
TSP06_LINE-ALL+32(2) = SPACE. " PDLFDNR,PDDATALEN ne ASCII
tsp06_line-all+34(72) = tsp06-pddata.
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.
********************************
*
* global entry for transport routines: object IMPORT
*
********************************
FORM IMPORT USING IMPORT_SUBRC.
DATA MSGNO LIKE T100-MSGNR.
*
* global entry for transport routines: object IMPORT
*
********************************
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.
ENDIF.
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.
ENDIF.
ENDFORM.
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.
ENDIF.
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.
ENDIF.
ENDFORM.
* check layout set/style part before saving during import
* RC = 0 if o.k. to import
* RC = 4 if TXT not in langvec
* RC = 8 if DEF not in langvec
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.
* no message "langvec ignored", message 054 is unused now
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.
ENDIF.
ENDIF.
ENDFORM.
* RC = 0 if o.k. to import
* RC = 4 if TXT not in langvec
* RC = 8 if DEF not in langvec
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.
* no message "langvec ignored", message 054 is unused now
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.
ENDIF.
ENDIF.
ENDFORM.
* IMPORT a style or layout set
* OBJECT_TYPE is FORM/FORT or STYL/STYT
FORM IMPORT_FORMSTYL USING VALUE(OBJECT_TYPE) VALUE(LANGUAGE_ONLY).
DATA: RC LIKE SY-SUBRC,
OLANG LIKE THEAD-TDOSPRAS,
TRANSTAT LIKE THEAD-TDTRANSTAT.
* OBJECT_TYPE is FORM/FORT or STYL/STYT
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.
* TODO: COMMIT WORK. BV
* add 1 to commit_counter.
* if commit_counter > c_commit_max_records.
* clear commit_counter.
* commit work.
* endif.
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.
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.
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.
* TODO: COMMIT WORK. BV
* add 1 to commit_counter.
* if commit_counter > c_commit_max_records.
* clear commit_counter.
* commit work.
* endif.
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.
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 a TEXT
FORM IMPORT_TEXT.
DATA: RC LIKE SY-SUBRC.
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.
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 a PRINTER definition
FORM IMPORT_PRIN.
CONSTANTS: ALLCLIENTS LIKE SY-MANDT VALUE '* '.
STATICS: VERSION LIKE TSP0A-PVERS,
PRINTER LIKE TSP0A-PATYPE,
NUMLINES LIKE SY-TABIX.
FORM IMPORT_PRIN.
CONSTANTS: ALLCLIENTS LIKE SY-MANDT VALUE '* '.
STATICS: VERSION LIKE TSP0A-PVERS,
PRINTER LIKE TSP0A-PATYPE,
NUMLINES LIKE SY-TABIX.
* refresh buffer tables
REFRESH: BUF_T022D, BUF_TSP06, BUF_TSP06A,
BUF_TFO03, BUF_TFO04, BUF_TFO06,
BUF_TSP1D.
PERFORM IMPORT_RECORD.
WHILE END_OF_OBJDATA = FALSE AND SUBRC = 0.
CASE RECORD-COMMAND.
* print controls T022D (REPLACE ALL)
WHEN '022D'.
BUF_T022D = RECORD-DATA.
APPEND BUF_T022D.
* font families TFO01
WHEN 'FO01'. "ignore, no import
* printer fonts TFO03 (REPLACE ALL)
WHEN 'FO03'.
TFO03_LINE = RECORD-DATA.
BUF_TFO03-tdprinter = TFO03_LINE-ALL(8).
BUF_TFO03-tdfamily = TFO03_LINE-ALL+8(8).
BUF_TFO03-tdfontsize = TFO03_LINE-ALL+16(3).
BUF_TFO03-tdbold = TFO03_LINE-ALL+19(1).
BUF_TFO03-tditalic = TFO03_LINE-ALL+20(1).
BUF_TFO03-tdpprintid = TFO03_LINE-ALL+24(30).
BUF_TFO03-tdlprintid = TFO03_LINE-ALL+54(30).
BUF_TFO03-tdafmflag = TFO03_LINE-ALL+84(1).
BUF_TFO03-tdcpselect = TFO03_LINE-ALL+85(1).
BUF_TFO03-TDCPI = TFO03_LINE-CPI.
APPEND BUF_TFO03.
* printer font metrics TFO04 (REPLACE ALL)
WHEN 'FO04'.
BUF_TFO04 = RECORD-DATA.
APPEND BUF_TFO04.
* system barcodes TFO05
WHEN 'FO05'. "ignore, no import
* printer barcodes TFO06 (REPLACE ALL)
WHEN 'FO06'.
BUF_TFO06 = RECORD-DATA.
APPEND BUF_TFO06.
* device format summary TSP06A (REPLACE ALL)
WHEN 'SP6A'.
* BUF_TSP06A = RECORD-DATA.
clear buf_tsp06A.
tsp06a_line = record-data.
move-corresponding tsp06a_line to buf_tsp06a.
APPEND BUF_TSP06A.
WHEN 'SP6X'.
TSP06AX_LINE = RECORD-DATA.
DESCRIBE TABLE BUF_TSP06A LINES NUMLINES.
READ TABLE BUF_TSP06A WITH KEY
PTYPE = TSP06AX_LINE-PTYPE
PAPER = TSP06AX_LINE-PAPER.
IF SY-SUBRC = 0.
BUF_TSP06A-LSTDRIVER = TSP06AX_LINE-LSTDRIVER.
BUF_TSP06A-LSTSUBTYPE = TSP06AX_LINE-LSTSUBTYPE.
BUF_TSP06A-DRIVERINFO = TSP06AX_LINE-DRIVERINFO.
BUF_TSP06A-SPACEMODE = TSP06AX_LINE-SPACEMODE.
BUF_TSP06A-CHARWIDTH = TSP06AX_LINE-CHARWIDTH.
BUF_TSP06A-FONTSIZE = TSP06AX_LINE-FONTSIZE.
MODIFY BUF_TSP06A INDEX SY-TABIX.
ENDIF.
* device format details TSP06 (REPLACE ALL)
WHEN 'SP06'.
TSP06_LINE = RECORD-DATA.
* BUF_TSP06 = TSP06_LINE-ALL.
clear buf_tsp06.
buf_tsp06-pdptype = tsp06_line-all(8).
buf_tsp06-pdpaper = tsp06_line-all+8(16).
buf_tsp06-pdname = tsp06_line-all+24(8).
buf_tsp06-pddata = tsp06_line-all+34(72).
BUF_TSP06-PDLFDNR = TSP06_LINE-PDLFDNR.
BUF_TSP06-PDDATALEN = TSP06_LINE-PDDATALEN.
APPEND BUF_TSP06.
* spooler formats TSP1D (insert NEW only, do not change existing)
WHEN 'SP1D'.
* BUF_TSP1D = RECORD-DATA.
clear buf_tsp1d.
tsp1d_line = record-data.
move-corresponding tsp1d_line to buf_tsp1d.
APPEND BUF_TSP1D.
WHEN 'SP1X'.
TSP1DX_LINE = RECORD-DATA.
READ TABLE BUF_TSP1D WITH KEY
PAPART = TSP1DX_LINE-PAPART.
IF SY-SUBRC = 0.
BUF_TSP1D-LISTAREA = TSP1DX_LINE-LISTAREA.
BUF_TSP1D-MRG_TOP = TSP1DX_LINE-MRG_TOP.
BUF_TSP1D-MRG_LEFT = TSP1DX_LINE-MRG_LEFT.
BUF_TSP1D-MRG_BOT = TSP1DX_LINE-MRG_BOT.
BUF_TSP1D-MRG_RIGHT = TSP1DX_LINE-MRG_RIGHT.
MODIFY BUF_TSP1D INDEX NUMLINES.
ENDIF.
* 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!
WHEN FUNC_DEL_PAPER.
PAPER = RECORD-DATA.
* DELETE FROM TSP06 WHERE PDPTYPE = PAPER-PDPTYPE "B20K064895
* AND PDPAPER = PAPER-PDPAPER.
WHEN FUNC_DEL_PRIN. "B20K057010
* delete printer, tables will be deleted in UPDATE_PRIN_TABLES
PRINTER = NAME(8). "
DELETE FROM TSP0A WHERE PATYPE = PRINTER. "
PERFORM NEWPROT USING NLP_WAR NLP_LV2 NLP_MID '097' "
OBJECT NAME(8) SPACE SPACE. "
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.
* 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.
REFRESH: BUF_T022D, BUF_TSP06, BUF_TSP06A,
BUF_TFO03, BUF_TFO04, BUF_TFO06,
BUF_TSP1D.
PERFORM IMPORT_RECORD.
WHILE END_OF_OBJDATA = FALSE AND SUBRC = 0.
CASE RECORD-COMMAND.
* print controls T022D (REPLACE ALL)
WHEN '022D'.
BUF_T022D = RECORD-DATA.
APPEND BUF_T022D.
* font families TFO01
WHEN 'FO01'. "ignore, no import
* printer fonts TFO03 (REPLACE ALL)
WHEN 'FO03'.
TFO03_LINE = RECORD-DATA.
BUF_TFO03-tdprinter = TFO03_LINE-ALL(8).
BUF_TFO03-tdfamily = TFO03_LINE-ALL+8(8).
BUF_TFO03-tdfontsize = TFO03_LINE-ALL+16(3).
BUF_TFO03-tdbold = TFO03_LINE-ALL+19(1).
BUF_TFO03-tditalic = TFO03_LINE-ALL+20(1).
BUF_TFO03-tdpprintid = TFO03_LINE-ALL+24(30).
BUF_TFO03-tdlprintid = TFO03_LINE-ALL+54(30).
BUF_TFO03-tdafmflag = TFO03_LINE-ALL+84(1).
BUF_TFO03-tdcpselect = TFO03_LINE-ALL+85(1).
BUF_TFO03-TDCPI = TFO03_LINE-CPI.
APPEND BUF_TFO03.
* printer font metrics TFO04 (REPLACE ALL)
WHEN 'FO04'.
BUF_TFO04 = RECORD-DATA.
APPEND BUF_TFO04.
* system barcodes TFO05
WHEN 'FO05'. "ignore, no import
* printer barcodes TFO06 (REPLACE ALL)
WHEN 'FO06'.
BUF_TFO06 = RECORD-DATA.
APPEND BUF_TFO06.
* device format summary TSP06A (REPLACE ALL)
WHEN 'SP6A'.
* BUF_TSP06A = RECORD-DATA.
clear buf_tsp06A.
tsp06a_line = record-data.
move-corresponding tsp06a_line to buf_tsp06a.
APPEND BUF_TSP06A.
WHEN 'SP6X'.
TSP06AX_LINE = RECORD-DATA.
DESCRIBE TABLE BUF_TSP06A LINES NUMLINES.
READ TABLE BUF_TSP06A WITH KEY
PTYPE = TSP06AX_LINE-PTYPE
PAPER = TSP06AX_LINE-PAPER.
IF SY-SUBRC = 0.
BUF_TSP06A-LSTDRIVER = TSP06AX_LINE-LSTDRIVER.
BUF_TSP06A-LSTSUBTYPE = TSP06AX_LINE-LSTSUBTYPE.
BUF_TSP06A-DRIVERINFO = TSP06AX_LINE-DRIVERINFO.
BUF_TSP06A-SPACEMODE = TSP06AX_LINE-SPACEMODE.
BUF_TSP06A-CHARWIDTH = TSP06AX_LINE-CHARWIDTH.
BUF_TSP06A-FONTSIZE = TSP06AX_LINE-FONTSIZE.
MODIFY BUF_TSP06A INDEX SY-TABIX.
ENDIF.
* device format details TSP06 (REPLACE ALL)
WHEN 'SP06'.
TSP06_LINE = RECORD-DATA.
* BUF_TSP06 = TSP06_LINE-ALL.
clear buf_tsp06.
buf_tsp06-pdptype = tsp06_line-all(8).
buf_tsp06-pdpaper = tsp06_line-all+8(16).
buf_tsp06-pdname = tsp06_line-all+24(8).
buf_tsp06-pddata = tsp06_line-all+34(72).
BUF_TSP06-PDLFDNR = TSP06_LINE-PDLFDNR.
BUF_TSP06-PDDATALEN = TSP06_LINE-PDDATALEN.
APPEND BUF_TSP06.
* spooler formats TSP1D (insert NEW only, do not change existing)
WHEN 'SP1D'.
* BUF_TSP1D = RECORD-DATA.
clear buf_tsp1d.
tsp1d_line = record-data.
move-corresponding tsp1d_line to buf_tsp1d.
APPEND BUF_TSP1D.
WHEN 'SP1X'.
TSP1DX_LINE = RECORD-DATA.
READ TABLE BUF_TSP1D WITH KEY
PAPART = TSP1DX_LINE-PAPART.
IF SY-SUBRC = 0.
BUF_TSP1D-LISTAREA = TSP1DX_LINE-LISTAREA.
BUF_TSP1D-MRG_TOP = TSP1DX_LINE-MRG_TOP.
BUF_TSP1D-MRG_LEFT = TSP1DX_LINE-MRG_LEFT.
BUF_TSP1D-MRG_BOT = TSP1DX_LINE-MRG_BOT.
BUF_TSP1D-MRG_RIGHT = TSP1DX_LINE-MRG_RIGHT.
MODIFY BUF_TSP1D INDEX NUMLINES.
ENDIF.
* 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!
WHEN FUNC_DEL_PAPER.
PAPER = RECORD-DATA.
* DELETE FROM TSP06 WHERE PDPTYPE = PAPER-PDPTYPE "B20K064895
* AND PDPAPER = PAPER-PDPAPER.
WHEN FUNC_DEL_PRIN. "B20K057010
* delete printer, tables will be deleted in UPDATE_PRIN_TABLES
PRINTER = NAME(8). "
DELETE FROM TSP0A WHERE PATYPE = PRINTER. "
PERFORM NEWPROT USING NLP_WAR NLP_LV2 NLP_MID '097' "
OBJECT NAME(8) SPACE SPACE. "
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.
* 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.
* insert entries from PRIN import buffered in BUF_... tables into DB
FORM UPDATE_PRIN_TABLES_FROM_BUFFER USING VALUE(PRINTER).
STATICS: NUM_DEVICE_FORMATS TYPE I,
TSP06_TIMESTAMP(6).
FORM UPDATE_PRIN_TABLES_FROM_BUFFER USING VALUE(PRINTER).
STATICS: NUM_DEVICE_FORMATS TYPE I,
TSP06_TIMESTAMP(6).
* formats
LOOP AT BUF_TSP1D. "B20K086195
MOVE-CORRESPONDING BUF_TSP1D TO TSP1D.
INSERT TSP1D. "only insert new items, no update of existing
ENDLOOP.
* print controls
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.
* printer fonts
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.
* printer font metrics
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.
* printer barcodes
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.
* device format summary - new in 4.0A
DELETE FROM TSP06A WHERE PTYPE = PRINTER. "B20K061850
LOOP AT BUF_TSP06A. "avoid runtime-error from ARRAY INSERT
BUF_TSP06A-PTYPE = PRINTER. MODIFY BUF_TSP06A.
ENDLOOP.
INSERT TSP06A FROM TABLE BUF_TSP06A.
DESCRIBE TABLE BUF_TSP06A LINES NUM_DEVICE_FORMATS.
* device format details
CLEAR TSP06A. "prepare TSP06A workarea "B20K061850
DELETE FROM TSP06 WHERE PDPTYPE = PRINTER.
LOOP AT BUF_TSP06. "avoid runtime-error from ARRAY INSERT
BUF_TSP06-PDPTYPE = PRINTER. MODIFY BUF_TSP06.
IF NUM_DEVICE_FORMATS = 0. "no TSP06A info in import data
* collect existing device formats from TSP06 for TSP06A
IF BUF_TSP06-PDNAME = 'CONTROL'. "B20K061850
IF BUF_TSP06-PDLFDNR = 1.
TSP06A-PTYPE = PRINTER.
TSP06A-PAPER = BUF_TSP06-PDPAPER.
TSP06A-VERSION = BUF_TSP06-PDDATA.
INSERT TSP06A.
ELSEIF BUF_TSP06-PDLFDNR = 2.
TSP06A-PTYPE = PRINTER.
TSP06A-PAPER = BUF_TSP06-PDPAPER.
* user info 1
TSP06A-CHGNAME1 = BUF_TSP06-PDDATA+0(12).
TSP06_TIMESTAMP = BUF_TSP06-PDDATA+12(6).
IF TSP06_TIMESTAMP <> SPACE.
TSP06A-CHGTSTMP1+2(6) = TSP06_TIMESTAMP.
PERFORM EXTEND_YEAR CHANGING TSP06A-CHGTSTMP1.
ELSE.
CLEAR TSP06A-CHGTSTMP1.
ENDIF.
TSP06A-CHGSAPSYS1 = BUF_TSP06-PDDATA+18(4).
TSP06A-CHGSAPREL1 = BUF_TSP06-PDDATA+22(4).
* user info 2
TSP06A-CHGNAME2 = BUF_TSP06-PDDATA+26(12).
TSP06_TIMESTAMP = BUF_TSP06-PDDATA+38(6).
IF TSP06_TIMESTAMP <> SPACE.
TSP06A-CHGTSTMP2+2(6) = TSP06_TIMESTAMP.
PERFORM EXTEND_YEAR CHANGING TSP06A-CHGTSTMP2.
ELSE.
CLEAR TSP06A-CHGTSTMP2.
ENDIF.
TSP06A-CHGSAPSYS2 = BUF_TSP06-PDDATA+44(4).
TSP06A-CHGSAPREL2 = BUF_TSP06-PDDATA+48(4).
* user info 3
TSP06A-CHGNAME3 = BUF_TSP06-PDDATA+52(12).
TSP06_TIMESTAMP = BUF_TSP06-PDDATA+64(6).
IF TSP06_TIMESTAMP <> SPACE.
TSP06A-CHGTSTMP3+2(6) = TSP06_TIMESTAMP.
PERFORM EXTEND_YEAR CHANGING TSP06A-CHGTSTMP3.
ELSE.
CLEAR TSP06A-CHGTSTMP3.
ENDIF.
TSP06A-CHGSAPSYS3 = ' '.
INSERT TSP06A. IF SY-SUBRC <> 0. UPDATE TSP06A. ENDIF.
ELSEIF BUF_TSP06-PDLFDNR = 3.
TSP06A-PTYPE = PRINTER.
TSP06A-PAPER = BUF_TSP06-PDPAPER.
TSP06A-POSTFLAG = BUF_TSP06-PDDATA+0(1).
TSP06A-CONVFLAG = BUF_TSP06-PDDATA+1(1).
IF TSP06A-CONVFLAG = 'X'.
TSP06A-CONVCODEP = BUF_TSP06-PDDATA+2(4).
ELSE.
CLEAR TSP06A-CONVCODEP.
ENDIF.
INSERT TSP06A. IF SY-SUBRC <> 0. UPDATE TSP06A. ENDIF.
ELSEIF BUF_TSP06-PDLFDNR = 4. "4.0A only
TSP06A-BASE = BUF_TSP06-PDDATA.
INSERT TSP06A. IF SY-SUBRC <> 0. UPDATE TSP06A. ENDIF.
ENDIF.
ENDIF.
ENDIF.
ENDLOOP.
INSERT TSP06 FROM TABLE BUF_TSP06.
* release memory for table buffers
FREE: BUF_T022D, BUF_TSP06, BUF_TSP06A,
BUF_TFO03, BUF_TFO04, BUF_TFO06.
ENDFORM.
LOOP AT BUF_TSP1D. "B20K086195
MOVE-CORRESPONDING BUF_TSP1D TO TSP1D.
INSERT TSP1D. "only insert new items, no update of existing
ENDLOOP.
* print controls
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.
* printer fonts
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.
* printer font metrics
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.
* printer barcodes
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.
* device format summary - new in 4.0A
DELETE FROM TSP06A WHERE PTYPE = PRINTER. "B20K061850
LOOP AT BUF_TSP06A. "avoid runtime-error from ARRAY INSERT
BUF_TSP06A-PTYPE = PRINTER. MODIFY BUF_TSP06A.
ENDLOOP.
INSERT TSP06A FROM TABLE BUF_TSP06A.
DESCRIBE TABLE BUF_TSP06A LINES NUM_DEVICE_FORMATS.
* device format details
CLEAR TSP06A. "prepare TSP06A workarea "B20K061850
DELETE FROM TSP06 WHERE PDPTYPE = PRINTER.
LOOP AT BUF_TSP06. "avoid runtime-error from ARRAY INSERT
BUF_TSP06-PDPTYPE = PRINTER. MODIFY BUF_TSP06.
IF NUM_DEVICE_FORMATS = 0. "no TSP06A info in import data
* collect existing device formats from TSP06 for TSP06A
IF BUF_TSP06-PDNAME = 'CONTROL'. "B20K061850
IF BUF_TSP06-PDLFDNR = 1.
TSP06A-PTYPE = PRINTER.
TSP06A-PAPER = BUF_TSP06-PDPAPER.
TSP06A-VERSION = BUF_TSP06-PDDATA.
INSERT TSP06A.
ELSEIF BUF_TSP06-PDLFDNR = 2.
TSP06A-PTYPE = PRINTER.
TSP06A-PAPER = BUF_TSP06-PDPAPER.
* user info 1
TSP06A-CHGNAME1 = BUF_TSP06-PDDATA+0(12).
TSP06_TIMESTAMP = BUF_TSP06-PDDATA+12(6).
IF TSP06_TIMESTAMP <> SPACE.
TSP06A-CHGTSTMP1+2(6) = TSP06_TIMESTAMP.
PERFORM EXTEND_YEAR CHANGING TSP06A-CHGTSTMP1.
ELSE.
CLEAR TSP06A-CHGTSTMP1.
ENDIF.
TSP06A-CHGSAPSYS1 = BUF_TSP06-PDDATA+18(4).
TSP06A-CHGSAPREL1 = BUF_TSP06-PDDATA+22(4).
* user info 2
TSP06A-CHGNAME2 = BUF_TSP06-PDDATA+26(12).
TSP06_TIMESTAMP = BUF_TSP06-PDDATA+38(6).
IF TSP06_TIMESTAMP <> SPACE.
TSP06A-CHGTSTMP2+2(6) = TSP06_TIMESTAMP.
PERFORM EXTEND_YEAR CHANGING TSP06A-CHGTSTMP2.
ELSE.
CLEAR TSP06A-CHGTSTMP2.
ENDIF.
TSP06A-CHGSAPSYS2 = BUF_TSP06-PDDATA+44(4).
TSP06A-CHGSAPREL2 = BUF_TSP06-PDDATA+48(4).
* user info 3
TSP06A-CHGNAME3 = BUF_TSP06-PDDATA+52(12).
TSP06_TIMESTAMP = BUF_TSP06-PDDATA+64(6).
IF TSP06_TIMESTAMP <> SPACE.
TSP06A-CHGTSTMP3+2(6) = TSP06_TIMESTAMP.
PERFORM EXTEND_YEAR CHANGING TSP06A-CHGTSTMP3.
ELSE.
CLEAR TSP06A-CHGTSTMP3.
ENDIF.
TSP06A-CHGSAPSYS3 = ' '.
INSERT TSP06A. IF SY-SUBRC <> 0. UPDATE TSP06A. ENDIF.
ELSEIF BUF_TSP06-PDLFDNR = 3.
TSP06A-PTYPE = PRINTER.
TSP06A-PAPER = BUF_TSP06-PDPAPER.
TSP06A-POSTFLAG = BUF_TSP06-PDDATA+0(1).
TSP06A-CONVFLAG = BUF_TSP06-PDDATA+1(1).
IF TSP06A-CONVFLAG = 'X'.
TSP06A-CONVCODEP = BUF_TSP06-PDDATA+2(4).
ELSE.
CLEAR TSP06A-CONVCODEP.
ENDIF.
INSERT TSP06A. IF SY-SUBRC <> 0. UPDATE TSP06A. ENDIF.
ELSEIF BUF_TSP06-PDLFDNR = 4. "4.0A only
TSP06A-BASE = BUF_TSP06-PDDATA.
INSERT TSP06A. IF SY-SUBRC <> 0. UPDATE TSP06A. ENDIF.
ENDIF.
ENDIF.
ENDIF.
ENDLOOP.
INSERT TSP06 FROM TABLE BUF_TSP06.
* release memory for table buffers
FREE: BUF_T022D, BUF_TSP06, BUF_TSP06A,
BUF_TFO03, BUF_TFO04, BUF_TFO06.
ENDFORM.
* convert 2-digit year to 4-digit for TSP06A timestamps
FORM EXTEND_YEAR CHANGING TSTMP. "B20K061850
STATICS: Y TYPE I.
FORM EXTEND_YEAR CHANGING TSTMP. "B20K061850
STATICS: Y TYPE I.
IF NOT TSTMP IS INITIAL.
Y = TSTMP+2(2).
IF Y < 50.
TSTMP(2) = '20'.
ELSE.
TSTMP(2) = '19'.
ENDIF.
TSTMP+8(6) = '000000'.
ENDIF.
ENDFORM.
Y = TSTMP+2(2).
IF Y < 50.
TSTMP(2) = '20'.
ELSE.
TSTMP(2) = '19'.
ENDIF.
TSTMP+8(6) = '000000'.
ENDIF.
ENDFORM.
* call function SAVE_TEXT to save a single HEADER + LINES
* RC = 0 if o.k.
* RC > 0 if error, and message number+parameters are returned in ITCRS
* IF RC = 2 then language does not exist in target system
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.
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.
* RC = 0 if o.k.
* RC > 0 if error, and message number+parameters are returned in ITCRS
* IF RC = 2 then language does not exist in target system
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.
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.
* delete a style/layout set
FORM DELETE_OBJECT USING VALUE(OBJECT) VALUE(NAME).
DATA: FORMNAME LIKE ITCTA-TDFORM,
STYLENAME LIKE ITCDA-TDSTYLE,
FOUND LIKE BOOLEAN.
FORM DELETE_OBJECT USING VALUE(OBJECT) VALUE(NAME).
DATA: FORMNAME LIKE ITCTA-TDFORM,
STYLENAME LIKE ITCDA-TDSTYLE,
FOUND LIKE BOOLEAN.
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.
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.
* set custom language vector
FORM SET_CUSTOM_LANGUAGE_VECTOR USING VALUE(LANGVEC).
STATICS: LEN LIKE SY-FDPOS.
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). "B20K049191
ENDIF.
ENDIF.
ENDFORM.
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). "B20K049191
ENDIF.
ENDIF.
ENDFORM.
* for FORM/STYL transport: get current language vector to be
* used for export/import in LANGVEC
* returns sy-subrc = 0 if o.k., else 1
FORM GET_LANGUAGE_VECTOR CHANGING LANGVEC.
STATICS: MASTERLANG_ONLY LIKE BOOLEAN.
* used for export/import in LANGVEC
* returns sy-subrc = 0 if o.k., else 1
FORM GET_LANGUAGE_VECTOR CHANGING LANGVEC.
STATICS: MASTERLANG_ONLY LIKE BOOLEAN.
* 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.
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.
SY-SUBRC = 1.
ENDIF.
ENDFORM.
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.
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.
SY-SUBRC = 1.
ENDIF.
ENDFORM.
FORM SET_MESSAGE_LANGUAGE USING VALUE(LANG). "B20K065126
IF MESSAGE_LANGUAGE = SPACE.
MESSAGE_LANGUAGE = LANG.
ENDIF.
ENDFORM.
IF MESSAGE_LANGUAGE = SPACE.
MESSAGE_LANGUAGE = LANG.
ENDIF.
ENDFORM.
FORM GET_MESSAGE_LANGUAGE USING LANG.
LANG = MESSAGE_LANGUAGE.
IF LANG = SPACE.
LANG = SY-LANGU.
ENDIF.
ENDFORM.
LANG = MESSAGE_LANGUAGE.
IF LANG = SPACE.
LANG = SY-LANGU.
ENDIF.
ENDFORM.
*********************
* Basic Procedures
*********************
* Basic Procedures
*********************
* set binary file format flag
FORM SET_BINARY_FILE_FORMAT USING VALUE(BINFILE_FLAG).
STATICS: APPL_SYSCP LIKE TCP00-CPCODEPAGE.
FORM SET_BINARY_FILE_FORMAT USING VALUE(BINFILE_FLAG).
STATICS: APPL_SYSCP LIKE TCP00-CPCODEPAGE.
CALL FUNCTION 'SYSTEM_CODEPAGE'
IMPORTING
CODEPAGE = APPL_SYSCP
CURRENT_DYNAMIC_CODEPAGE = SYSTEM_CODEPAGE.
IF SYSTEM_CODEPAGE(2) = '41'.
R3_INTERNAL_CHARSET = C_CHARSET_UNICODE.
RECORD_NUMBYTES = 2 * C_RECORD_NUMCHARS.
ELSE.
RECORD_NUMBYTES = C_RECORD_NUMCHARS.
IF SYSTEM_CODEPAGE(1) = '0'.
R3_INTERNAL_CHARSET = C_CHARSET_EBCDIC.
ELSE.
R3_INTERNAL_CHARSET = C_CHARSET_ASCII.
ENDIF.
ENDIF.
IF BINFILE_FLAG = TRUE.
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.
IMPORTING
CODEPAGE = APPL_SYSCP
CURRENT_DYNAMIC_CODEPAGE = SYSTEM_CODEPAGE.
IF SYSTEM_CODEPAGE(2) = '41'.
R3_INTERNAL_CHARSET = C_CHARSET_UNICODE.
RECORD_NUMBYTES = 2 * C_RECORD_NUMCHARS.
ELSE.
RECORD_NUMBYTES = C_RECORD_NUMCHARS.
IF SYSTEM_CODEPAGE(1) = '0'.
R3_INTERNAL_CHARSET = C_CHARSET_EBCDIC.
ELSE.
R3_INTERNAL_CHARSET = C_CHARSET_ASCII.
ENDIF.
ENDIF.
IF BINFILE_FLAG = TRUE.
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 sy-subrc = 0 if BINARY format wanted
FORM GET_BINARY_FILE_FORMAT_FLAG.
IF BINARY_FILE_FORMAT_VALID = BINARY_FILE_FORMAT_MAGIC.
SY-SUBRC = 0.
ELSE.
SY-SUBRC = 1.
ENDIF.
ENDFORM.
FORM GET_BINARY_FILE_FORMAT_FLAG.
IF BINARY_FILE_FORMAT_VALID = BINARY_FILE_FORMAT_MAGIC.
SY-SUBRC = 0.
ELSE.
SY-SUBRC = 1.
ENDIF.
ENDFORM.
FORM SET_FILE_SOURCE USING VALUE(LOCALFILE). "B20K053928
IF LOCALFILE = TRUE.
FILE_SOURCE_LOCAL = FILE_SOURCE_LOCAL_MAGIC.
ELSE.
FILE_SOURCE_LOCAL = SPACE.
ENDIF.
ENDFORM.
IF LOCALFILE = TRUE.
FILE_SOURCE_LOCAL = FILE_SOURCE_LOCAL_MAGIC.
ELSE.
FILE_SOURCE_LOCAL = SPACE.
ENDIF.
ENDFORM.
* set sy-subrc = 0 if file source is LOCAL (GUI)
FORM GET_FILE_SOURCE. "B20K053928
IF FILE_SOURCE_LOCAL = FILE_SOURCE_LOCAL_MAGIC.
SY-SUBRC = 0.
ELSE.
SY-SUBRC = 1.
ENDIF.
ENDFORM.
FORM GET_FILE_SOURCE. "B20K053928
IF FILE_SOURCE_LOCAL = FILE_SOURCE_LOCAL_MAGIC.
SY-SUBRC = 0.
ELSE.
SY-SUBRC = 1.
ENDIF.
ENDFORM.
* set MASTERLANGUAGE_ONLY mode (3.1G export)
FORM SET_MASTERLANG_ONLY_FLAG USING VALUE(FLAG). "B20K057147
IF FLAG = TRUE.
MASTERLANG_ONLY_FLAG = MASTERLANG_ONLY_MAGIC.
ELSE.
MASTERLANG_ONLY_FLAG = SPACE.
ENDIF.
ENDFORM.
FORM SET_MASTERLANG_ONLY_FLAG USING VALUE(FLAG). "B20K057147
IF FLAG = TRUE.
MASTERLANG_ONLY_FLAG = MASTERLANG_ONLY_MAGIC.
ELSE.
MASTERLANG_ONLY_FLAG = SPACE.
ENDIF.
ENDFORM.
* set sy-subrc = 0 if masterlang_only mode is active
FORM GET_MASTERLANG_ONLY_FLAG. "B20K057147
IF MASTERLANG_ONLY_FLAG = MASTERLANG_ONLY_MAGIC.
SY-SUBRC = 0.
ELSE.
SY-SUBRC = 1.
ENDIF.
ENDFORM.
FORM GET_MASTERLANG_ONLY_FLAG. "B20K057147
IF MASTERLANG_ONLY_FLAG = MASTERLANG_ONLY_MAGIC.
SY-SUBRC = 0.
ELSE.
SY-SUBRC = 1.
ENDIF.
ENDFORM.
FORM EXPORT_TA.
RECORD-TYP = 'T'.
RECORD-COMMAND = 'COMM'.
RECORD-DATA = TRKORR.
PERFORM EXPORT_CLIPBOARD USING FALSE. "not end_of_obj
ENDFORM.
RECORD-TYP = 'T'.
RECORD-COMMAND = 'COMM'.
RECORD-DATA = TRKORR.
PERFORM EXPORT_CLIPBOARD USING FALSE. "not end_of_obj
ENDFORM.
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.
RECORD-TYP = 'S'.
RECORD-COMMAND = OBJECT.
RECORD-DATA = OBJ_NAME.
PERFORM EXPORT_CLIPBOARD USING FALSE. "not end_of_obj
ENDFORM.
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.
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 dummy entry
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.
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 function like activate...
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.
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.
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.
CLEAR RECORD.
RECORD-TYP = 'E'.
IF CLIPBOARD = TRUE.
PERFORM EXPORT_CLIPBOARD USING TRUE. "end_of_obj
ELSE.
PERFORM EXPDATA(RDDDIC00) USING RECORD.
ENDIF.
ENDFORM.
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.
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.
* read header line of TA with TCOMM<transportname>
* sets RC to 0 if o.k else > 0
* only used when reading dataset with RSTXR3TR
FORM IMPORT_TA USING 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 'T' OR RECORD-COMMAND NE 'COMM'.
* transport header was not found
PERFORM NEWPROT USING NLP_ERR NLP_LV2 NLP_MID '075'
RECORD-TYP RECORD-COMMAND SPACE SPACE.
RC = 1.
EXIT.
ENDIF.
IF RECORD-DATA NE TRKORR.
* transport number ... and content of file ... differ
PERFORM NEWPROT USING NLP_ERR NLP_LV2 NLP_MID '076'
TRKORR RECORD-DATA SPACE SPACE.
RC = 1.
EXIT.
ENDIF.
ENDFORM.
* sets RC to 0 if o.k else > 0
* only used when reading dataset with RSTXR3TR
FORM IMPORT_TA USING 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 'T' OR RECORD-COMMAND NE 'COMM'.
* transport header was not found
PERFORM NEWPROT USING NLP_ERR NLP_LV2 NLP_MID '075'
RECORD-TYP RECORD-COMMAND SPACE SPACE.
RC = 1.
EXIT.
ENDIF.
IF RECORD-DATA NE TRKORR.
* transport number ... and content of file ... differ
PERFORM NEWPROT USING NLP_ERR NLP_LV2 NLP_MID '076'
TRKORR RECORD-DATA SPACE SPACE.
RC = 1.
EXIT.
ENDIF.
ENDFORM.
* read header line of TA with S<objectname>
* sets RC to 0 if o.k else > 0
* only used when reading DATASET with RSTXSCRP
FORM IMPORT_SAPSCRIPT USING OBJECT OBJ_NAME RC.
STATICS: TYPCMD(5),
SOBJ(10).
* sets RC to 0 if o.k else > 0
* only used when reading DATASET with RSTXSCRP
FORM IMPORT_SAPSCRIPT USING OBJECT OBJ_NAME RC.
STATICS: TYPCMD(5),
SOBJ(10).
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 ...
TYPCMD = RECORD-TYP. TYPCMD+1 = RECORD-COMMAND.
SOBJ = 'S'. SOBJ+1 = OBJECT.
PERFORM NEWPROT USING NLP_ERR NLP_LV2 NLP_MID '085'
TYPCMD SOBJ SPACE SPACE.
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.
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 ...
TYPCMD = RECORD-TYP. TYPCMD+1 = RECORD-COMMAND.
SOBJ = 'S'. SOBJ+1 = OBJECT.
PERFORM NEWPROT USING NLP_ERR NLP_LV2 NLP_MID '085'
TYPCMD SOBJ SPACE SPACE.
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.
* read header entry in file, i.e. HTEXT, HPRIN, HFORM, HSTYL
*
* sets globals OBJECT, NAME
*
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.
*
* sets globals OBJECT, NAME
*
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.
* read a single line from DATASET or TA
* sets SUBRC...
* if the end marker "E" is read, the END_OF_OBJDATA flag is set to TRUE
FORM IMPORT_RECORD.
DATA: RC LIKE SY-SUBRC.
* sets SUBRC...
* if the end marker "E" is read, the END_OF_OBJDATA flag is set to TRUE
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.
ENDIF.
SUBRC = 0.
ENDFORM.
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.
ENDIF.
SUBRC = 0.
ENDFORM.
* read all remaining records from IMPORT file. We might have stopped
* reading in the middle of an object due to an error
* this is done ONLY if we are called from the "official" transporter
* i.e. not from RSTXR3TR or RSTXSCRP.
* Careful: We MUST NOT read again if the IMPDATA routine has already
* delivered us a RC <> 0 because then we would overread
* the next object record!
* To prevent this, the END_OF_DATA flag is used
FORM SKIP_UNREAD_RECORDS.
DATA: COUNT LIKE INTEGER.
* reading in the middle of an object due to an error
* this is done ONLY if we are called from the "official" transporter
* i.e. not from RSTXR3TR or RSTXSCRP.
* Careful: We MUST NOT read again if the IMPDATA routine has already
* delivered us a RC <> 0 because then we would overread
* the next object record!
* To prevent this, the END_OF_DATA flag is used
FORM SKIP_UNREAD_RECORDS.
DATA: COUNT LIKE INTEGER.
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.
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.
* interface to transport software: call form IMPDATA to get next record
* RC returns IMPDATA's return code
* ATTENTION: structure RECORD must be passed as REC parameter!
FORM CALL_IMPDATA USING REC RC.
PERFORM IMPDATA(RDDDIC10) USING REC RC.
IF RC <> 0.
END_OF_DATA = TRUE.
ENDIF.
ENDFORM.
* RC returns IMPDATA's return code
* ATTENTION: structure RECORD must be passed as REC parameter!
FORM CALL_IMPDATA USING REC RC.
PERFORM IMPDATA(RDDDIC10) USING REC RC.
IF RC <> 0.
END_OF_DATA = TRUE.
ENDIF.
ENDFORM.
* export a single text (=HEADER from STXH and LINES from STXL)
* it is used for TEXT, STYL and FORM objects
* the flag LANGUAGE_ONLY controls the state how FORM/STYL is
* exported/imported:
* LANGUAGE_ONLY = FALSE -> object is exported/imported as MOD
* = TRUE -> object is exported/imported as ACT
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.
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.
* it is used for TEXT, STYL and FORM objects
* the flag LANGUAGE_ONLY controls the state how FORM/STYL is
* exported/imported:
* LANGUAGE_ONLY = FALSE -> object is exported/imported as MOD
* = TRUE -> object is exported/imported as ACT
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.
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.
* convert binary text in LINES table to ASCII format
FORM CONVERT_LINES_BIN_2_ASCII.
DATA BEGIN OF L OCCURS 100.
INCLUDE STRUCTURE TLINE.
DATA END OF L.
FIELD-SYMBOLS <P>.
FORM CONVERT_LINES_BIN_2_ASCII.
DATA BEGIN OF L OCCURS 100.
INCLUDE STRUCTURE TLINE.
DATA END OF L.
FIELD-SYMBOLS <P>.
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 <P>.
PERFORM CONV_BIN_2_HEX USING LINES-TDFORMAT+1(1) <P>.
* convert line(1..65)
DO 65 TIMES.
ASSIGN <P>+2(2) TO <P>.
PERFORM CONV_BIN_2_HEX USING LINES-TDLINE(1) <P>.
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 <P>.
PERFORM CONV_BIN_2_HEX USING LINES-TDLINE(1) <P>.
SHIFT LINES-TDLINE.
* convert line(68..132)
DO 65 TIMES.
ASSIGN <P>+2(2) TO <P>.
PERFORM CONV_BIN_2_HEX USING LINES-TDLINE(1) <P>.
SHIFT LINES-TDLINE.
ENDDO.
APPEND L.
ENDLOOP.
REFRESH LINES.
LOOP AT L.
LINES = L. APPEND LINES.
ENDLOOP.
FREE L.
ENDFORM.
LOOP AT LINES.
* convert format
CLEAR L.
PERFORM CONV_BIN_2_HEX USING LINES-TDFORMAT(1) L-TDFORMAT.
ASSIGN L-TDLINE(2) TO <P>.
PERFORM CONV_BIN_2_HEX USING LINES-TDFORMAT+1(1) <P>.
* convert line(1..65)
DO 65 TIMES.
ASSIGN <P>+2(2) TO <P>.
PERFORM CONV_BIN_2_HEX USING LINES-TDLINE(1) <P>.
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 <P>.
PERFORM CONV_BIN_2_HEX USING LINES-TDLINE(1) <P>.
SHIFT LINES-TDLINE.
* convert line(68..132)
DO 65 TIMES.
ASSIGN <P>+2(2) TO <P>.
PERFORM CONV_BIN_2_HEX USING LINES-TDLINE(1) <P>.
SHIFT LINES-TDLINE.
ENDDO.
APPEND L.
ENDLOOP.
REFRESH LINES.
LOOP AT L.
LINES = L. APPEND LINES.
ENDLOOP.
FREE L.
ENDFORM.
* convert ASCII text in LINES table to binary
FORM CONVERT_LINES_ASCII_2_BIN.
DATA BEGIN OF L OCCURS 100.
INCLUDE STRUCTURE TLINE.
DATA END OF L.
FIELD-SYMBOLS <P>.
DATA L_OFFS TYPE I.
FORM CONVERT_LINES_ASCII_2_BIN.
DATA BEGIN OF L OCCURS 100.
INCLUDE STRUCTURE TLINE.
DATA END OF L.
FIELD-SYMBOLS <P>.
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 <P>.
DO 65 TIMES.
PERFORM CONV_HEX_2_BIN USING LINES-TDLINE(2) <P>.
SHIFT LINES-TDLINE BY 2 PLACES.
ASSIGN <P>+1(1) TO <P>.
ENDDO.
L_OFFS = 65.
ELSE. "middle of a l-line
ASSIGN L-TDLINE+65(1) TO <P>.
* convert LINES-TDFORMAT
PERFORM CONV_HEX_2_BIN USING LINES-TDFORMAT <P>.
* convert LINES-TDLINE
DO 66 TIMES.
ASSIGN <P>+1(1) TO <P>.
PERFORM CONV_HEX_2_BIN USING LINES-TDLINE(2) <P>.
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.
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 <P>.
DO 65 TIMES.
PERFORM CONV_HEX_2_BIN USING LINES-TDLINE(2) <P>.
SHIFT LINES-TDLINE BY 2 PLACES.
ASSIGN <P>+1(1) TO <P>.
ENDDO.
L_OFFS = 65.
ELSE. "middle of a l-line
ASSIGN L-TDLINE+65(1) TO <P>.
* convert LINES-TDFORMAT
PERFORM CONV_HEX_2_BIN USING LINES-TDFORMAT <P>.
* convert LINES-TDLINE
DO 66 TIMES.
ASSIGN <P>+1(1) TO <P>.
PERFORM CONV_HEX_2_BIN USING LINES-TDLINE(2) <P>.
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.
* set original language of style/layout set in target system
* OBJECT=FORM/STYL
FORM SET_OLANGUAGE USING VALUE(OBJECT) VALUE(OLANG) VALUE(LANGVEC).
DATA: TDNAME LIKE THEAD-TDNAME,
TDOBJECT LIKE THEAD-TDOBJECT,
TDOLANG LIKE THEAD-TDSPRAS.
* OBJECT=FORM/STYL
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.
ENDIF.
ENDFORM.
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.
ENDIF.
ENDFORM.
* activate STYLE,FORM
FORM ACTIVATE_OBJECT.
DATA: STYLE LIKE ITCDA-TDSTYLE,
FORM LIKE ITCTA-TDFORM.
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.
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.
***************************************
* routines for interfacing correction system
***************************************
* routines for interfacing correction system
***************************************
FORM GET_TA. "B20K070087
CALL FUNCTION 'TR_READ_COMM'
EXPORTING
WI_TRKORR = TRKORR
* WI_DIALOG = 'X'
* WI_LANGU = SY-LANGU
* WI_SEL_E070 = ' '
WI_SEL_E071 = 'X'
* WI_SEL_E071K = ' '
* IV_SEL_E071KF = ' '
* WI_SEL_E07T = ' '
* WI_SEL_E070C = ' '
* IV_SEL_E070M = ' '
* IMPORTING
* WE_E070 =
* WE_E07T =
* WE_E070C =
* ES_E070M =
* WE_E07T_DOESNT_EXIST =
* WE_E070C_DOESNT_EXIST =
* EV_E070M_DOESNT_EXIST =
TABLES
WT_E071 = E071_TAB
* WT_E071K =
* ET_E071KF =
EXCEPTIONS
NOT_EXIST_E070 = 1
NO_AUTHORIZATION = 2.
IF SY-SUBRC <> 0.
MESSAGE A051 WITH TRKORR.
ENDIF.
ENDFORM. "B20K070087
CALL FUNCTION 'TR_READ_COMM'
EXPORTING
WI_TRKORR = TRKORR
* WI_DIALOG = 'X'
* WI_LANGU = SY-LANGU
* WI_SEL_E070 = ' '
WI_SEL_E071 = 'X'
* WI_SEL_E071K = ' '
* IV_SEL_E071KF = ' '
* WI_SEL_E07T = ' '
* WI_SEL_E070C = ' '
* IV_SEL_E070M = ' '
* IMPORTING
* WE_E070 =
* WE_E07T =
* WE_E070C =
* ES_E070M =
* WE_E07T_DOESNT_EXIST =
* WE_E070C_DOESNT_EXIST =
* EV_E070M_DOESNT_EXIST =
TABLES
WT_E071 = E071_TAB
* WT_E071K =
* ET_E071KF =
EXCEPTIONS
NOT_EXIST_E070 = 1
NO_AUTHORIZATION = 2.
IF SY-SUBRC <> 0.
MESSAGE A051 WITH TRKORR.
ENDIF.
ENDFORM. "B20K070087
***************************************
* routines for data conversion, codepage handling, UNICODE
***************************************
* routines for data conversion, codepage handling, UNICODE
***************************************
* convert 1-ascii digit to 1 hex byte,
* 0 -> $30
* 1 -> $31
* ...
* 9 -> $39
FORM CONVERT_DIGIT_TO_HEXBYTE USING VALUE(DIGIT) BYTE TYPE X.
CASE DIGIT.
WHEN '1'. BYTE = '31'.
WHEN '2'. BYTE = '32'.
WHEN '3'. BYTE = '33'.
WHEN '4'. BYTE = '34'.
WHEN '5'. BYTE = '35'.
WHEN '6'. BYTE = '36'.
WHEN '7'. BYTE = '37'.
WHEN '8'. BYTE = '38'.
WHEN '9'. BYTE = '39'.
WHEN OTHERS. BYTE = '30'.
ENDCASE.
ENDFORM.
* 0 -> $30
* 1 -> $31
* ...
* 9 -> $39
FORM CONVERT_DIGIT_TO_HEXBYTE USING VALUE(DIGIT) BYTE TYPE X.
CASE DIGIT.
WHEN '1'. BYTE = '31'.
WHEN '2'. BYTE = '32'.
WHEN '3'. BYTE = '33'.
WHEN '4'. BYTE = '34'.
WHEN '5'. BYTE = '35'.
WHEN '6'. BYTE = '36'.
WHEN '7'. BYTE = '37'.
WHEN '8'. BYTE = '38'.
WHEN '9'. BYTE = '39'.
WHEN OTHERS. BYTE = '30'.
ENDCASE.
ENDFORM.
* convert 1 hex byte to 1 ascii digit
* $30 -> 0
* $31 -> 1
* ...
* $39 -> 9
FORM CONVERT_HEXBYTE_TO_DIGIT USING VALUE(HEXBYTE) TYPE X
DIGIT.
CASE HEXBYTE.
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.
* $30 -> 0
* $31 -> 1
* ...
* $39 -> 9
FORM CONVERT_HEXBYTE_TO_DIGIT USING VALUE(HEXBYTE) TYPE X
DIGIT.
CASE HEXBYTE.
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 hex byte to 2 ascii characters (1st two chars of CHARFIELD)
FORM CONV_BIN_2_HEX USING VALUE(BYTECHAR) type c
CHARFIELD type c.
statics: x type x,
c2(2) type c.
field-symbols <p>.
FORM CONV_BIN_2_HEX USING VALUE(BYTECHAR) type c
CHARFIELD type c.
statics: x type x,
c2(2) type c.
field-symbols <p>.
assign bytechar to <p> type 'X'.
x = <p>.
c2 = x.
CHARFIELD = c2.
ENDFORM.
x = <p>.
c2 = x.
CHARFIELD = c2.
ENDFORM.
* convert 2 ascii characters to single hex byte
FORM CONV_HEX_2_BIN USING VALUE(CHARFIELD) type c
BYTECHAR type c.
statics: x type x,
c2(2) type c.
field-symbols <p>.
FORM CONV_HEX_2_BIN USING VALUE(CHARFIELD) type c
BYTECHAR type c.
statics: x type x,
c2(2) type c.
field-symbols <p>.
c2 = charfield.
case c2+1(1).
when '1'. x = 1.
when '2'. x = 2.
when '3'. x = 3.
when '4'. x = 4.
when '5'. x = 5.
when '6'. x = 6.
when '7'. x = 7.
when '8'. x = 8.
when '9'. x = 9.
when 'A'. x = 10.
when 'B'. x = 11.
when 'C'. x = 12.
when 'D'. x = 13.
when 'E'. x = 14.
when 'F'. x = 15.
when others. x = 0.
endcase.
case c2(1).
when '1'. x = x + 1 * 16.
when '2'. x = x + 2 * 16.
when '3'. x = x + 3 * 16.
when '4'. x = x + 4 * 16.
when '5'. x = x + 5 * 16.
when '6'. x = x + 6 * 16.
when '7'. x = x + 7 * 16.
when '8'. x = x + 8 * 16.
when '9'. x = x + 9 * 16.
when 'A'. x = x + 10 * 16.
when 'B'. x = x + 11 * 16.
when 'C'. x = x + 12 * 16.
when 'D'. x = x + 13 * 16.
when 'E'. x = x + 14 * 16.
when 'F'. x = x + 15 * 16.
endcase.
assign bytechar to <p> type 'X'.
<p> = x.
ENDFORM.
case c2+1(1).
when '1'. x = 1.
when '2'. x = 2.
when '3'. x = 3.
when '4'. x = 4.
when '5'. x = 5.
when '6'. x = 6.
when '7'. x = 7.
when '8'. x = 8.
when '9'. x = 9.
when 'A'. x = 10.
when 'B'. x = 11.
when 'C'. x = 12.
when 'D'. x = 13.
when 'E'. x = 14.
when 'F'. x = 15.
when others. x = 0.
endcase.
case c2(1).
when '1'. x = x + 1 * 16.
when '2'. x = x + 2 * 16.
when '3'. x = x + 3 * 16.
when '4'. x = x + 4 * 16.
when '5'. x = x + 5 * 16.
when '6'. x = x + 6 * 16.
when '7'. x = x + 7 * 16.
when '8'. x = x + 8 * 16.
when '9'. x = x + 9 * 16.
when 'A'. x = x + 10 * 16.
when 'B'. x = x + 11 * 16.
when 'C'. x = x + 12 * 16.
when 'D'. x = x + 13 * 16.
when 'E'. x = x + 14 * 16.
when 'F'. x = x + 15 * 16.
endcase.
assign bytechar to <p> type 'X'.
<p> = x.
ENDFORM.
***************************************
* protocol/message handling routines
***************************************
* protocol/message handling routines
***************************************
* new protocol routine which uses the
* new protocol interface of transporter: NEW_LOGPROT
FORM NEWPROT USING VALUE(SEVERITY) VALUE(LEVEL) VALUE(MESGID)
VALUE(NUM) VALUE(P1) VALUE(P2) VALUE(P3) VALUE(P4).
* new protocol interface of transporter: NEW_LOGPROT
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 AND EXTERNAL_PROTOCOL = SPACE. "B20K055867
* transport online via RSTXR3TR,RSTXSCRP
FORMAT COLOR COL_KEY.
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.
ENDIF.
ENDFORM.
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 AND EXTERNAL_PROTOCOL = SPACE. "B20K055867
* transport online via RSTXR3TR,RSTXSCRP
FORMAT COLOR COL_KEY.
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.
ENDIF.
ENDFORM.
* write a message from T100...
FORM WRITE_MSG USING VALUE(ABG) VALUE(NUM)
VALUE(P1) VALUE(P2) VALUE(P3) VALUE(P4).
STATICS: LN(250) TYPE C,
MSLANG LIKE SY-LANGU.
FORM WRITE_MSG USING VALUE(ABG) VALUE(NUM)
VALUE(P1) VALUE(P2) VALUE(P3) VALUE(P4).
STATICS: LN(250) TYPE C,
MSLANG LIKE SY-LANGU.
PERFORM GET_MESSAGE_LANGUAGE USING MSLANG. "B20K065126
SELECT SINGLE * FROM T100 WHERE SPRSL = MSLANG "
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'(052).
REPLACE '&' WITH ABG INTO LN. CONDENSE LN.
REPLACE '&' WITH NUM INTO LN. CONDENSE LN.
REPLACE '&' WITH MESSAGE_LANGUAGE INTO LN. CONDENSE LN.
WRITE LN(120).
ENDIF.
ENDFORM.
SELECT SINGLE * FROM T100 WHERE SPRSL = MSLANG "
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'(052).
REPLACE '&' WITH ABG INTO LN. CONDENSE LN.
REPLACE '&' WITH NUM INTO LN. CONDENSE LN.
REPLACE '&' WITH MESSAGE_LANGUAGE INTO LN. CONDENSE LN.
WRITE LN(120).
ENDIF.
ENDFORM.
***************************************
* file (=clipboard) import/export handling routines
***************************************
* file (=clipboard) import/export handling routines
***************************************
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
PERFORM FILE_WRITE_RECORD USING FILENAME 'T'. "B20K053928
ENDIF.
IF LIST_FILE_CONTENTS = 'X'.
FORMAT COLOR COL_NORMAL.
WRITE: / RECORD.
ENDIF.
ENDFORM.
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
PERFORM FILE_WRITE_RECORD USING FILENAME 'T'. "B20K053928
ENDIF.
IF LIST_FILE_CONTENTS = 'X'.
FORMAT COLOR COL_NORMAL.
WRITE: / RECORD.
ENDIF.
ENDFORM.
* exports binfile header including codepage in a binary representation
* in hex, this reads:
* FF 52 53 54 58 <codepage>
FORM EXPORT_CLIPBOARD_BIN_HEADER.
STATICS: REC_ASCII LIKE FC_FULL_TAB-RECORD.
FIELD-SYMBOLS <P>.
* in hex, this reads:
* FF 52 53 54 58 <codepage>
FORM EXPORT_CLIPBOARD_BIN_HEADER.
STATICS: REC_ASCII LIKE FC_FULL_TAB-RECORD.
FIELD-SYMBOLS <P>.
CLEAR REC_ASCII.
REC_ASCII(1) = BINARY_FILE_HEADER_BYTE1.
REC_ASCII+1(1) = BINARY_FILE_HEADER_BYTE2.
REC_ASCII+2(1) = BINARY_FILE_HEADER_BYTE3.
REC_ASCII+3(1) = BINARY_FILE_HEADER_BYTE4.
REC_ASCII+4(1) = BINARY_FILE_HEADER_BYTE5.
* now write system codepage
PERFORM CONVERT_DIGIT_TO_HEXBYTE USING SYSTEM_CODEPAGE(1)
REC_ASCII+5(1).
PERFORM CONVERT_DIGIT_TO_HEXBYTE USING SYSTEM_CODEPAGE+1(1)
REC_ASCII+6(1).
PERFORM CONVERT_DIGIT_TO_HEXBYTE USING SYSTEM_CODEPAGE+2(1)
REC_ASCII+7(1).
PERFORM CONVERT_DIGIT_TO_HEXBYTE USING SYSTEM_CODEPAGE+3(1)
REC_ASCII+8(1).
CLEAR REC_ASCII+9.
CASE R3_INTERNAL_CHARSET.
WHEN C_CHARSET_ASCII.
ASSIGN REC_ASCII TO <P> TYPE 'C'.
RECORD = <P>.
WHEN C_CHARSET_EBCDIC.
ASSIGN REC_ASCII TO <P> TYPE 'C'.
RECORD = <P>.
WHEN C_CHARSET_UNICODE.
ASSIGN REC_ASCII TO <P> TYPE 'C'.
RECORD = <P>.
* TRANSLATE RECORD FROM CODE PAGE C_GUIFILE_BIN_CODEPAGE.
record_nostruct = record.
perform translate_from(RSTXTRANSLATE) using record_nostruct
c_guifile_bin_codepage.
record = record_nostruct.
ENDCASE.
PERFORM EXPORT_CLIPBOARD USING FALSE. "not end_of_obj
ENDFORM.
REC_ASCII(1) = BINARY_FILE_HEADER_BYTE1.
REC_ASCII+1(1) = BINARY_FILE_HEADER_BYTE2.
REC_ASCII+2(1) = BINARY_FILE_HEADER_BYTE3.
REC_ASCII+3(1) = BINARY_FILE_HEADER_BYTE4.
REC_ASCII+4(1) = BINARY_FILE_HEADER_BYTE5.
* now write system codepage
PERFORM CONVERT_DIGIT_TO_HEXBYTE USING SYSTEM_CODEPAGE(1)
REC_ASCII+5(1).
PERFORM CONVERT_DIGIT_TO_HEXBYTE USING SYSTEM_CODEPAGE+1(1)
REC_ASCII+6(1).
PERFORM CONVERT_DIGIT_TO_HEXBYTE USING SYSTEM_CODEPAGE+2(1)
REC_ASCII+7(1).
PERFORM CONVERT_DIGIT_TO_HEXBYTE USING SYSTEM_CODEPAGE+3(1)
REC_ASCII+8(1).
CLEAR REC_ASCII+9.
CASE R3_INTERNAL_CHARSET.
WHEN C_CHARSET_ASCII.
ASSIGN REC_ASCII TO <P> TYPE 'C'.
RECORD = <P>.
WHEN C_CHARSET_EBCDIC.
ASSIGN REC_ASCII TO <P> TYPE 'C'.
RECORD = <P>.
WHEN C_CHARSET_UNICODE.
ASSIGN REC_ASCII TO <P> TYPE 'C'.
RECORD = <P>.
* TRANSLATE RECORD FROM CODE PAGE C_GUIFILE_BIN_CODEPAGE.
record_nostruct = record.
perform translate_from(RSTXTRANSLATE) using record_nostruct
c_guifile_bin_codepage.
record = record_nostruct.
ENDCASE.
PERFORM EXPORT_CLIPBOARD USING FALSE. "not end_of_obj
ENDFORM.
* import binary file header including codepage
* set sy-subrc = 0 if format o.k.
* set sy-subrc = 1 if bad format
* set sy-subrc = 2 if bad codepage
* else 3
FORM IMPORT_CLIPBOARD_BIN_HEADER USING CODEPAGE.
STATICS: CP LIKE TCP02-CPCODEPAGE,
SYS_CP LIKE TCP02-CPCODEPAGE,
EOF(1) TYPE C,
HEXBYTE TYPE X,
LEN LIKE SY-FDPOS,
REC LIKE FC_FULL_TAB-RECORD.
* set sy-subrc = 0 if format o.k.
* set sy-subrc = 1 if bad format
* set sy-subrc = 2 if bad codepage
* else 3
FORM IMPORT_CLIPBOARD_BIN_HEADER USING CODEPAGE.
STATICS: CP LIKE TCP02-CPCODEPAGE,
SYS_CP LIKE TCP02-CPCODEPAGE,
EOF(1) TYPE C,
HEXBYTE TYPE X,
LEN LIKE SY-FDPOS,
REC LIKE FC_FULL_TAB-RECORD.
PERFORM FC_READ_RECORD_ASCII USING FILENAME REC EOF.
IF EOF = TRUE.
SUBRC = 4.
ENDIF.
IF SUBRC NE 0.
END_OF_CLIPBOARD = TRUE. SY-SUBRC = 3. EXIT.
ENDIF.
* check binary header
HEXBYTE = REC(1).
IF HEXBYTE <> BINARY_FILE_HEADER_BYTE1.
SY-SUBRC = 1. EXIT.
ENDIF.
HEXBYTE = REC+1(1).
IF HEXBYTE <> BINARY_FILE_HEADER_BYTE2.
SY-SUBRC = 1. EXIT.
ENDIF.
HEXBYTE = REC+2(1).
IF HEXBYTE <> BINARY_FILE_HEADER_BYTE3.
SY-SUBRC = 1. EXIT.
ENDIF.
HEXBYTE = REC+3(1).
IF HEXBYTE <> BINARY_FILE_HEADER_BYTE4.
SY-SUBRC = 1. EXIT.
ENDIF.
HEXBYTE = REC+4(1).
IF HEXBYTE <> BINARY_FILE_HEADER_BYTE5.
SY-SUBRC = 1. EXIT.
ENDIF.
* get codepage
PERFORM CONVERT_HEXBYTE_TO_DIGIT USING REC+5(1) CP(1).
PERFORM CONVERT_HEXBYTE_TO_DIGIT USING REC+6(1) CP+1(1).
PERFORM CONVERT_HEXBYTE_TO_DIGIT USING REC+7(1) CP+2(1).
PERFORM CONVERT_HEXBYTE_TO_DIGIT USING REC+8(1) CP+3(1).
SELECT SINGLE * FROM TCP00 WHERE CPCODEPAGE = CP.
IF SY-SUBRC = 0.
CODEPAGE = CP.
ELSE.
SY-SUBRC = 2. EXIT.
ENDIF.
* AS/400: use hardcoded codepage for binfile format and language import
LEN = STRLEN( CUSTOM_LANGUAGE_VECTOR ). "B20K051883
IF LEN = 1 AND R3_INTERNAL_CHARSET = C_CHARSET_EBCDIC.
SYS_CP = SYSTEM_CODEPAGE.
CASE CP.
WHEN '1100'. SYS_CP = '0120'.
WHEN '1400'. SYS_CP = '0410'.
WHEN '1500'. SYS_CP = '0500'.
WHEN '1610'. SYS_CP = '0610'.
WHEN '1700'. SYS_CP = '0700'.
WHEN '1802'. SYS_CP = '0800'.
ENDCASE.
IF SYS_CP <> SYSTEM_CODEPAGE.
FORMAT COLOR COL_KEY.
WRITE: / 'Zielzeichensatz f黵 Import ge鋘dert:'(205),
SYSTEM_CODEPAGE, '->', SYS_CP.
SYSTEM_CODEPAGE = SYS_CP.
ENDIF.
ENDIF. "B20K051883
ENDFORM.
IF EOF = TRUE.
SUBRC = 4.
ENDIF.
IF SUBRC NE 0.
END_OF_CLIPBOARD = TRUE. SY-SUBRC = 3. EXIT.
ENDIF.
* check binary header
HEXBYTE = REC(1).
IF HEXBYTE <> BINARY_FILE_HEADER_BYTE1.
SY-SUBRC = 1. EXIT.
ENDIF.
HEXBYTE = REC+1(1).
IF HEXBYTE <> BINARY_FILE_HEADER_BYTE2.
SY-SUBRC = 1. EXIT.
ENDIF.
HEXBYTE = REC+2(1).
IF HEXBYTE <> BINARY_FILE_HEADER_BYTE3.
SY-SUBRC = 1. EXIT.
ENDIF.
HEXBYTE = REC+3(1).
IF HEXBYTE <> BINARY_FILE_HEADER_BYTE4.
SY-SUBRC = 1. EXIT.
ENDIF.
HEXBYTE = REC+4(1).
IF HEXBYTE <> BINARY_FILE_HEADER_BYTE5.
SY-SUBRC = 1. EXIT.
ENDIF.
* get codepage
PERFORM CONVERT_HEXBYTE_TO_DIGIT USING REC+5(1) CP(1).
PERFORM CONVERT_HEXBYTE_TO_DIGIT USING REC+6(1) CP+1(1).
PERFORM CONVERT_HEXBYTE_TO_DIGIT USING REC+7(1) CP+2(1).
PERFORM CONVERT_HEXBYTE_TO_DIGIT USING REC+8(1) CP+3(1).
SELECT SINGLE * FROM TCP00 WHERE CPCODEPAGE = CP.
IF SY-SUBRC = 0.
CODEPAGE = CP.
ELSE.
SY-SUBRC = 2. EXIT.
ENDIF.
* AS/400: use hardcoded codepage for binfile format and language import
LEN = STRLEN( CUSTOM_LANGUAGE_VECTOR ). "B20K051883
IF LEN = 1 AND R3_INTERNAL_CHARSET = C_CHARSET_EBCDIC.
SYS_CP = SYSTEM_CODEPAGE.
CASE CP.
WHEN '1100'. SYS_CP = '0120'.
WHEN '1400'. SYS_CP = '0410'.
WHEN '1500'. SYS_CP = '0500'.
WHEN '1610'. SYS_CP = '0610'.
WHEN '1700'. SYS_CP = '0700'.
WHEN '1802'. SYS_CP = '0800'.
ENDCASE.
IF SYS_CP <> SYSTEM_CODEPAGE.
FORMAT COLOR COL_KEY.
WRITE: / 'Zielzeichensatz f黵 Import ge鋘dert:'(205),
SYSTEM_CODEPAGE, '->', SYS_CP.
SYSTEM_CODEPAGE = SYS_CP.
ENDIF.
ENDIF. "B20K051883
ENDFORM.
* read a line from transport dataset into RECORD
* sets SUBRC <> 0 if line could not be read
FORM IMPORT_CLIPBOARD.
STATICS: EOF LIKE BOOLEAN.
* sets SUBRC <> 0 if line could not be read
FORM IMPORT_CLIPBOARD.
STATICS: EOF LIKE BOOLEAN.
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.
record_nostruct = record.
perform translate_from(RSTXTRANSLATE) using record_nostruct
binfile_codepage.
record = record_nostruct.
ENDIF.
ELSE.
* text mode file
PERFORM FILE_READ_RECORD USING FILENAME EOF.
SUBRC = SY-SUBRC.
IF SUBRC NE 0.
END_OF_CLIPBOARD = TRUE.
EXIT.
ENDIF.
ENDIF.
IF LIST_FILE_CONTENTS = 'X'.
FORMAT COLOR COL_NORMAL.
WRITE: / RECORD.
ENDIF.
ENDFORM.
* 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.
record_nostruct = record.
perform translate_from(RSTXTRANSLATE) using record_nostruct
binfile_codepage.
record = record_nostruct.
ENDIF.
ELSE.
* text mode file
PERFORM FILE_READ_RECORD USING FILENAME EOF.
SUBRC = SY-SUBRC.
IF SUBRC NE 0.
END_OF_CLIPBOARD = TRUE.
EXIT.
ENDIF.
ENDIF.
IF LIST_FILE_CONTENTS = 'X'.
FORMAT COLOR COL_NORMAL.
WRITE: / RECORD.
ENDIF.
ENDFORM.
***************************************
* routines for file open, write, read, close
***************************************
* routines for file open, write, read, close
***************************************
FORM GUI_FILE_TEXT_INIT.
REFRESH GUI_FILE_TEXT. CLEAR GUI_FILE_TEXT.
GUI_FILE_TEXT_CUR_LINE_INDEX = 1.
ENDFORM.
REFRESH GUI_FILE_TEXT. CLEAR GUI_FILE_TEXT.
GUI_FILE_TEXT_CUR_LINE_INDEX = 1.
ENDFORM.
FORM GUI_FILE_BIN_INIT.
REFRESH GUI_FILE_BIN. CLEAR GUI_FILE_BIN.
GUI_FILE_BIN_CUR_LINE_INDEX = 1.
GUI_FILE_BIN_CUR_LINEOFS = 0.
GUI_FILE_BIN_TOTAL_BYTES = 0.
ENDFORM.
REFRESH GUI_FILE_BIN. CLEAR GUI_FILE_BIN.
GUI_FILE_BIN_CUR_LINE_INDEX = 1.
GUI_FILE_BIN_CUR_LINEOFS = 0.
GUI_FILE_BIN_TOTAL_BYTES = 0.
ENDFORM.
FORM GUI_FILE_PUTBYTE USING VALUE(BYTE) TYPE X.
GUI_FILE_BIN-L+GUI_FILE_BIN_CUR_LINEOFS(1) = BYTE.
ADD 1 TO GUI_FILE_BIN_CUR_LINEOFS.
ADD 1 TO GUI_FILE_BIN_TOTAL_BYTES.
IF GUI_FILE_BIN_CUR_LINEOFS = C_GUIFILE_BIN_NUMBYTES.
APPEND GUI_FILE_BIN.
ADD 1 TO GUI_FILE_BIN_CUR_LINE_INDEX.
GUI_FILE_BIN_CUR_LINEOFS = 0.
ENDIF.
ENDFORM.
GUI_FILE_BIN-L+GUI_FILE_BIN_CUR_LINEOFS(1) = BYTE.
ADD 1 TO GUI_FILE_BIN_CUR_LINEOFS.
ADD 1 TO GUI_FILE_BIN_TOTAL_BYTES.
IF GUI_FILE_BIN_CUR_LINEOFS = C_GUIFILE_BIN_NUMBYTES.
APPEND GUI_FILE_BIN.
ADD 1 TO GUI_FILE_BIN_CUR_LINE_INDEX.
GUI_FILE_BIN_CUR_LINEOFS = 0.
ENDIF.
ENDFORM.
FORM GUI_FILE_FLUSH_BUFFER.
IF GUI_FILE_BIN_CUR_LINEOFS > 0.
APPEND GUI_FILE_BIN.
ENDIF.
ENDFORM.
IF GUI_FILE_BIN_CUR_LINEOFS > 0.
APPEND GUI_FILE_BIN.
ENDIF.
ENDFORM.
FORM GUI_FILE_GETBYTE USING BYTE TYPE X.
READ TABLE GUI_FILE_BIN INDEX GUI_FILE_BIN_CUR_LINE_INDEX.
IF SY-SUBRC <> 0.
BYTE = '00'.
ELSE.
BYTE = GUI_FILE_BIN-L+GUI_FILE_BIN_CUR_LINEOFS(1).
ADD 1 TO GUI_FILE_BIN_CUR_LINEOFS.
SUBTRACT 1 FROM GUI_FILE_BIN_TOTAL_BYTES.
IF GUI_FILE_BIN_TOTAL_BYTES < 0.
SY-SUBRC = 1. EXIT.
ENDIF.
IF GUI_FILE_BIN_CUR_LINEOFS = C_GUIFILE_BIN_NUMBYTES.
ADD 1 TO GUI_FILE_BIN_CUR_LINE_INDEX.
GUI_FILE_BIN_CUR_LINEOFS = 0.
ENDIF.
SY-SUBRC = 0.
ENDIF.
ENDFORM.
READ TABLE GUI_FILE_BIN INDEX GUI_FILE_BIN_CUR_LINE_INDEX.
IF SY-SUBRC <> 0.
BYTE = '00'.
ELSE.
BYTE = GUI_FILE_BIN-L+GUI_FILE_BIN_CUR_LINEOFS(1).
ADD 1 TO GUI_FILE_BIN_CUR_LINEOFS.
SUBTRACT 1 FROM GUI_FILE_BIN_TOTAL_BYTES.
IF GUI_FILE_BIN_TOTAL_BYTES < 0.
SY-SUBRC = 1. EXIT.
ENDIF.
IF GUI_FILE_BIN_CUR_LINEOFS = C_GUIFILE_BIN_NUMBYTES.
ADD 1 TO GUI_FILE_BIN_CUR_LINE_INDEX.
GUI_FILE_BIN_CUR_LINEOFS = 0.
ENDIF.
SY-SUBRC = 0.
ENDIF.
ENDFORM.
* replace DOWNLOAD with new calls (UNICODE)
form download tables datatab
using filename like rlgrap-filename
mode type c
bin_filesize type i
cancel type c.
data: name type string,
path type string,
fullpath type string,
filter type string,
guiobj type ref to cl_gui_frontend_services,
uact type i.
form download tables datatab
using filename like rlgrap-filename
mode type c
bin_filesize type i
cancel type c.
data: name type string,
path type string,
fullpath type string,
filter type string,
guiobj type ref to cl_gui_frontend_services,
uact type i.
if mode <> 'ASC' and mode <> 'BIN'.
sy-subrc = 1. exit.
endif.
clear cancel.
if filename is initial.
name = 'test.txt'.
else.
name = filename.
endif.
filter = '(*.*)|*.*|'.
*create object guiobj.
*call method guiobj->file_save_dialog
* exporting default_extension = 'txt'
* default_file_name = name
* file_filter = filter
* changing filename = name
* path = path
* fullpath = fullpath
* user_action = uact.
*if uact = guiobj->action_cancel.
* cancel = 'X'. exit.
*endif.
*CALL FUNCTION 'GUI_DOWNLOAD'
* EXPORTING
* BIN_FILESIZE = bin_filesize
* FILENAME = fullpath
* FILETYPE = mode
** APPEND = ' '
** CODEPAGE = ' '
** NO_BYTEORDER_MARK = ' '
* IMPORTING
* FILELENGTH = bin_filesize
* TABLES
* DATA_TAB = datatab
** FORMAT_TAB =
* EXCEPTIONS
* FILE_WRITE_ERROR = 1
* NO_BATCH = 2
* GUI_REFUSE_FILETRANSFER = 3
* INVALID_TYPE = 4
* NO_AUTHORITY = 5
* UNKNOWN_ERROR = 6.
sy-subrc = 1. exit.
endif.
clear cancel.
if filename is initial.
name = 'test.txt'.
else.
name = filename.
endif.
filter = '(*.*)|*.*|'.
*create object guiobj.
*call method guiobj->file_save_dialog
* exporting default_extension = 'txt'
* default_file_name = name
* file_filter = filter
* changing filename = name
* path = path
* fullpath = fullpath
* user_action = uact.
*if uact = guiobj->action_cancel.
* cancel = 'X'. exit.
*endif.
*CALL FUNCTION 'GUI_DOWNLOAD'
* EXPORTING
* BIN_FILESIZE = bin_filesize
* FILENAME = fullpath
* FILETYPE = mode
** APPEND = ' '
** CODEPAGE = ' '
** NO_BYTEORDER_MARK = ' '
* IMPORTING
* FILELENGTH = bin_filesize
* TABLES
* DATA_TAB = datatab
** FORMAT_TAB =
* EXCEPTIONS
* FILE_WRITE_ERROR = 1
* NO_BATCH = 2
* GUI_REFUSE_FILETRANSFER = 3
* INVALID_TYPE = 4
* NO_AUTHORITY = 5
* UNKNOWN_ERROR = 6.
CALL FUNCTION 'WS_DOWNLOAD'
EXPORTING
*IN_FILESIZE = bin_filesize
FILENAME = filename
FILETYPE = mode
TABLES
DATA_TAB = datatab
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.
EXPORTING
*IN_FILESIZE = bin_filesize
FILENAME = filename
FILETYPE = mode
TABLES
DATA_TAB = datatab
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.
filename = fullpath.
endform.
form upload tables datatab
using filename like rlgrap-filename
mode type c
bin_filesize type i
cancel type c.
data: name type string,
filetype type char10,
filetable type filetable,
filter type string,
rc type i,
guiobj type ref to cl_gui_frontend_services,
uact type i.
using filename like rlgrap-filename
mode type c
bin_filesize type i
cancel type c.
data: name type string,
filetype type char10,
filetable type filetable,
filter type string,
rc type i,
guiobj type ref to cl_gui_frontend_services,
uact type i.
if mode <> 'ASC' and mode <> 'BIN'.
sy-subrc = 1. exit.
endif.
filetype = mode.
name = filename.
clear cancel.
create object guiobj.
filter = '(*.*)|*.*|)'.
call method guiobj->file_open_dialog
exporting default_filename = name
file_filter = filter
changing file_table = filetable
rc = rc
user_action = uact
exceptions file_open_dialog_failed = 1
cntl_error = 2
error_no_gui = 3.
check sy-subrc = 0.
if rc < 0.
cancel = 'X'. exit.
endif.
read table filetable index 1 into name.
check sy-subrc = 0.
CALL FUNCTION 'GUI_UPLOAD'
EXPORTING FILENAME = name
FILETYPE = FILETYPE
IMPORTING FILELENGTH = bin_filesize
TABLES DATA_TAB = datatab
EXCEPTIONS FILE_OPEN_ERROR = 2
FILE_READ_ERROR = 3
INVALID_TYPE = 4
NO_BATCH = 5
OTHERS = 6.
filename = name.
endform.
sy-subrc = 1. exit.
endif.
filetype = mode.
name = filename.
clear cancel.
create object guiobj.
filter = '(*.*)|*.*|)'.
call method guiobj->file_open_dialog
exporting default_filename = name
file_filter = filter
changing file_table = filetable
rc = rc
user_action = uact
exceptions file_open_dialog_failed = 1
cntl_error = 2
error_no_gui = 3.
check sy-subrc = 0.
if rc < 0.
cancel = 'X'. exit.
endif.
read table filetable index 1 into name.
check sy-subrc = 0.
CALL FUNCTION 'GUI_UPLOAD'
EXPORTING FILENAME = name
FILETYPE = FILETYPE
IMPORTING FILELENGTH = bin_filesize
TABLES DATA_TAB = datatab
EXCEPTIONS FILE_OPEN_ERROR = 2
FILE_READ_ERROR = 3
INVALID_TYPE = 4
NO_BATCH = 5
OTHERS = 6.
filename = name.
endform.
FORM FILE_OPEN USING VALUE(FILENAME) VALUE(I_O_FLAG)
VALUE(B_T_FLAG).
STATICS: CANCEL(1),
FILE LIKE RLGRAP-FILENAME.
VALUE(B_T_FLAG).
STATICS: CANCEL(1),
FILE LIKE RLGRAP-FILENAME.
PERFORM GET_FILE_SOURCE.
IF SY-SUBRC = 0. "GUI upload/download
IF I_O_FLAG = 'O'.
* start of output, write later at CLOSE
IF B_T_FLAG = 'B'.
PERFORM GUI_FILE_BIN_INIT.
ELSE.
PERFORM GUI_FILE_TEXT_INIT.
ENDIF.
SY-SUBRC = 0.
ELSE.
* start of input, read everything now
FILE = filename.
IF B_T_FLAG = 'B'.
PERFORM GUI_FILE_BIN_INIT.
perform upload tables gui_file_bin
using file
'BIN'
gui_file_bin_total_bytes
cancel.
ELSE.
PERFORM GUI_FILE_TEXT_INIT.
perform upload tables gui_file_text
using file
'ASC'
gui_file_bin_total_bytes
cancel.
ENDIF.
IF CANCEL = SPACE and sy-subrc = 0.
SY-SUBRC = 0.
ELSE.
FORMAT COLOR COL_NEGATIVE.
WRITE: /
'Dataset konnte nicht zum Lesen ge鰂fnet werden'(018), FILE.
SY-SUBRC = 1.
ENDIF.
ENDIF.
EXIT.
ENDIF.
* server file system read/write
IF B_T_FLAG = 'B'. "binary mode
IF I_O_FLAG = 'O'.
OPEN DATASET FILENAME FOR OUTPUT IN BINARY MODE.
ELSE.
OPEN DATASET FILENAME FOR INPUT IN BINARY MODE.
ENDIF.
ELSE. "text mode
IF I_O_FLAG = 'O'.
OPEN DATASET FILENAME FOR OUTPUT IN TEXT MODE encoding default.
ELSE.
OPEN DATASET FILENAME FOR INPUT IN TEXT MODE encoding default.
ENDIF.
ENDIF.
IF SY-SUBRC NE 0.
IF I_O_FLAG = 'O'.
FORMAT COLOR COL_NEGATIVE.
WRITE: /
'Dataset konnte nicht zum Schreiben ge鰂fnet werden'(017),FILENAME.
ELSE.
FORMAT COLOR COL_NEGATIVE.
WRITE: /
'Dataset konnte nicht zum Lesen ge鰂fnet werden'(018), FILENAME.
ENDIF.
ENDIF.
ENDFORM.
IF SY-SUBRC = 0. "GUI upload/download
IF I_O_FLAG = 'O'.
* start of output, write later at CLOSE
IF B_T_FLAG = 'B'.
PERFORM GUI_FILE_BIN_INIT.
ELSE.
PERFORM GUI_FILE_TEXT_INIT.
ENDIF.
SY-SUBRC = 0.
ELSE.
* start of input, read everything now
FILE = filename.
IF B_T_FLAG = 'B'.
PERFORM GUI_FILE_BIN_INIT.
perform upload tables gui_file_bin
using file
'BIN'
gui_file_bin_total_bytes
cancel.
ELSE.
PERFORM GUI_FILE_TEXT_INIT.
perform upload tables gui_file_text
using file
'ASC'
gui_file_bin_total_bytes
cancel.
ENDIF.
IF CANCEL = SPACE and sy-subrc = 0.
SY-SUBRC = 0.
ELSE.
FORMAT COLOR COL_NEGATIVE.
WRITE: /
'Dataset konnte nicht zum Lesen ge鰂fnet werden'(018), FILE.
SY-SUBRC = 1.
ENDIF.
ENDIF.
EXIT.
ENDIF.
* server file system read/write
IF B_T_FLAG = 'B'. "binary mode
IF I_O_FLAG = 'O'.
OPEN DATASET FILENAME FOR OUTPUT IN BINARY MODE.
ELSE.
OPEN DATASET FILENAME FOR INPUT IN BINARY MODE.
ENDIF.
ELSE. "text mode
IF I_O_FLAG = 'O'.
OPEN DATASET FILENAME FOR OUTPUT IN TEXT MODE encoding default.
ELSE.
OPEN DATASET FILENAME FOR INPUT IN TEXT MODE encoding default.
ENDIF.
ENDIF.
IF SY-SUBRC NE 0.
IF I_O_FLAG = 'O'.
FORMAT COLOR COL_NEGATIVE.
WRITE: /
'Dataset konnte nicht zum Schreiben ge鰂fnet werden'(017),FILENAME.
ELSE.
FORMAT COLOR COL_NEGATIVE.
WRITE: /
'Dataset konnte nicht zum Lesen ge鰂fnet werden'(018), FILENAME.
ENDIF.
ENDIF.
ENDFORM.
FORM FILE_CLOSE USING VALUE(FILENAME) VALUE(I_O_FLAG).
STATICS: FILE LIKE RLGRAP-FILENAME,
BIN_FILESIZE TYPE I,
CANCEL(1).
STATICS: FILE LIKE RLGRAP-FILENAME,
BIN_FILESIZE TYPE I,
CANCEL(1).
PERFORM GET_FILE_SOURCE.
IF SY-SUBRC = 0. "GUI upload/download
IF I_O_FLAG = 'O'.
* end of output, write data to gui
FILE = filename.
PERFORM GET_BINARY_FILE_FORMAT_FLAG.
IF SY-SUBRC = 0.
* write last bytes to table
PERFORM GUI_FILE_FLUSH_BUFFER.
* get binary file size
BIN_FILESIZE = GUI_FILE_BIN_TOTAL_BYTES.
file = filename.
perform download tables gui_file_bin
using file
'BIN'
bin_filesize
cancel.
ELSE.
perform download tables gui_file_text
using file
'ASC'
bin_filesize
cancel.
ENDIF.
IF CANCEL = SPACE.
SY-SUBRC = 0.
ELSE.
FORMAT COLOR COL_NEGATIVE.
WRITE: /
'Dataset konnte nicht zum Schreiben ge鰂fnet werden'(017),FILE.
SY-SUBRC = 1.
ENDIF.
ELSE.
* end of input, nothing to do
SY-SUBRC = 0.
ENDIF.
EXIT.
ELSE. "server filesystem read/write
CLOSE DATASET FILENAME.
ENDIF.
ENDFORM.
IF SY-SUBRC = 0. "GUI upload/download
IF I_O_FLAG = 'O'.
* end of output, write data to gui
FILE = filename.
PERFORM GET_BINARY_FILE_FORMAT_FLAG.
IF SY-SUBRC = 0.
* write last bytes to table
PERFORM GUI_FILE_FLUSH_BUFFER.
* get binary file size
BIN_FILESIZE = GUI_FILE_BIN_TOTAL_BYTES.
file = filename.
perform download tables gui_file_bin
using file
'BIN'
bin_filesize
cancel.
ELSE.
perform download tables gui_file_text
using file
'ASC'
bin_filesize
cancel.
ENDIF.
IF CANCEL = SPACE.
SY-SUBRC = 0.
ELSE.
FORMAT COLOR COL_NEGATIVE.
WRITE: /
'Dataset konnte nicht zum Schreiben ge鰂fnet werden'(017),FILE.
SY-SUBRC = 1.
ENDIF.
ELSE.
* end of input, nothing to do
SY-SUBRC = 0.
ENDIF.
EXIT.
ELSE. "server filesystem read/write
CLOSE DATASET FILENAME.
ENDIF.
ENDFORM.
FORM FILE_WRITE_RECORD USING VALUE(FILE) VALUE(B_T_FLAG).
IF FILE_SOURCE_LOCAL = FILE_SOURCE_LOCAL_MAGIC. "GUI download
CASE R3_INTERNAL_CHARSET.
WHEN C_CHARSET_ASCII.
GUI_FILE_TEXT = RECORD.
WHEN C_CHARSET_EBCDIC.
GUI_FILE_TEXT = RECORD.
WHEN C_CHARSET_UNICODE.
GUI_FILE_TEXT = RECORD.
ENDCASE.
APPEND GUI_FILE_TEXT.
ELSE. "server file write
TRANSFER RECORD TO FILE.
ENDIF.
ENDFORM.
IF FILE_SOURCE_LOCAL = FILE_SOURCE_LOCAL_MAGIC. "GUI download
CASE R3_INTERNAL_CHARSET.
WHEN C_CHARSET_ASCII.
GUI_FILE_TEXT = RECORD.
WHEN C_CHARSET_EBCDIC.
GUI_FILE_TEXT = RECORD.
WHEN C_CHARSET_UNICODE.
GUI_FILE_TEXT = RECORD.
ENDCASE.
APPEND GUI_FILE_TEXT.
ELSE. "server file write
TRANSFER RECORD TO FILE.
ENDIF.
ENDFORM.
FORM FILE_WRITE_BIN_REC USING VALUE(FILE) VALUE(BIN_REC) TYPE X
VALUE(NUMBYTES).
STATICS X TYPE X.
field-symbols <p>.
VALUE(NUMBYTES).
STATICS X TYPE X.
field-symbols <p>.
IF FILE_SOURCE_LOCAL = FILE_SOURCE_LOCAL_MAGIC. "GUI download
assign bin_rec to <p> type 'X'.
DO NUMBYTES TIMES.
X = <p>.
PERFORM GUI_FILE_PUTBYTE USING X.
* SHIFT BIN_REC.
assign <p>+1(1) to <p>.
ENDDO.
ELSE. "server file write
TRANSFER BIN_REC TO FILE.
ENDIF.
ENDFORM.
assign bin_rec to <p> type 'X'.
DO NUMBYTES TIMES.
X = <p>.
PERFORM GUI_FILE_PUTBYTE USING X.
* SHIFT BIN_REC.
assign <p>+1(1) to <p>.
ENDDO.
ELSE. "server file write
TRANSFER BIN_REC TO FILE.
ENDIF.
ENDFORM.
FORM FILE_READ_RECORD USING VALUE(FILE) EOF.
IF FILE_SOURCE_LOCAL = FILE_SOURCE_LOCAL_MAGIC. "GUI upload
READ TABLE GUI_FILE_TEXT INDEX GUI_FILE_TEXT_CUR_LINE_INDEX.
IF SY-SUBRC = 0.
CASE R3_INTERNAL_CHARSET.
WHEN C_CHARSET_ASCII.
RECORD = GUI_FILE_TEXT.
WHEN C_CHARSET_EBCDIC.
RECORD = GUI_FILE_TEXT.
WHEN C_CHARSET_UNICODE.
RECORD = GUI_FILE_TEXT.
ENDCASE.
ADD 1 TO GUI_FILE_TEXT_CUR_LINE_INDEX.
EOF = FALSE.
ELSE.
EOF = TRUE.
ENDIF.
ELSE. "server file read
READ DATASET FILE INTO RECORD.
IF SY-SUBRC = 0.
EOF = FALSE.
ELSE.
EOF = TRUE.
ENDIF.
ENDIF.
ENDFORM.
IF FILE_SOURCE_LOCAL = FILE_SOURCE_LOCAL_MAGIC. "GUI upload
READ TABLE GUI_FILE_TEXT INDEX GUI_FILE_TEXT_CUR_LINE_INDEX.
IF SY-SUBRC = 0.
CASE R3_INTERNAL_CHARSET.
WHEN C_CHARSET_ASCII.
RECORD = GUI_FILE_TEXT.
WHEN C_CHARSET_EBCDIC.
RECORD = GUI_FILE_TEXT.
WHEN C_CHARSET_UNICODE.
RECORD = GUI_FILE_TEXT.
ENDCASE.
ADD 1 TO GUI_FILE_TEXT_CUR_LINE_INDEX.
EOF = FALSE.
ELSE.
EOF = TRUE.
ENDIF.
ELSE. "server file read
READ DATASET FILE INTO RECORD.
IF SY-SUBRC = 0.
EOF = FALSE.
ELSE.
EOF = TRUE.
ENDIF.
ENDIF.
ENDFORM.
FORM FILE_READ_BIN_REC USING VALUE(FILE) BIN_REC TYPE X
NUMBYTES.
STATICS: BYTE TYPE X.
FIELD-SYMBOLS <P>.
NUMBYTES.
STATICS: BYTE TYPE X.
FIELD-SYMBOLS <P>.
IF FILE_SOURCE_LOCAL = FILE_SOURCE_LOCAL_MAGIC. "GUI upload
ASSIGN BIN_REC(1) TO <P>.
DO NUMBYTES TIMES.
PERFORM GUI_FILE_GETBYTE USING BYTE.
CHECK SY-SUBRC = 0.
<P> = BYTE.
ASSIGN <P>+1(1) TO <P>.
ENDDO.
ELSE. "server file read
READ DATASET FILE INTO BIN_REC.
ENDIF.
ENDFORM.
ASSIGN BIN_REC(1) TO <P>.
DO NUMBYTES TIMES.
PERFORM GUI_FILE_GETBYTE USING BYTE.
CHECK SY-SUBRC = 0.
<P> = BYTE.
ASSIGN <P>+1(1) TO <P>.
ENDDO.
ELSE. "server file read
READ DATASET FILE INTO BIN_REC.
ENDIF.
ENDFORM.
***************************************
* routines for file compress/decompress
***************************************
* routines for file compress/decompress
***************************************
* clear all tables
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.
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.
* compress FC_FULL_TAB into FC_COMP_TAB
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.
FORMAT COLOR COL_NEGATIVE.
WRITE: / 'Fehler bei TABLE COMPRESS'(200), SY-SUBRC.
STOP.
ENDIF.
DESCRIBE TABLE FC_COMP_TAB LINES FC_COMP_TAB_LINES.
ENDFORM.
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.
FORMAT COLOR COL_NEGATIVE.
WRITE: / 'Fehler bei TABLE COMPRESS'(200), SY-SUBRC.
STOP.
ENDIF.
DESCRIBE TABLE FC_COMP_TAB LINES FC_COMP_TAB_LINES.
ENDFORM.
* decompress FC_COMP_TAB into FC_FULL_TAB
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.
FORMAT COLOR COL_NEGATIVE.
WRITE: / 'Fehler bei TABLE DECOMPRESS'(201), SY-SUBRC.
STOP.
ENDIF.
DESCRIBE TABLE FC_FULL_TAB LINES FC_FULL_TAB_LINES.
ENDFORM.
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.
FORMAT COLOR COL_NEGATIVE.
WRITE: / 'Fehler bei TABLE DECOMPRESS'(201), SY-SUBRC.
STOP.
ENDIF.
DESCRIBE TABLE FC_FULL_TAB LINES FC_FULL_TAB_LINES.
ENDFORM.
* header enth鋖t: 5 Hex werte als magic number und 6 Stellen
* BCD Darstellung der Anzahl folgender records
FORM FC_WRITE_COMPHEADER USING VALUE(DATASET_NAME) VALUE(NUMRECORDS).
STATICS: COMPHEADER(50) TYPE X,
NUMREC(6) TYPE N.
* BCD Darstellung der Anzahl folgender records
FORM FC_WRITE_COMPHEADER USING VALUE(DATASET_NAME) VALUE(NUMRECORDS).
STATICS: COMPHEADER(50) TYPE X,
NUMREC(6) TYPE N.
NUMREC = NUMRECORDS.
COMPHEADER(1) = BINARY_FILE_HEADER_BYTE1.
COMPHEADER+1(1) = BINARY_FILE_HEADER_BYTE2.
COMPHEADER+2(1) = BINARY_FILE_HEADER_BYTE3.
COMPHEADER+3(1) = BINARY_FILE_HEADER_BYTE4.
COMPHEADER+4(1) = BINARY_FILE_HEADER_BYTE5.
PERFORM CONVERT_DIGIT_TO_HEXBYTE USING NUMREC(1) COMPHEADER+5(1).
PERFORM CONVERT_DIGIT_TO_HEXBYTE USING NUMREC+1(1) COMPHEADER+6(1).
PERFORM CONVERT_DIGIT_TO_HEXBYTE USING NUMREC+2(1) COMPHEADER+7(1).
PERFORM CONVERT_DIGIT_TO_HEXBYTE USING NUMREC+3(1) COMPHEADER+8(1).
PERFORM CONVERT_DIGIT_TO_HEXBYTE USING NUMREC+4(1) COMPHEADER+9(1).
PERFORM CONVERT_DIGIT_TO_HEXBYTE USING NUMREC+5(1) COMPHEADER+10(1).
CLEAR COMPHEADER+11.
PERFORM FILE_WRITE_BIN_REC USING DATASET_NAME COMPHEADER 50."B20K053928
ENDFORM.
COMPHEADER(1) = BINARY_FILE_HEADER_BYTE1.
COMPHEADER+1(1) = BINARY_FILE_HEADER_BYTE2.
COMPHEADER+2(1) = BINARY_FILE_HEADER_BYTE3.
COMPHEADER+3(1) = BINARY_FILE_HEADER_BYTE4.
COMPHEADER+4(1) = BINARY_FILE_HEADER_BYTE5.
PERFORM CONVERT_DIGIT_TO_HEXBYTE USING NUMREC(1) COMPHEADER+5(1).
PERFORM CONVERT_DIGIT_TO_HEXBYTE USING NUMREC+1(1) COMPHEADER+6(1).
PERFORM CONVERT_DIGIT_TO_HEXBYTE USING NUMREC+2(1) COMPHEADER+7(1).
PERFORM CONVERT_DIGIT_TO_HEXBYTE USING NUMREC+3(1) COMPHEADER+8(1).
PERFORM CONVERT_DIGIT_TO_HEXBYTE USING NUMREC+4(1) COMPHEADER+9(1).
PERFORM CONVERT_DIGIT_TO_HEXBYTE USING NUMREC+5(1) COMPHEADER+10(1).
CLEAR COMPHEADER+11.
PERFORM FILE_WRITE_BIN_REC USING DATASET_NAME COMPHEADER 50."B20K053928
ENDFORM.
* read compressed block header, return number of records
* if error, sy-subrc <> 0, NUMRECORDS=0 indicates end of file
FORM FC_READ_COMPHEADER USING VALUE(DATASET_NAME) NUMRECORDS.
STATICS: COMPHEADER(50) TYPE X,
NUMREC(6) TYPE N,
HEXBYTE TYPE X,
EOF(1) TYPE C.
* if error, sy-subrc <> 0, NUMRECORDS=0 indicates end of file
FORM FC_READ_COMPHEADER USING VALUE(DATASET_NAME) NUMRECORDS.
STATICS: COMPHEADER(50) TYPE X,
NUMREC(6) TYPE N,
HEXBYTE TYPE X,
EOF(1) TYPE C.
PERFORM FILE_READ_BIN_REC USING DATASET_NAME COMPHEADER
50.
IF SY-SUBRC <> 0.
NUMRECORDS = 0. SY-SUBRC = 2. EXIT.
ENDIF.
* read binary header id
HEXBYTE = COMPHEADER(1).
IF HEXBYTE <> BINARY_FILE_HEADER_BYTE1.
SY-SUBRC = 1. EXIT.
ENDIF.
HEXBYTE = COMPHEADER+1(1).
IF HEXBYTE <> BINARY_FILE_HEADER_BYTE2.
SY-SUBRC = 1. EXIT.
ENDIF.
HEXBYTE = COMPHEADER+2(1).
IF HEXBYTE <> BINARY_FILE_HEADER_BYTE3.
SY-SUBRC = 1. EXIT.
ENDIF.
HEXBYTE = COMPHEADER+3(1).
IF HEXBYTE <> BINARY_FILE_HEADER_BYTE4.
SY-SUBRC = 1. EXIT.
ENDIF.
HEXBYTE = COMPHEADER+4(1).
IF HEXBYTE <> BINARY_FILE_HEADER_BYTE5.
SY-SUBRC = 1. EXIT.
ENDIF.
* read block size
PERFORM CONVERT_HEXBYTE_TO_DIGIT USING COMPHEADER+5(1) NUMREC(1).
PERFORM CONVERT_HEXBYTE_TO_DIGIT USING COMPHEADER+6(1) NUMREC+1(1).
PERFORM CONVERT_HEXBYTE_TO_DIGIT USING COMPHEADER+7(1) NUMREC+2(1).
PERFORM CONVERT_HEXBYTE_TO_DIGIT USING COMPHEADER+8(1) NUMREC+3(1).
PERFORM CONVERT_HEXBYTE_TO_DIGIT USING COMPHEADER+9(1) NUMREC+4(1).
PERFORM CONVERT_HEXBYTE_TO_DIGIT USING COMPHEADER+10(1) NUMREC+5(1).
NUMRECORDS = NUMREC.
ENDFORM.
50.
IF SY-SUBRC <> 0.
NUMRECORDS = 0. SY-SUBRC = 2. EXIT.
ENDIF.
* read binary header id
HEXBYTE = COMPHEADER(1).
IF HEXBYTE <> BINARY_FILE_HEADER_BYTE1.
SY-SUBRC = 1. EXIT.
ENDIF.
HEXBYTE = COMPHEADER+1(1).
IF HEXBYTE <> BINARY_FILE_HEADER_BYTE2.
SY-SUBRC = 1. EXIT.
ENDIF.
HEXBYTE = COMPHEADER+2(1).
IF HEXBYTE <> BINARY_FILE_HEADER_BYTE3.
SY-SUBRC = 1. EXIT.
ENDIF.
HEXBYTE = COMPHEADER+3(1).
IF HEXBYTE <> BINARY_FILE_HEADER_BYTE4.
SY-SUBRC = 1. EXIT.
ENDIF.
HEXBYTE = COMPHEADER+4(1).
IF HEXBYTE <> BINARY_FILE_HEADER_BYTE5.
SY-SUBRC = 1. EXIT.
ENDIF.
* read block size
PERFORM CONVERT_HEXBYTE_TO_DIGIT USING COMPHEADER+5(1) NUMREC(1).
PERFORM CONVERT_HEXBYTE_TO_DIGIT USING COMPHEADER+6(1) NUMREC+1(1).
PERFORM CONVERT_HEXBYTE_TO_DIGIT USING COMPHEADER+7(1) NUMREC+2(1).
PERFORM CONVERT_HEXBYTE_TO_DIGIT USING COMPHEADER+8(1) NUMREC+3(1).
PERFORM CONVERT_HEXBYTE_TO_DIGIT USING COMPHEADER+9(1) NUMREC+4(1).
PERFORM CONVERT_HEXBYTE_TO_DIGIT USING COMPHEADER+10(1) NUMREC+5(1).
NUMRECORDS = NUMREC.
ENDFORM.
* write header and compressed blocks to dataset
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.
PERFORM FILE_WRITE_BIN_REC USING DATASET_NAME "B20K053928
FC_COMP_TAB-RECORD "
1024. "
ENDLOOP.
FC_COMP_TAB_LINES = 0.
REFRESH FC_COMP_TAB. FREE FC_COMP_TAB.
ENDFORM.
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.
PERFORM FILE_WRITE_BIN_REC USING DATASET_NAME "B20K053928
FC_COMP_TAB-RECORD "
1024. "
ENDLOOP.
FC_COMP_TAB_LINES = 0.
REFRESH FC_COMP_TAB. FREE FC_COMP_TAB.
ENDFORM.
* read header and compressed blocks from dataset
* EOF = TRUE if end of file (i.e. no header)
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.
CASE SY-SUBRC.
WHEN 0.
WHEN 1.
FORMAT COLOR COL_NEGATIVE.
WRITE: / 'Fehler: Ung黮tige Blockkennung, falsches Dateiformat'(202).
STOP.
WHEN 2.
EOF = TRUE. EXIT.
WHEN OTHERS.
IF FC_COMP_TAB_LINES = 0.
EOF = TRUE. EXIT.
ENDIF.
ENDCASE.
DO FC_COMP_TAB_LINES TIMES.
PERFORM FILE_READ_BIN_REC USING DATASET_NAME FC_COMP_TAB-RECORD
FC_COMP_TAB_NUMBYTES.
IF SY-SUBRC = 0.
APPEND FC_COMP_TAB.
ELSE.
FORMAT COLOR COL_NEGATIVE.
WRITE: /
'Fehler: Zu wenige komprimierte Bl鯿ke, Datei unvollst鋘dig'(203).
WRITE: /
'Soll-Anzahl:', FC_COMP_TAB_LINES. "#EC NOTEXT
DESCRIBE TABLE FC_COMP_TAB LINES FC_COMP_TAB_LINES.
WRITE: /
'Ist-Anzahl:', FC_COMP_TAB_LINES. "#EC NOTEXT
STOP.
ENDIF.
ENDDO.
DESCRIBE TABLE FC_COMP_TAB LINES FC_COMP_TAB_LINES.
ENDFORM.
* EOF = TRUE if end of file (i.e. no header)
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.
CASE SY-SUBRC.
WHEN 0.
WHEN 1.
FORMAT COLOR COL_NEGATIVE.
WRITE: / 'Fehler: Ung黮tige Blockkennung, falsches Dateiformat'(202).
STOP.
WHEN 2.
EOF = TRUE. EXIT.
WHEN OTHERS.
IF FC_COMP_TAB_LINES = 0.
EOF = TRUE. EXIT.
ENDIF.
ENDCASE.
DO FC_COMP_TAB_LINES TIMES.
PERFORM FILE_READ_BIN_REC USING DATASET_NAME FC_COMP_TAB-RECORD
FC_COMP_TAB_NUMBYTES.
IF SY-SUBRC = 0.
APPEND FC_COMP_TAB.
ELSE.
FORMAT COLOR COL_NEGATIVE.
WRITE: /
'Fehler: Zu wenige komprimierte Bl鯿ke, Datei unvollst鋘dig'(203).
WRITE: /
'Soll-Anzahl:', FC_COMP_TAB_LINES. "#EC NOTEXT
DESCRIBE TABLE FC_COMP_TAB LINES FC_COMP_TAB_LINES.
WRITE: /
'Ist-Anzahl:', FC_COMP_TAB_LINES. "#EC NOTEXT
STOP.
ENDIF.
ENDDO.
DESCRIBE TABLE FC_COMP_TAB LINES FC_COMP_TAB_LINES.
ENDFORM.
* write single record into FC_FULL_TABLE
* if maximum lines reached, wait till end of object, then
* compress and output data
FORM FC_WRITE_RECORD USING VALUE(DATASET_NAME)
VALUE(REC) LIKE RECORD
VALUE(END_OF_OBJ).
FIELD-SYMBOLS <P>.
* if maximum lines reached, wait till end of object, then
* compress and output data
FORM FC_WRITE_RECORD USING VALUE(DATASET_NAME)
VALUE(REC) LIKE RECORD
VALUE(END_OF_OBJ).
FIELD-SYMBOLS <P>.
CASE R3_INTERNAL_CHARSET.
WHEN C_CHARSET_ASCII.
ASSIGN REC TO <P> TYPE 'X'.
FC_FULL_TAB-RECORD = <P>.
WHEN C_CHARSET_EBCDIC.
ASSIGN REC TO <P> TYPE 'X'.
FC_FULL_TAB-RECORD = <P>.
WHEN C_CHARSET_UNICODE.
* TRANSLATE R TO CODE PAGE C_GUIFILE_BIN_CODEPAGE.
record_nostruct = rec.
perform translate_to(RSTXTRANSLATE) using record_nostruct
c_guifile_bin_codepage.
ASSIGN record_nostruct TO <P> TYPE 'X'.
FC_FULL_TAB-RECORD = <P>.
ENDCASE.
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.
WHEN C_CHARSET_ASCII.
ASSIGN REC TO <P> TYPE 'X'.
FC_FULL_TAB-RECORD = <P>.
WHEN C_CHARSET_EBCDIC.
ASSIGN REC TO <P> TYPE 'X'.
FC_FULL_TAB-RECORD = <P>.
WHEN C_CHARSET_UNICODE.
* TRANSLATE R TO CODE PAGE C_GUIFILE_BIN_CODEPAGE.
record_nostruct = rec.
perform translate_to(RSTXTRANSLATE) using record_nostruct
c_guifile_bin_codepage.
ASSIGN record_nostruct TO <P> TYPE 'X'.
FC_FULL_TAB-RECORD = <P>.
ENDCASE.
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.
* close file after writing
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.
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.
* read single record from FC_FULL_TABLE
* if table empty, read next block
* compress and output data
* eof = TRUE if end of file
FORM FC_READ_RECORD USING VALUE(DATASET_NAME)
REC LIKE RECORD
EOF.
FIELD-SYMBOLS <P>.
* if table empty, read next block
* compress and output data
* eof = TRUE if end of file
FORM FC_READ_RECORD USING VALUE(DATASET_NAME)
REC LIKE RECORD
EOF.
FIELD-SYMBOLS <P>.
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.
FORMAT COLOR COL_NEGATIVE.
WRITE: / 'Fehler: Entkomprimierte Tabelle ist leer'(204). STOP.
ENDIF.
CASE R3_INTERNAL_CHARSET.
WHEN C_CHARSET_ASCII.
ASSIGN REC TO <P> TYPE 'X'.
<P> = FC_FULL_TAB-RECORD.
WHEN C_CHARSET_EBCDIC.
ASSIGN REC TO <P> TYPE 'X'.
<P> = FC_FULL_TAB-RECORD.
WHEN C_CHARSET_UNICODE.
ASSIGN record_nostruct TO <P> TYPE 'X'.
<P> = FC_FULL_TAB-RECORD.
* TRANSLATE R FROM CODE PAGE C_GUIFILE_BIN_CODEPAGE.
perform translate_from(RSTXTRANSLATE) using record_nostruct
c_guifile_bin_codepage.
REC = record_nostruct.
ENDCASE.
DELETE FC_FULL_TAB INDEX 1.
FC_FULL_TAB_LINES = FC_FULL_TAB_LINES - 1.
ENDFORM.
* 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.
FORMAT COLOR COL_NEGATIVE.
WRITE: / 'Fehler: Entkomprimierte Tabelle ist leer'(204). STOP.
ENDIF.
CASE R3_INTERNAL_CHARSET.
WHEN C_CHARSET_ASCII.
ASSIGN REC TO <P> TYPE 'X'.
<P> = FC_FULL_TAB-RECORD.
WHEN C_CHARSET_EBCDIC.
ASSIGN REC TO <P> TYPE 'X'.
<P> = FC_FULL_TAB-RECORD.
WHEN C_CHARSET_UNICODE.
ASSIGN record_nostruct TO <P> TYPE 'X'.
<P> = FC_FULL_TAB-RECORD.
* TRANSLATE R FROM CODE PAGE C_GUIFILE_BIN_CODEPAGE.
perform translate_from(RSTXTRANSLATE) using record_nostruct
c_guifile_bin_codepage.
REC = record_nostruct.
ENDCASE.
DELETE FC_FULL_TAB INDEX 1.
FC_FULL_TAB_LINES = FC_FULL_TAB_LINES - 1.
ENDFORM.
FORM FC_READ_RECORD_ASCII USING VALUE(DATASET_NAME)
REC TYPE X
EOF.
STATICS: R LIKE RECORD.
FIELD-SYMBOLS <P>.
REC TYPE X
EOF.
STATICS: R LIKE RECORD.
FIELD-SYMBOLS <P>.
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.
FORMAT COLOR COL_NEGATIVE.
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.
* 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.
FORMAT COLOR COL_NEGATIVE.
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.
* test form routine that inputs dataset and lists decompressed data
* to test, do external perform on this routine with dataset name
FORM FC_DECOMPRESS_AND_LIST USING VALUE(DATASET).
STATICS: EOF LIKE BOOLEAN.
* to test, do external perform on this routine with dataset name
FORM FC_DECOMPRESS_AND_LIST USING VALUE(DATASET).
STATICS: EOF LIKE BOOLEAN.
perform set_binary_file_format using true.
OPEN DATASET DATASET FOR INPUT IN BINARY MODE.
IF SY-SUBRC <> 0.
FORMAT COLOR COL_NEGATIVE.
WRITE: /
'Dataset konnte nicht zum Lesen ge鰂fnet werden'(018), DATASET.
EXIT.
ENDIF.
PERFORM FC_INIT.
FORMAT COLOR COL_NORMAL.
DO.
PERFORM FC_READ_RECORD USING DATASET RECORD EOF.
IF EOF = TRUE.
EXIT.
ENDIF.
WRITE: / RECORD(80).
ENDDO.
CLOSE DATASET DATASET.
ENDFORM.
OPEN DATASET DATASET FOR INPUT IN BINARY MODE.
IF SY-SUBRC <> 0.
FORMAT COLOR COL_NEGATIVE.
WRITE: /
'Dataset konnte nicht zum Lesen ge鰂fnet werden'(018), DATASET.
EXIT.
ENDIF.
PERFORM FC_INIT.
FORMAT COLOR COL_NORMAL.
DO.
PERFORM FC_READ_RECORD USING DATASET RECORD EOF.
IF EOF = TRUE.
EXIT.
ENDIF.
WRITE: / RECORD(80).
ENDDO.
CLOSE DATASET DATASET.
ENDFORM.
ZSAPSCRIPFORMEXP.txt
*&---------------------------------------------------------------------*
*& Report ZSAPSCRIPFORMEXP
*&
*&---------------------------------------------------------------------*
*&
*&
*&---------------------------------------------------------------------*
*& Report ZSAPSCRIPFORMEXP
*&
*&---------------------------------------------------------------------*
*&
*&
*&---------------------------------------------------------------------*
REPORT ZSAPSCRIPFORMEXP.
TABLES:TADIR,TRDIRT,TSTC,DD03L,DD02L,DD04L,DD02T,DD03T,DD04T.
DATA: BEGIN OF YTADIR OCCURS 0.
INCLUDE STRUCTURE TADIR. "资源库对象的目录
INCLUDE STRUCTURE TRDIRT.
DATA: END OF YTADIR.
DATA: YYNAME(128) TYPE C.
DATA: TT TYPE STRING OCCURS 0 WITH HEADER LINE.
DATA: RN(72).
DATA: COUNT TYPE I.
DATA: CCOUNT TYPE C.
DATA:FIELDS(40),
LIN TYPE I,
VAL(30),
REP(40).
DATA: TT TYPE STRING OCCURS 0 WITH HEADER LINE.
DATA: RN(72).
DATA: COUNT TYPE I.
DATA: CCOUNT TYPE C.
DATA:FIELDS(40),
LIN TYPE I,
VAL(30),
REP(40).
SELECTION-SCREEN BEGIN OF BLOCK BLK1 WITH FRAME .
PARAMETERS:DOW AS CHECKBOX. "是否下载
PARAMETERS:P_DIR(50) DEFAULT 'D:SAP ABAP'. "下载路径
PARAMETERS:STYPE(6) DEFAULT 'RTF'.
SELECTION-SCREEN END OF BLOCK BLK1.
SELECTION-SCREEN BEGIN OF BLOCK BLK2 WITH FRAME.
SELECT-OPTIONS:AUTHOR FOR TADIR-AUTHOR DEFAULT 'JUNQIU'. "开发人
SELECT-OPTIONS:DEVCLASS FOR TADIR-DEVCLASS. "开发类
SELECT-OPTIONS:OBJ FOR TADIR-OBJ_NAME. "下载程序名称
SELECTION-SCREEN END OF BLOCK BLK2.
SELECT * INTO CORRESPONDING FIELDS OF TABLE YTADIR
FROM TADIR
*INNER JOIN TRDIRT
*ON TADIR~OBJ_NAME = TRDIRT~NAME
WHERE OBJECT = 'FORM'
AND OBJ_NAME IN OBJ
AND DEVCLASS IN DEVCLASS
AND AUTHOR IN AUTHOR.
*SORT YTADIR BY OBJ_NAME.
FROM TADIR
*INNER JOIN TRDIRT
*ON TADIR~OBJ_NAME = TRDIRT~NAME
WHERE OBJECT = 'FORM'
AND OBJ_NAME IN OBJ
AND DEVCLASS IN DEVCLASS
AND AUTHOR IN AUTHOR.
*SORT YTADIR BY OBJ_NAME.
LOOP AT YTADIR.
IF DOW = 'X'.
CONCATENATE P_DIR YTADIR-OBJ_NAME '.' STYPE INTO YYNAME.
perform rstxscrp(zrstxr3tr) using 'FORM' YTADIR-OBJ_NAME 'EXPORT' YYNAME '' '' '' 'X' ''.
WRITE:/3(10) YTADIR-DEVCLASS, (15) YTADIR-AUTHOR, (30) YTADIR-OBJ_NAME, (50) YTADIR-TEXT.
ELSE.
WRITE:/3(10) YTADIR-DEVCLASS, (15) YTADIR-AUTHOR, (30) YTADIR-OBJ_NAME, (50) YTADIR-TEXT.
ENDIF.
ENDLOOP.
ELSE.
WRITE:/3(10) YTADIR-DEVCLASS, (15) YTADIR-AUTHOR, (30) YTADIR-OBJ_NAME, (50) YTADIR-TEXT.
ENDIF.
ENDLOOP.