051   Не задана структура БД
052   Недостаточно полей данных (&). Полей & в структуре.
053   Неизвестный тип поля '&'
054   Ошибка выгрузки в &
055   Ошибка создания объекта конвертации в '&'
056   Ошибка конвертации: '&' (&) поз. & в '&'

FLD_NAME   CHAR11   CHAR   11   0   Длина знака 11
FLD_TYPE   CHAR01   CHAR   1   0   Поле текста (1 знак)
FLD_LEN   INT1   INT1   3   0   Значение - байт
FLD_DEC   INT1   INT1   3   0   Значение - байт

TYPE-POOLS: abap, slis.

DATA: nint4 TYPE int4.

FIELD-SYMBOLS: <tab_to> TYPE table.

TYPES: BEGIN OF tlastdata,
          year(1)          TYPE x,         " YY
          month(1)         TYPE x,         " MM
          day(1)           TYPE x,         " DD
       END   OF tlastdata.

DATA: BEGIN OF dbfheader,
          null_byte(1)     TYPE x,         " заголовочный байт
          last_data        TYPE tlastdata, " дата модификации
          count_rec(4)     TYPE x,         " число записей
          len_header(2)    TYPE x,         " полная длина заголовка
          len_record(2)    TYPE x,         " длина записи
          reserv_1(2)      TYPE x,         "
          flag_transact(1) TYPE x,         " флаг задержки транзакции
          reserv_2(13)     TYPE x,         "
          flag_mdx(1)      TYPE x,         " флаг MDX
          reserv_3(3)      TYPE x,         "
      END   OF dbfheader.

DATA: BEGIN OF dbfdescriptor ,
          fld_name(11)     TYPE x,         " имя поля
          fld_type(1)      TYPE x,         " тип поля
          reserv_1(4)      TYPE x,         "
          fld_len(1)       TYPE x,         " длина поля
          fld_dec(1)       TYPE x,         " десятичных разрядов
          reserv_2(13)     TYPE x,         "
          flag_mdx(1)      TYPE x,         " тег MDX
      END   OF dbfdescriptor .

DATA: idbfdescriptor      LIKE STANDARD TABLE OF dbfdescriptor.

* длина записи (включая байт - признак удаления)
DATA: dbfrecordsize       TYPE i.

********************************************************
DATA: it_tfbin(1)    TYPE x OCCURS 0 WITH HEADER LINE.

FUNCTION zz_make_dbf.
*"----------------------------------------------------------------------
*"*"Локальный интерфейс:
*"  IMPORTING
*"     VALUE(FILE) TYPE  STRING
*"     VALUE(IS_DOS) TYPE  FLAG DEFAULT 'X'
*"     VALUE(IS_APPL) TYPE  FLAG DEFAULT SPACE
*"     VALUE(REPLACEMENT) TYPE  ABAP_REPL DEFAULT SPACE
*"  TABLES
*"      DBF_STRUCT STRUCTURE  ZDBF_STRUCT
*"      DBF_DATA
*"  EXCEPTIONS
*"      EMPTY_DBF_STRUCT
*"      SHORT_DBF_DATA
*"      UNKNOWN_FLD_TYPE
*"      ERROR_DOWNLOAD
*"      CONVERTER_ERROR
*"----------------------------------------------------------------------

  PERFORM checkdata       TABLES dbf_struct dbf_data.
  CHECK sy-subrc = 0.

  PERFORM make_descriptor TABLES dbf_struct USING is_dos.
  CHECK sy-subrc = 0.

  PERFORM makeheader      TABLES dbf_struct dbf_data.
  CHECK sy-subrc = 0.

  PERFORM makedata        TABLES dbf_struct dbf_data USING is_dos.
  CHECK sy-subrc = 0.

  PERFORM downloadheader  USING is_appl file.
  CHECK sy-subrc = 0.

  PERFORM downloaddata    USING is_appl file is_dos replacement.
  CHECK sy-subrc = 0.

  PERFORM download_eof    USING is_appl file.
  CHECK sy-subrc = 0.

ENDFUNCTION.

*---------------------------------------------------------------------*
*       FORM CheckData                                                *
*---------------------------------------------------------------------*
FORM checkdata       TABLES dbf_struct STRUCTURE zdbf_struct
                            dbf_data.

  DATA: ndatafield    TYPE i,
        nstructfield  TYPE i.

  FIELD-SYMBOLS: <field_from>.

  IF dbf_struct[] IS INITIAL.
    sy-subrc = 1.
    MESSAGE e051 RAISING empty_dbf_struct.
  ENDIF.

  DO.
    ASSIGN COMPONENT sy-index OF STRUCTURE dbf_data  TO <field_from>.
    IF sy-subrc = 0.
      ndatafield = sy-index.
    ELSE.
      DESCRIBE TABLE dbf_struct LINES nstructfield.
      IF ndatafield < nstructfield.
        sy-subrc = 2.
        MESSAGE e052 WITH ndatafield nstructfield
                     RAISING short_dbf_data.
      ELSE.
        sy-subrc = 0.
      ENDIF.
      EXIT.
    ENDIF.
  ENDDO.

ENDFORM.                    "CheckData

*---------------------------------------------------------------------*
*       FORM Make_Descriptor                                          *
*---------------------------------------------------------------------*
FORM make_descriptor TABLES dbf_struct STRUCTURE zdbf_struct
                     USING  is_dos     TYPE      flag.

* для замены пробелов на x00 в имени поля
  DATA: ctransf(2) TYPE x VALUE '2000'.

  dbfrecordsize = 1.   " 1 байт - флаг удаления записи

  REFRESH idbfdescriptor.

  LOOP AT dbf_struct.

    TRANSLATE dbf_struct-fld_name TO UPPER CASE.
    TRANSLATE dbf_struct-fld_type TO UPPER CASE.

    CASE dbf_struct-fld_type.
      WHEN 'C'.
*       dbf_struct-fld_len =  .
        dbf_struct-fld_dec = 0.
      WHEN 'L'.
        dbf_struct-fld_len = 1.
        dbf_struct-fld_dec = 0.
      WHEN 'N'.
*     when 'M'.
*     when 'F'.
      WHEN 'D'.
        dbf_struct-fld_len = 8.
        dbf_struct-fld_dec = 0.
      WHEN OTHERS.
        sy-subrc = 1.
        MESSAGE e053 WITH dbf_struct-fld_type RAISING unknown_fld_type.
    ENDCASE.

    MODIFY dbf_struct INDEX sy-tabix.

* создание дескриптора
    CLEAR dbfdescriptor.

*   DbfDescriptor-fld_name = dbf_struct-fld_name.
*   TRANSLATE DbfDescriptor-fld_name USING cTransf.
    PERFORM data_2_x     USING    is_dos
                                  dbf_struct-fld_name
                         CHANGING dbfdescriptor-fld_name.

*   DbfDescriptor-fld_type = dbf_struct-fld_type.
    PERFORM data_2_x     USING    is_dos
                                  dbf_struct-fld_type
                         CHANGING dbfdescriptor-fld_type.

    nint4 = dbf_struct-fld_len.
    PERFORM inttohex USING nint4 1 CHANGING dbfdescriptor-fld_len.

    nint4 = dbf_struct-fld_dec.
    PERFORM inttohex USING nint4 1 CHANGING dbfdescriptor-fld_dec.

    APPEND dbfdescriptor TO idbfdescriptor.

* длина записи
    ADD dbf_struct-fld_len TO dbfrecordsize.

  ENDLOOP.

  sy-subrc = 0.

ENDFORM.                    "Make_Descriptor

*---------------------------------------------------------------------*
*       FORM inttohex                                                 *
*---------------------------------------------------------------------*
* записывает данные в заголовок, дескриптор в соглашениях DOS
* например iNum = 4660 (10СС) = '1234' (16СС)
*          if iLen = 1 then cHex = '34'
*          if iLen = 2 then cHex = '3412'
*          if iLen = 4 then cHex = '34120000'
*---------------------------------------------------------------------*
FORM inttohex USING inum    TYPE int4
                    ilen    TYPE int1
           CHANGING chex    TYPE x.

  DATA: nflagint  TYPE i,
        pos_from  TYPE i,
        pos_to    TYPE i,
        nlenhex   TYPE i.

  FIELD-SYMBOLS <fs> TYPE x.

  CLEAR chex.

* для 64 разрядной платформы 4660 (10СС) = '00001234' (16СС)
* для 32 разрядной платформы 4660 (10СС) = '34120000' (16СС)

  nflagint = 4660.
  ASSIGN nflagint TO <fs> CASTING.

  CASE <fs>+0(1).
    WHEN '00'.               " 00001234         " инвертировать
      ASSIGN inum TO <fs> CASTING.
      DESCRIBE FIELD <fs> LENGTH nlenhex IN BYTE MODE.
      DO ilen TIMES.
        pos_from       = nlenhex - sy-index.    " читать от конца
        pos_to         = sy-index - 1.          " писать от начала
        chex+pos_to(1) = <fs>+pos_from(1).
      ENDDO.

    WHEN '34'.               " 34120000         " взять iLen байт
      ASSIGN inum TO <fs> CASTING.
      chex = <fs>+0(ilen).

    WHEN OTHERS.

  ENDCASE.

ENDFORM.                    "inttohex

*---------------------------------------------------------------------*
*       FORM MakeHeader                                               *
*---------------------------------------------------------------------*
FORM makeheader      TABLES dbf_struct STRUCTURE  zdbf_struct
                            dbf_data.

  CLEAR dbfheader.

* заголовочный байт

* 7   - подключение файла DBT
* 6-5 - флаг SQL
* 4   - ???
* 3   - файл DBT
* 2-0 - Номер версии

  dbfheader-null_byte = '03'. " DBASE III

* дата модификации
  nint4 = sy-datum+2(2).     " YY
  PERFORM inttohex USING nint4 1 CHANGING dbfheader-last_data-year.

  nint4 = sy-datum+4(2).     " MM
  PERFORM inttohex USING nint4 1 CHANGING dbfheader-last_data-month.

  nint4 = sy-datum+6(2).     " DD
  PERFORM inttohex USING nint4 1 CHANGING dbfheader-last_data-day  .

* число записей
  DESCRIBE TABLE dbf_data        LINES nint4.
  PERFORM inttohex USING nint4 4 CHANGING dbfheader-count_rec.

* полная длина заголовка (заголовок + дескрипторы + терминальный байт)
  DESCRIBE TABLE idbfdescriptor LINES nint4.
  nint4 = nint4 * 32 + 32 + 1.
  PERFORM inttohex USING nint4 2 CHANGING dbfheader-len_header.

* длина записи (включая байт - признак удаления)
  nint4 = dbfrecordsize.
  PERFORM inttohex USING nint4 2 CHANGING dbfheader-len_record.

  sy-subrc = 0.

ENDFORM.                    "MakeHeader

*---------------------------------------------------------------------*
*       FORM MakeData                                                 *
*---------------------------------------------------------------------*
FORM makedata        TABLES dbf_struct STRUCTURE  zdbf_struct
                            dbf_data
                      USING is_dos   TYPE  flag.

  DATA: lt_fieldcat TYPE lvc_t_fcat         ,
        fcat_line   LIKE LINE OF lt_fieldcat,
        gt_outtab   TYPE REF TO data        ,
        gf_line     TYPE REF TO data        .

  FIELD-SYMBOLS: <line_to>   ,
                 <field_from>,
                 <field_to>  .

  REFRESH lt_fieldcat.

* флаг удаления записи
  CLEAR fcat_line.
  fcat_line-fieldname = 'FLAG_DEL_123456789'. " > 11 знаков
  fcat_line-inttype   = 'C'.
  fcat_line-outputlen = '1'.
  APPEND fcat_line TO lt_fieldcat.

  LOOP AT dbf_struct.

    CLEAR fcat_line.
    fcat_line-fieldname = dbf_struct-fld_name.

    CASE dbf_struct-fld_type.
      WHEN 'C'.
        fcat_line-inttype   = 'C'.
        fcat_line-outputlen = dbf_struct-fld_len.

      WHEN 'L'.
        fcat_line-inttype   = 'C'.
        fcat_line-outputlen = dbf_struct-fld_len.

      WHEN 'N'.
*       fcat_line-inttype   = 'P'.
*       fcat_line-outputlen = dbf_struct-fld_len.
*       fcat_line-decimals  = dbf_struct-fld_dec.
        fcat_line-inttype   = 'C'.
        fcat_line-outputlen = dbf_struct-fld_len.

*     when 'M'.
*     when 'F'.
      WHEN 'D'.
        fcat_line-inttype   = dbf_struct-fld_type.
        fcat_line-outputlen = dbf_struct-fld_len.

      WHEN OTHERS.
    ENDCASE.

    APPEND fcat_line TO lt_fieldcat.

  ENDLOOP.

  CALL METHOD cl_alv_table_create=>create_dynamic_table
    EXPORTING
      it_fieldcatalog = lt_fieldcat
    IMPORTING
      ep_table        = gt_outtab.

  ASSIGN gt_outtab->* TO <tab_to>.

  CREATE DATA gf_line LIKE LINE OF <tab_to>.
  ASSIGN gf_line->* TO <line_to>.

  LOOP AT dbf_data.

    LOOP AT dbf_struct.

      nint4 = sy-tabix + 1. " смещение + 1 за счет флага удаления.

      ASSIGN COMPONENT sy-tabix OF STRUCTURE dbf_data  TO <field_from>.
      ASSIGN COMPONENT nint4    OF STRUCTURE <line_to> TO <field_to>  .

      CASE dbf_struct-fld_type.
        WHEN 'C'.
          <field_to> = <field_from>.
        WHEN 'L'.
          IF <field_from> CA 'TtYyXx'.
            <field_to> = 'T'.
          ELSE.
            <field_to> = 'F'.
          ENDIF.
        WHEN 'N'.
          WRITE <field_from> TO <field_to> LEFT-JUSTIFIED NO-GROUPING
                                           DECIMALS dbf_struct-fld_dec.
          REPLACE ',' WITH '.' INTO <field_to>.

          SEARCH <field_to> FOR '-'.
          IF sy-subrc = 0.
            <field_to>+sy-fdpos(1) = ''.
            SHIFT <field_to> BY 1 PLACES RIGHT.
            <field_to>+0(1) = '-'.
          ENDIF.
          SHIFT <field_to> RIGHT DELETING TRAILING space.
*       when 'M'.
*       when 'F'.
        WHEN 'D'.
          <field_to> = <field_from>.
        WHEN OTHERS.
      ENDCASE.

    ENDLOOP.

    APPEND <line_to> TO <tab_to>.

  ENDLOOP.

  sy-subrc = 0.

ENDFORM.                    "MakeData

*---------------------------------------------------------------------*
*       FORM add_dbf                                                  *
*---------------------------------------------------------------------*
FORM add_dbf USING    ctext   TYPE x
             CHANGING xbuffer TYPE x
                      xsize   TYPE i.

  DATA: nlen TYPE i.

  xbuffer+xsize = ctext.

  DESCRIBE FIELD ctext LENGTH nlen IN BYTE MODE.
  ADD nlen TO xsize.

ENDFORM.                    "add_dbf

*---------------------------------------------------------------------*
*       FORM DownloadHeader                                           *
*---------------------------------------------------------------------*
FORM downloadheader  USING is_appl  TYPE flag
                           filename TYPE string.

  DATA: x0d(1)    TYPE x VALUE '0D'.

  DATA: xstring   TYPE xstring.
  DATA: hex_tab   LIKE STANDARD TABLE OF tbl1024.
  DATA: bytes     TYPE i.

  DATA: xbuffer(32768) TYPE x.
  DATA: xsize          TYPE i.

  FIELD-SYMBOLS <fs> TYPE x.

* заголовок
  ASSIGN dbfheader TO <fs> CASTING.
  PERFORM add_dbf USING <fs> CHANGING xbuffer xsize.

* дескрипторы
  LOOP AT idbfdescriptor INTO dbfdescriptor.
    ASSIGN dbfdescriptor TO <fs> CASTING.
    PERFORM add_dbf USING <fs> CHANGING xbuffer xsize.
  ENDLOOP.

* терминальный байт
  PERFORM add_dbf USING x0d CHANGING xbuffer xsize.

* отрезать хвост от буффера
  xstring = xbuffer+0(xsize).

* в таблицу для выгрузки
  PERFORM buffer_2_hex_tab TABLES   hex_tab
                           CHANGING xstring
                                    bytes.

  IF is_appl IS INITIAL.
    PERFORM download_presentation TABLES   hex_tab
                                  USING    filename
                                           space
                                           bytes.
  ELSE.
    PERFORM download_application  TABLES   hex_tab
                                  USING    filename
                                           space
                                           bytes.
  ENDIF.

ENDFORM.                    "DownloadHeader

*---------------------------------------------------------------------*
*       FORM DownloadData                                             *
*---------------------------------------------------------------------*
FORM downloaddata     USING is_appl     TYPE flag
                            filename    TYPE string
                            is_dos      TYPE flag
                            replacement TYPE abap_repl.

* объект для конвертации
  DATA: convout        TYPE REF TO cl_abap_conv_out_ce.
  DATA: encoded_string TYPE xstring.

* таблица в 16CC для выгрузки
  DATA: hex_tab        LIKE STANDARD TABLE OF tbl1024.
  DATA: bytes          TYPE i.

* получить объект для конвертации
  PERFORM make_converter USING    is_dos
                                  replacement
                         CHANGING convout.

  FIELD-SYMBOLS: <fs_line>  TYPE ANY,
                 <fs_field> TYPE c.

* строку разворачиваем вертикально, по одному байту,
* преобразуя к 16CC (для выгрузки в BIN)
  DATA: it_tab(1)     TYPE x OCCURS 0 WITH HEADER LINE.

*  LOOP AT <tab_to> ASSIGNING <fs_line>.
*    DO.
*      ASSIGN COMPONENT sy-index OF STRUCTURE <fs_line> TO <fs_field>
*                       TYPE 'C'.
*      IF sy-subrc = 0.
*        PERFORM convert       USING    is_dos
*                                       replacement
*                                       <fs_field>
*                              CHANGING convout.
*      ELSE.
*        EXIT.
*      ENDIF.
*    ENDDO.
*  ENDLOOP.

* для ускорения будем перекодировать сразу всю строку
  LOOP AT <tab_to> ASSIGNING <fs_line>.
    ASSIGN  <fs_line> TO <fs_field> CASTING.
    PERFORM convert       USING    is_dos
                                   replacement
                                   <fs_field>
                          CHANGING convout.
  ENDLOOP.

* получить перекодированную строку
  CALL METHOD convout->get_buffer
    RECEIVING
      buffer = encoded_string.

* переложить в таблицу по 1K
  PERFORM buffer_2_hex_tab TABLES   hex_tab
                           CHANGING encoded_string
                                    bytes.

  IF is_appl IS INITIAL.

    PERFORM download_presentation TABLES   hex_tab
                                  USING    filename
                                           'X'
                                           bytes.
  ELSE.
    PERFORM download_application  TABLES   hex_tab
                                  USING    filename
                                           'X'
                                           bytes.
  ENDIF.

ENDFORM.                    "DownloadData

*---------------------------------------------------------------------*
*       FORM Download_EOF                                             *
*---------------------------------------------------------------------*
FORM download_eof     USING is_appl  TYPE flag
                            filename TYPE string.

  DATA: x1a(1) TYPE x VALUE '1A'.

  DATA: hex_tab        LIKE STANDARD TABLE OF tbl1024.
  DATA: bytes          TYPE i.
  DATA: hex_record     LIKE LINE OF hex_tab.

  hex_record-line = x1a.
  APPEND hex_record TO hex_tab.
  bytes = XSTRLEN( x1a ).

  IF is_appl IS INITIAL.
    PERFORM download_presentation TABLES   hex_tab
                                  USING    filename
                                           'X'
                                           bytes.
  ELSE.
    PERFORM download_application  TABLES   hex_tab
                                  USING    filename
                                           'X'
                                           bytes.
  ENDIF.

ENDFORM.                    "Download_EOF

*&---------------------------------------------------------------------*
*&      form  data_2_x
*&---------------------------------------------------------------------*
FORM data_2_x     USING    is_dos   TYPE flag
                           data_chr TYPE c
                  CHANGING data_x   TYPE x.

* объект для конвертации
  DATA: convout          TYPE REF TO cl_abap_conv_out_ce.
  DATA: encoded_string   TYPE xstring.
  DATA: len              TYPE i.

  CLEAR data_x.

* получить объект для конвертации
  PERFORM make_converter USING    is_dos
                                  space
                         CHANGING convout.

  PERFORM convert        USING    is_dos
                                  space
                                  data_chr
                         CHANGING convout.

  CALL METHOD convout->get_buffer
    RECEIVING
      buffer = encoded_string.

  len = STRLEN( data_chr ).

  data_x+0(len) = encoded_string+0(len).

ENDFORM.                                                    "data_2_x

*&---------------------------------------------------------------------*
*&      Form  make_converter
*&---------------------------------------------------------------------*
FORM make_converter USING    is_dos      TYPE flag
                             replacement TYPE abap_repl
                    CHANGING convout    TYPE REF TO cl_abap_conv_out_ce.

  DATA:
    encoding    TYPE abap_encoding,
    ignore_cerr TYPE abap_bool.
  DATA:
*   text        type string,
    oref        TYPE REF TO cx_root.

  IF is_dos = 'X'.
    encoding = '1503'.
  ELSE.
    encoding = '1504'.
  ENDIF.

  IF replacement IS INITIAL.
    ignore_cerr = abap_false.
  ELSE.
    ignore_cerr = abap_true .
  ENDIF.

  TRY.
      CALL METHOD cl_abap_conv_out_ce=>create
        EXPORTING
          encoding    = encoding
*         endian      =
          replacement = replacement
          ignore_cerr = ignore_cerr
        RECEIVING
          conv        = convout.
*   CATCH cx_parameter_invalid_range .
*   CATCH cx_sy_codepage_converter_init .
    CATCH cx_root INTO oref.
*     text = oref->get_text( ).
*     Ошибка создания объекта конвертации в '&'
      MESSAGE e055 WITH encoding RAISING converter_error.
  ENDTRY.

ENDFORM.                    "make_converter

*&---------------------------------------------------------------------*
*&      Form  convert
*&---------------------------------------------------------------------*
FORM convert       USING    is_dos      TYPE flag
                            replacement TYPE abap_repl
                            data        TYPE any
                   CHANGING convout     TYPE REF TO cl_abap_conv_out_ce.

  DATA:
*   text        TYPE string,
    oref        TYPE REF TO cx_root.

  TRY.
      CALL METHOD convout->write
        EXPORTING
*         n    = text_len
          data = data.
*   CATCH cx_sy_codepage_converter_init .
*   CATCH cx_sy_conversion_codepage .
*   CATCH cx_parameter_invalid_type .
*   CATCH cx_parameter_invalid_range .
    CATCH cx_root INTO oref.

      PERFORM convert_error     USING    is_dos
                                         replacement
                                         data.

  ENDTRY.

ENDFORM.                    "convert

*&---------------------------------------------------------------------*
*&      Form  convert_error
*&---------------------------------------------------------------------*
FORM convert_error     USING    is_dos      TYPE flag
                                replacement TYPE abap_repl
                                data        TYPE any.

  DATA:
    convout     TYPE REF TO cl_abap_conv_out_ce.

  DATA:
    text        TYPE string,
    oref        TYPE REF TO cx_root.

  DATA:
    n_pos       TYPE sy-fdpos,
    char01      TYPE char01,
    subrc       TYPE sy-subrc.

  PERFORM make_converter USING    is_dos
                                  replacement
                         CHANGING convout.

* посимвольным перебором найти ошибочный знак
  DO.
    n_pos = sy-index - 1.
    PERFORM get_char01 USING    data    " очередной символ
                                n_pos
                       CHANGING char01
                                subrc.
    IF subrc = 0.
      TRY.
          CALL METHOD convout->write
            EXPORTING
*             n    = text_len
              data = char01.
        CATCH cx_root INTO oref.
          PERFORM char_2_view_x USING    char01  " ошибочный знак
                                CHANGING text.              " в 16CC
          n_pos = n_pos + 1.
          EXIT.
      ENDTRY.
    ELSE.
      EXIT.
    ENDIF.
  ENDDO.

* Ошибка конвертации: '&' (&) поз. & в '&'
  MESSAGE e056 WITH char01 text n_pos data RAISING converter_error.

ENDFORM.                    "convert_error

*&---------------------------------------------------------------------*
*&      Form  get_chr
*&---------------------------------------------------------------------*
FORM get_char01 USING    data   TYPE any
                         pos    TYPE sy-fdpos
                CHANGING char01 TYPE char01
                         subrc  TYPE sy-subrc.

  CLEAR: char01, subrc.

  CATCH SYSTEM-EXCEPTIONS data_access_errors = 1.
    char01 = data+pos(1).
  ENDCATCH.
  subrc = sy-subrc.

ENDFORM.                                                    "get_char01

*&---------------------------------------------------------------------*
*&      Form  char_2_view_x
*&---------------------------------------------------------------------*
*  данные в виде символьной строки в 16CC (для внешнего предствления)
*&---------------------------------------------------------------------*
FORM char_2_view_x USING    data   TYPE any
                   CHANGING view_x TYPE string.

  DATA: len_byte TYPE sy-fdpos,
        pos      TYPE sy-fdpos,
        chr(2)   TYPE c.

  FIELD-SYMBOLS <fs> TYPE x.

  CLEAR: view_x.

  ASSIGN data TO <fs> CASTING.

  DESCRIBE FIELD <fs> LENGTH len_byte IN BYTE MODE.
  DO len_byte TIMES.
    pos = sy-index - 1.
    chr = <fs>+pos(1).
    CONCATENATE view_x chr INTO view_x.
  ENDDO.

ENDFORM.                    "char_2_view_x

*&---------------------------------------------------------------------*
*&      Form  buffer_2_hex_tab
*&---------------------------------------------------------------------*
FORM buffer_2_hex_tab TABLES   hex_tab        STRUCTURE tbl1024
                      CHANGING encoded_string TYPE xstring
                               bytes          TYPE i.

  DATA: hex_record       LIKE LINE OF hex_tab.
  DATA: bytes_len_rest   TYPE i.
  DATA: bytes_len_record TYPE i.

  REFRESH hex_tab.

*  попробуем поэкономить память за счет уменьшения encoded_string
*  при перекладке в hex_tab

*  CALL FUNCTION 'SCMS_XSTRING_TO_BINARY'
*    EXPORTING
*      buffer                = buffer
*      append_to_table       = 'X'
**   importing
**     output_length         =
*    TABLES
*      binary_tab            = hex_tab.

  bytes           = XSTRLEN( encoded_string ).
  bytes_len_rest  = XSTRLEN( encoded_string ).

  DESCRIBE FIELD hex_record LENGTH bytes_len_record IN BYTE MODE.

  WHILE bytes_len_rest > bytes_len_record.
    MOVE encoded_string(bytes_len_record) TO hex_record-line.
    APPEND hex_record TO hex_tab.
    encoded_string = encoded_string+bytes_len_record.
    bytes_len_rest = XSTRLEN( encoded_string ).
  ENDWHILE.

  IF bytes_len_rest > 0.
    MOVE encoded_string TO hex_record-line.
    APPEND hex_record TO hex_tab.
  ENDIF.

ENDFORM.                    "buffer_2_hex_tab

*&---------------------------------------------------------------------*
*&      Form  download_presentation
*&---------------------------------------------------------------------*
*       выгружаем на  presantation
*&---------------------------------------------------------------------*
FORM download_presentation TABLES   hex_tab  STRUCTURE tbl1024
                           USING    filename TYPE string
                                    append   TYPE char01
                                    bytes    TYPE i.

* выгружаем в двоичном виде
  CALL FUNCTION 'GUI_DOWNLOAD'
    EXPORTING
      bin_filesize = bytes
      filename     = filename
      filetype     = 'BIN'
      append       = append
    TABLES
      data_tab     = hex_tab
    EXCEPTIONS
      OTHERS       = 22.

  IF sy-subrc <> 0.
    MESSAGE e054 WITH filename RAISING error_download.
  ENDIF.

ENDFORM.                    "download_presentation

*&---------------------------------------------------------------------*
*&      Form  download_application
*&---------------------------------------------------------------------*
*       выгружаем на  application
*&---------------------------------------------------------------------*
FORM download_application  TABLES   hex_tab  STRUCTURE tbl1024
                           USING    filename TYPE string
                                    append   TYPE char01
                                    bytes    TYPE i.

  DATA: bytes_len_rest   TYPE i.
  DATA: bytes_len_record TYPE i.

  FIELD-SYMBOLS: <fs> LIKE LINE OF hex_tab.

  DESCRIBE FIELD <fs> LENGTH bytes_len_record IN BYTE MODE.

* выгружаем в двоичном виде
  IF append IS INITIAL.
    OPEN DATASET filename FOR OUTPUT    IN BINARY MODE.
  ELSE.
    OPEN DATASET filename FOR APPENDING IN BINARY MODE.
  ENDIF.
  IF sy-subrc <> 0.
    MESSAGE e054 WITH filename RAISING error_download.
  ENDIF.

  LOOP AT hex_tab ASSIGNING <fs>.

    IF bytes > bytes_len_record.
      bytes_len_rest = bytes_len_record.
    ELSE.
      bytes_len_rest = bytes.
    ENDIF.

    TRANSFER <fs> TO filename LENGTH bytes_len_rest.
    bytes = bytes - bytes_len_rest.

  ENDLOOP.

  CLOSE DATASET filename .

ENDFORM.                    "download_application

FUNCTION zz_load_dbf.
*"----------------------------------------------------------------------
*"*"Локальный интерфейс:
*"  IMPORTING
*"     VALUE(I_FILE) TYPE  STRING OPTIONAL
*"     REFERENCE(I_DOS_FLAG) TYPE  FLAG DEFAULT 'X'
*"  TABLES
*"      DBF_STRUCT STRUCTURE  ZDBF_STRUCT OPTIONAL
*"  CHANGING
*"     REFERENCE(IT_FIELDCAT) TYPE  LVC_T_FCAT OPTIONAL
*"     REFERENCE(IT_DBF_DATA) TYPE REF TO  DATA OPTIONAL
*"  EXCEPTIONS
*"      UNKNOWN_FLD_TYPE
*"----------------------------------------------------------------------

  DATA:
    descr_count       TYPE i,
    mimetype(30)      TYPE c,
    pos               TYPE sy-index.

  DATA: header        LIKE dbfheader.

  DATA: count_rec     TYPE i,
        len_header    TYPE i,
        len_record    TYPE i.

  DATA: descriptor_x  LIKE dbfdescriptor.

  DATA: wa_fieldcat   LIKE LINE OF it_fieldcat,
*       gt_outtab     TYPE REF TO data,
        gf_line       TYPE REF TO data.

  FIELD-SYMBOLS: <tab> TYPE table,
                 <line>,
                 <field>.

  DATA: text_buffer        TYPE string,
        flag_del           TYPE flag.

  REFRESH: it_fieldcat, dbf_struct.

  CALL FUNCTION 'GUI_UPLOAD'
    EXPORTING
      filename                = i_file
      filetype                = 'BIN'
    TABLES
      data_tab                = it_tfbin
    EXCEPTIONS
      file_open_error         = 1
      file_read_error         = 2
      no_batch                = 3
      gui_refuse_filetransfer = 4
      invalid_type            = 5
      no_authority            = 6
      unknown_error           = 7
      bad_data_format         = 8
      header_not_allowed      = 9
      separator_not_allowed   = 10
      header_too_long         = 11
      unknown_dp_error        = 12
      access_denied           = 13
      dp_out_of_memory        = 14
      disk_full               = 15
      dp_timeout              = 16
      OTHERS                  = 17.
  IF sy-subrc <> 0.
    MESSAGE ID sy-msgid TYPE sy-msgty NUMBER sy-msgno
            WITH sy-msgv1 sy-msgv2 sy-msgv3 sy-msgv4.
  ENDIF.

  CASE i_dos_flag.
    WHEN 'X'.
      mimetype = 'charset=cp866'.
    WHEN space.
      mimetype = 'charset=windows-1251'.
  ENDCASE.


  PERFORM get_header CHANGING header.

  PERFORM get_4int USING header-count_rec  CHANGING count_rec .
  PERFORM get_2int USING header-len_header CHANGING len_header.
  PERFORM get_2int USING header-len_record CHANGING len_record.

  descr_count = ( len_header - 1 - 32 ) / 32.

  DO descr_count TIMES.
    PERFORM get_descriptor USING    sy-index
                           CHANGING descriptor_x.

    PERFORM get_data       USING    descriptor_x-fld_name
                                    1
                                    10
                                    abap_true
                                    mimetype
                           CHANGING dbf_struct-fld_name.

    PERFORM get_data       USING    descriptor_x-fld_type
                                    1
                                    1
                                    abap_true
                                    mimetype
                           CHANGING dbf_struct-fld_type.

    dbf_struct-fld_len  = descriptor_x-fld_len.
    dbf_struct-fld_dec  = descriptor_x-fld_dec.
    APPEND dbf_struct.
  ENDDO.

* Построение каталога полей для выходной таблицы
  LOOP AT dbf_struct.

    CLEAR wa_fieldcat.

    wa_fieldcat-fieldname = dbf_struct-fld_name.

    CASE dbf_struct-fld_type.
      WHEN 'C'.
        wa_fieldcat-inttype   = 'C'.
        wa_fieldcat-outputlen = dbf_struct-fld_len.
        wa_fieldcat-intlen    = dbf_struct-fld_len.
      WHEN 'L'.
        wa_fieldcat-inttype   = 'C'.
        wa_fieldcat-outputlen = '1'.
        wa_fieldcat-intlen    = '1'.
      WHEN 'N'.
        wa_fieldcat-inttype   = 'P'.
        wa_fieldcat-decimals  = dbf_struct-fld_dec.

* Ограничение длины поля типа P
        IF dbf_struct-fld_len > 16.
          wa_fieldcat-outputlen = 16.
          wa_fieldcat-intlen    = 16.
        ELSE.
          wa_fieldcat-outputlen = dbf_struct-fld_len.
          wa_fieldcat-intlen    = dbf_struct-fld_len.
        ENDIF.

*     when 'M'.
*     when 'F'.

      WHEN 'D'.
        wa_fieldcat-inttype   = dbf_struct-fld_type.
        wa_fieldcat-outputlen = 8.
      WHEN OTHERS.
        sy-subrc = 1.
        MESSAGE e053 WITH dbf_struct-fld_type
                     RAISING unknown_fld_type.
    ENDCASE.

    APPEND wa_fieldcat TO it_fieldcat.

  ENDLOOP.

* создать динамическую таблицу
  CALL METHOD cl_alv_table_create=>create_dynamic_table
    EXPORTING
*      i_style_table             =
      it_fieldcatalog           = it_fieldcat
      i_length_in_byte          = abap_true
    IMPORTING
      ep_table                  = it_dbf_data. " gt_outtab.
*      e_style_fname             =
*    EXCEPTIONS
*      generate_subpool_dir_full = 1
*      others                    = 2
  .
  IF sy-subrc <> 0.
*   MESSAGE ID SY-MSGID TYPE SY-MSGTY NUMBER SY-MSGNO
*              WITH SY-MSGV1 SY-MSGV2 SY-MSGV3 SY-MSGV4.
  ENDIF.

*  ASSIGN gt_outtab->* TO <tab>.
  ASSIGN it_dbf_data->* TO <tab>.
  CREATE DATA gf_line LIKE LINE OF <tab>.
  ASSIGN gf_line->* TO <line>.

  DO count_rec TIMES.

    PERFORM get_record USING    len_header
                                len_record
                                sy-index
                                mimetype
                       CHANGING text_buffer.

* Проверка флага удаления записи обязательно через присвоение
* символьной переменной, иначе не работает IF
    flag_del = text_buffer+0(1).

    IF flag_del IS INITIAL.

      pos = 1.

      LOOP AT dbf_struct.

        ASSIGN COMPONENT dbf_struct-fld_name
                         OF STRUCTURE <line>      TO <field>.

        CATCH SYSTEM-EXCEPTIONS conversion_errors = 1.
          <field> = text_buffer+pos(dbf_struct-fld_len).
        ENDCATCH.

        pos = pos + dbf_struct-fld_len.
      ENDLOOP.

      APPEND <line> TO <tab>.
    ENDIF.

  ENDDO.

ENDFUNCTION.


*&---------------------------------------------------------------------*
*&      Form  get_header
*&---------------------------------------------------------------------*
FORM get_header     CHANGING header     LIKE dbfheader.

  DATA: wa_32(32) TYPE x,
        pos       TYPE sy-index.

  FIELD-SYMBOLS: <fs_in>     TYPE x,
                 <fs_out>    TYPE x,
                 <fs_header> TYPE ANY.

  DO 32 TIMES.
*   from
    READ TABLE it_tfbin INDEX sy-index ASSIGNING <fs_in>.
* to
    pos = sy-index - 1.
    ASSIGN wa_32+pos(1) TO <fs_out>.
    <fs_out> = <fs_in>.
  ENDDO.

  ASSIGN wa_32 TO <fs_header> CASTING LIKE dbfheader.
  header = <fs_header>.

ENDFORM.                    "get_header

*&---------------------------------------------------------------------*
*&      Form  get_descriptor
*&---------------------------------------------------------------------*
FORM get_descriptor USING    num          TYPE sy-index
                    CHANGING descriptor_x LIKE dbfdescriptor.

  DATA: wa_32(32) TYPE x,
        pos       TYPE sy-index,
        pos_start TYPE sy-index.

  FIELD-SYMBOLS: <fs_in>            TYPE x,
                 <fs_out>           TYPE x,
                 <fs_dbfdescriptor> TYPE ANY.

  pos_start = num * 32.

  DO 32 TIMES.
*   from
    pos = pos_start + sy-index.
    READ TABLE it_tfbin INDEX pos ASSIGNING <fs_in>.
* to
    pos = sy-index - 1.
    ASSIGN wa_32+pos(1) TO <fs_out>.
    <fs_out> = <fs_in>.
  ENDDO.

  ASSIGN wa_32 TO <fs_dbfdescriptor> CASTING LIKE dbfdescriptor.
  descriptor_x = <fs_dbfdescriptor>.

ENDFORM.                    "get_descriptor

*&---------------------------------------------------------------------*
*&      Form  get_data
*&---------------------------------------------------------------------*
FORM get_data USING    var_x      TYPE x
                       start      TYPE i
                       count      TYPE i
                       if_exit    TYPE flag
                       i_mimetype TYPE c
              CHANGING var_c      TYPE c.

  DATA: text_buffer      TYPE string.

  DATA: binary_tab(1)    TYPE x OCCURS 0 WITH HEADER LINE.

  PERFORM get_binary_tab TABLES binary_tab
                         USING  var_x
                                start
                                count
                                if_exit.

  CALL FUNCTION 'SCMS_BINARY_TO_STRING'
    EXPORTING
      input_length = count
      mimetype     = i_mimetype
    IMPORTING
      text_buffer  = text_buffer
    TABLES
      binary_tab   = binary_tab
    EXCEPTIONS
      failed       = 1
      OTHERS       = 2.
  IF sy-subrc = 0.
    var_c = text_buffer.
  ELSE.
* MESSAGE ID SY-MSGID TYPE SY-MSGTY NUMBER SY-MSGNO
*         WITH SY-MSGV1 SY-MSGV2 SY-MSGV3 SY-MSGV4.
  ENDIF.

ENDFORM.                    "get_data


*&---------------------------------------------------------------------*
*&      Form  get_record
*&---------------------------------------------------------------------*
FORM get_record USING    i_headerlen   TYPE i
                         i_recordlen   TYPE i
                         i_rec_num     TYPE i
                         i_mimetype    TYPE c
                CHANGING i_text_buffer TYPE string.

  FIELD-SYMBOLS: <x_record> TYPE x.

  DATA: start_pos  TYPE i,
        end_pos    TYPE i,
        it_xrecord TYPE STANDARD TABLE OF x.

  start_pos = i_headerlen + ( i_rec_num - 1 ) * i_recordlen + 1.
  end_pos   = start_pos + i_recordlen - 1.

  LOOP AT it_tfbin ASSIGNING <x_record> FROM start_pos TO end_pos.
    APPEND <x_record> TO it_xrecord.
  ENDLOOP.

  CALL FUNCTION 'SCMS_BINARY_TO_STRING'
    EXPORTING
      input_length = i_recordlen
      mimetype     = i_mimetype
    IMPORTING
      text_buffer  = i_text_buffer
    TABLES
      binary_tab   = it_xrecord
    EXCEPTIONS
      failed       = 1
      OTHERS       = 2.
  IF sy-subrc = 0.
  ELSE.
* MESSAGE ID SY-MSGID TYPE SY-MSGTY NUMBER SY-MSGNO
*         WITH SY-MSGV1 SY-MSGV2 SY-MSGV3 SY-MSGV4.
  ENDIF.

ENDFORM.                    "get_records
*&---------------------------------------------------------------------*
*&      Form  get_binary_tab
*&---------------------------------------------------------------------*
FORM get_binary_tab TABLES binary_tab
                    USING  var_x      TYPE x
                           start      TYPE i
                           count      TYPE i
                           if_exit    TYPE flag.
  DATA: pos  TYPE i,
        byte TYPE x.

  REFRESH: binary_tab.
  DO count TIMES.
    pos  = start - 1 + sy-index - 1.
    byte = var_x+pos(1).
    IF byte IS INITIAL AND if_exit = abap_true.
      EXIT.
    ELSE.
      APPEND byte TO binary_tab.
    ENDIF.
  ENDDO.

ENDFORM.                    "get_binary_tab
*---------------------------------------------------------------------*
*       FORM GET_4INT                                                 *
*---------------------------------------------------------------------*
FORM get_4int USING    var_x TYPE x
              CHANGING res   TYPE i.
  DATA: s(4) TYPE x.
  MOVE var_x(1)   TO s+3(1).
  MOVE var_x+1(1) TO s+2(1).
  MOVE var_x+2(1) TO s+1(1).
  MOVE var_x+3(1) TO s(1).
  res = s.
ENDFORM.                                                    "GET_4INT

*---------------------------------------------------------------------*
*       FORM GET_2INT                                                 *
*---------------------------------------------------------------------*
FORM get_2int USING    var_x TYPE x
              CHANGING res   TYPE i.
  DATA: s(2) TYPE x.
  MOVE var_x(1)   TO s+1(1).
  MOVE var_x+1(1) TO s(1).
  res = s.
ENDFORM.                                                    "GET_2INT