【原创】批量下载SAPSCRIPTFORM

最新推荐文章于 2023-09-25 17:00:50 发布

置顶 Sunonce

最新推荐文章于 2023-09-25 17:00:50 发布

阅读量2.3k

点赞数

文章标签： header dataset file object import vector

本文链接：https://blog.csdn.net/Sunonce/article/details/1698382

版权

昨天在google收索到了批量下载程序和表定义的文章，感觉这些小工具挺好用的。但是在日常的业务中sap script form也是经常要用到和备份的。虽然sap 提供了一个下载的功能，但是一次只能下载一个。于是受到启发，决定做一个可以批量下载的程序。

步骤：

1、使用SE38将附件中的程序上传到SAP系统中，开发类选择$TMP即可。

2、执行程序 ZSAPSCRIPFORMEXP，然后根据条件输入参数。点击执行（或者按F8）

部分参数说明：

P_DIR为输出目录

DEVCLASS为form的开发类

OBJ表示对象名称

http://dl2.csdn.net/down4/20070719/19091437514.txt

http://dl2.csdn.net/down4/20070719/19091515132.txt

文件上传好像有点问题，直接贴代码了。

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.

TABLES:
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.?

DATA BEGIN OF HEADER.
INCLUDE STRUCTURE THEAD.
DATA END OF HEADER.

DATA BEGIN OF HEADER_TAB OCCURS 20.
INCLUDE STRUCTURE THEAD.
DATA END OF HEADER_TAB.

DATA BEGIN OF HEADER_DEF.
INCLUDE STRUCTURE THEAD.
DATA END OF HEADER_DEF.

DATA BEGIN OF LINES OCCURS 50.
INCLUDE STRUCTURE TLINE.
DATA END OF LINES.

DATA:BEGIN 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.

DATA:BEGIN 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.

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.

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.

* 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.

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,

**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).

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

data: l_authority_check like boolean value 'X'.
********************************
*
* 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.

************************** 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).

********************************
*
* 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.

* 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.

********************************
*
* 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.

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.

* 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 TEXTKEY USING VALUE(LEN) LOW.
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.

* 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

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.

* 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.

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.

* 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.

    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.

         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.

********************************
*
* 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.

* 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.

* 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.

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.

* import a TEXT
FORM IMPORT_TEXT.
DATA: RC LIKE SY-SUBRC.

PERFORM GET_LANGUAGE_VECTOR USING LANGUAGE_VECTOR.
IF SY-SUBRC <> 0. "exit if language vector cannot be read
NOTHING = TRUE. SUBRC = 4. EXIT.
ENDIF.
* invalidate HEADER,LINES
CLEAR HEADER.
REFRESH LINES.
PERFORM IMPORT_RECORD.
WHILE END_OF_OBJDATA = FALSE AND SUBRC = 0.
CASE RECORD-COMMAND.
 WHEN 'HEAD'.
 HEADER = RECORD-DATA. REFRESH LINES.
 WHEN 'LINE'.
 LINES = RECORD-DATA. APPEND LINES.
 WHEN 'END'.
 IF LANGUAGE_VECTOR CA HEADER-TDSPRAS.
 PERFORM SAVE_TEXT USING RC.
 CASE RC.
 WHEN 0. "SAVE_TEXT o.k.
 WHEN 2. "BAD_LANGUAGE
 IMPORT_OK = FALSE. "suppress 'successful import' message
 WHEN OTHERS. "other ERROR
 IMPORT_OK = FALSE. "should not happen
 ENDCASE.
 ELSE.
* language vector prohibits OLANG export/import
 PERFORM NEWPROT USING NLP_WAR NLP_LV2 NLP_MID '082'
 HEADER-TDSPRAS SPACE SPACE SPACE.
 IMPORT_OK = FALSE. "suppress 'successful import' message
 ENDIF.
* invalidate HEADER,LINES
 CLEAR HEADER. REFRESH LINES.
 WHEN FUNC_NOTHING.
* nothing was imported
 PERFORM NEWPROT USING NLP_WAR NLP_LV3 NLP_MID '069'
 SPACE SPACE SPACE SPACE.
 NOTHING = TRUE.
 WHEN OTHERS.
* format ... is unknown and will be ignored
 PERFORM NEWPROT USING NLP_WAR NLP_LV3 NLP_MID '070'
 RECORD-COMMAND SPACE SPACE SPACE.
ENDCASE.
PERFORM IMPORT_RECORD.
ENDWHILE.
ENDFORM.

* import 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.

* 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.

* 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).

* 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.

* convert 2-digit year to 4-digit for TSP06A timestamps
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.

* 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.

* 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.

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.

* set custom language vector
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.

* 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.

* 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.

FORM SET_MESSAGE_LANGUAGE USING VALUE(LANG). "B20K065126
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.

*********************
* Basic Procedures
*********************

* set binary file format flag
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.

* 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 SET_FILE_SOURCE USING VALUE(LOCALFILE). "B20K053928
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.

* 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.

* 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 EXPORT_TA.
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.

FORM EXPORT_HEADER.
RECORD-TYP = 'H'.
RECORD-COMMAND = OBJECT.
RECORD-DATA = NAME.
IF CLIPBOARD = TRUE.
PERFORM EXPORT_CLIPBOARD USING FALSE. "not end_of_obj
ELSE.
PERFORM EXPDATA(RDDDIC00) USING RECORD.
ENDIF.
ENDFORM.

* export 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.

* 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_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.

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.

* 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.

* 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).

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.

* 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.

* 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.

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.

* 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.

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.

* 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.

* 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.

* 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 .

REFRESH L.
LOOP AT LINES.
* convert format
CLEAR L.
PERFORM CONV_BIN_2_HEX USING LINES-TDFORMAT(1) L-TDFORMAT.
ASSIGN L-TDLINE(2) TO .
PERFORM CONV_BIN_2_HEX USING LINES-TDFORMAT+1(1) .
* convert line(1..65)
DO 65 TIMES.
 ASSIGN +2(2) TO .
 PERFORM CONV_BIN_2_HEX USING LINES-TDLINE(1) .
 SHIFT LINES-TDLINE.
ENDDO.
APPEND L. CLEAR L.
* convert line(66)
PERFORM CONV_BIN_2_HEX USING LINES-TDLINE(1) L-TDFORMAT.
SHIFT LINES-TDLINE.
* convert line(67)
ASSIGN L-TDLINE(2) TO .
PERFORM CONV_BIN_2_HEX USING LINES-TDLINE(1) .
SHIFT LINES-TDLINE.
* convert line(68..132)
DO 65 TIMES.
 ASSIGN +2(2) TO .
 PERFORM CONV_BIN_2_HEX USING LINES-TDLINE(1) .
 SHIFT LINES-TDLINE.
ENDDO.
APPEND L.
ENDLOOP.
REFRESH LINES.
LOOP AT L.
LINES = L. APPEND LINES.
ENDLOOP.
FREE L.
ENDFORM.

* convert 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 .
DATA L_OFFS TYPE I.

REFRESH L.
L_OFFS = 0.
LOOP AT LINES.
IF L_OFFS = 0. "begin of a L-line
 CLEAR L.
* convert l-format
 PERFORM CONV_HEX_2_BIN USING LINES-TDFORMAT L-TDFORMAT(1).
 PERFORM CONV_HEX_2_BIN USING LINES-TDLINE(2) L-TDFORMAT+1(1).
 SHIFT LINES-TDLINE BY 2 PLACES.
* convert l-line(1..65)
 ASSIGN L-TDLINE(1) TO .
 DO 65 TIMES.
 PERFORM CONV_HEX_2_BIN USING LINES-TDLINE(2) .
 SHIFT LINES-TDLINE BY 2 PLACES.
 ASSIGN +1(1) TO .
 ENDDO.
 L_OFFS = 65.
ELSE. "middle of a l-line
 ASSIGN L-TDLINE+65(1) TO .
* convert LINES-TDFORMAT
 PERFORM CONV_HEX_2_BIN USING LINES-TDFORMAT .
* convert LINES-TDLINE
 DO 66 TIMES.
 ASSIGN +1(1) TO .
 PERFORM CONV_HEX_2_BIN USING LINES-TDLINE(2) .
 SHIFT LINES-TDLINE BY 2 PLACES.
 ENDDO.
 APPEND L.
 L_OFFS = 0.
ENDIF.
ENDLOOP.
REFRESH LINES.
LOOP AT L.
LINES = L. APPEND LINES.
ENDLOOP.
FREE L.
ENDFORM.

* 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.

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.

* activate STYLE,FORM
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.

***************************************
* 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

***************************************
* 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.

* 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.

* 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 .

assign bytechar to type 'X'.
x = .
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 .

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 type 'X'.
 = x.
ENDFORM.

***************************************
* 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).

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.

* 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.

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.

***************************************
* 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.

* 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 .

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 TYPE 'C'.
 RECORD = .
WHEN C_CHARSET_EBCDIC.
 ASSIGN REC_ASCII TO TYPE 'C'.
 RECORD = .
WHEN C_CHARSET_UNICODE.
 ASSIGN REC_ASCII TO TYPE 'C'.
 RECORD = .
* 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.

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.

* read a line from transport dataset into RECORD
* 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.

***************************************
* 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.

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.

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.

FORM GUI_FILE_FLUSH_BUFFER.
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.

* 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.

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.

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.

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.

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.

FORM FILE_OPEN USING VALUE(FILENAME) VALUE(I_O_FLAG)
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.

FORM FILE_CLOSE USING VALUE(FILENAME) VALUE(I_O_FLAG).
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.

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.

FORM FILE_WRITE_BIN_REC USING VALUE(FILE) VALUE(BIN_REC) TYPE X
VALUE(NUMBYTES).
STATICS X TYPE X.
field-symbols .

IF FILE_SOURCE_LOCAL = FILE_SOURCE_LOCAL_MAGIC. "GUI download
assign bin_rec to type 'X'.
DO NUMBYTES TIMES.
 X = .
 PERFORM GUI_FILE_PUTBYTE USING X.
* SHIFT BIN_REC.
 assign +1(1) to .
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.

FORM FILE_READ_BIN_REC USING VALUE(FILE) BIN_REC TYPE X
NUMBYTES.
STATICS: BYTE TYPE X.
FIELD-SYMBOLS .

IF FILE_SOURCE_LOCAL = FILE_SOURCE_LOCAL_MAGIC. "GUI upload
ASSIGN BIN_REC(1) TO .
DO NUMBYTES TIMES.
 PERFORM GUI_FILE_GETBYTE USING BYTE.
 CHECK SY-SUBRC = 0.
 = BYTE.
 ASSIGN +1(1) TO .
ENDDO.
ELSE. "server file read
READ DATASET FILE INTO BIN_REC.
ENDIF.
ENDFORM.

***************************************
* 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.

* 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.

* 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.

* 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.

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.

* 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.

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.

* 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.

* 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.

* 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 .

CASE R3_INTERNAL_CHARSET.
WHEN C_CHARSET_ASCII.
 ASSIGN REC TO TYPE 'X'.
 FC_FULL_TAB-RECORD = .
WHEN C_CHARSET_EBCDIC.
 ASSIGN REC TO TYPE 'X'.
 FC_FULL_TAB-RECORD = .
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 TYPE 'X'.
 FC_FULL_TAB-RECORD = .
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.

* 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 .

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 TYPE 'X'.
 = FC_FULL_TAB-RECORD.
WHEN C_CHARSET_EBCDIC.
 ASSIGN REC TO TYPE 'X'.
 = FC_FULL_TAB-RECORD.
WHEN C_CHARSET_UNICODE.
 ASSIGN record_nostruct TO TYPE 'X'.
 = 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 .

* 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.

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.

ZSAPSCRIPFORMEXP.txt

*&---------------------------------------------------------------------*
*& 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).

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.

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.

Sunonce

关注

0
点赞
踩
0

收藏

觉得还不错? 一键收藏
0
评论
【原创】批量下载SAPSCRIPTFORM

昨天在google收索到了批量下载程序和表定义的文章，感觉这些小工具挺好用的。但是在日常的业务中sap script form也是经常要用到和备份的。虽然sap 提供了一个下载的功能，但是一次只能下载一个。于是受到启发，决定做一个可以批量下载的程序。步骤： 1、使用SE38将附件中的程序上传到SAP系统中，开发类选择$TMP即可。 2、执行程序 ZSAPSCRIPFORME
复制链接

扫一扫