Когда-то написал для себя ФМ ZZ_MAKE_DBF для выгрузки в DBF.
Для преобразования в DOS использовал перекодировку 1500->1503.
Писал очень давно, сейчас что-то сделал-бы иначе
P.S. Ну вот, стоит немного отлучиться, и все собственные старые сообщения уже не прочитать. Мда...
структура ZDBF_STRUCT 'Структура DBF-файла':
Code:
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 Значение - байт
TOP-INCUDE:Code:
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 c, " имя поля
fld_type(1) type c, " тип поля
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.
** DBF table
data: DbfBuffer(32768) type x occurs 0 with header line.
** DBF parameters
data: DbfFileSize type i.
data: DbfRecordSize type i.
ФМ: ZZ_MAKE_DBFCode:
FUNCTION ZZ_MAKE_DBF.
*"----------------------------------------------------------------------
*"*"Локальный интерфейс:
*" IMPORTING
*" REFERENCE(FILE) TYPE STRING
*" REFERENCE(IS_DOS) TYPE FLAG DEFAULT 'X'
*" TABLES
*" DBF_STRUCT STRUCTURE ZDBF_STRUCT
*" DBF_DATA
*" EXCEPTIONS
*" EMPTY_DBF_STRUCT
*" SHORT_DBF_DATA
*" UNKNOWN_FLD_TYPE
*" ERROR_DOWNLOAD
*" ERROR_DOWNLOAD_DATA
*"----------------------------------------------------------------------
perform CheckData tables dbf_struct dbf_data.
check sy-subrc = 0.
perform Make_Descriptor tables dbf_struct.
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 file.
check sy-subrc = 0.
perform DownloadData using file.
check sy-subrc = 0.
perform Download_EOF using 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 e...(...) 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 e...(...) with nDataField nStructField
raising short_dbf_data.
else.
sy-subrc = 0.
endif.
exit.
endif.
enddo.
endform.
*---------------------------------------------------------------------*
* FORM Make_Descriptor *
*---------------------------------------------------------------------*
form Make_Descriptor tables dbf_struct structure zdbf_struct.
* для замены пробелов на 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 e...(...) 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.
DbfDescriptor-fld_type = dbf_struct-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.
*---------------------------------------------------------------------*
* 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.
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.
*---------------------------------------------------------------------*
* 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.
*---------------------------------------------------------------------*
* 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>.
if IS_DOS = 'X'.
translate <field_to> from code page '1500'
to code page '1503'.
endif.
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.
*---------------------------------------------------------------------*
* FORM add_dbf *
*---------------------------------------------------------------------*
form add_dbf using cText type x.
data: nLen type i.
DbfBuffer+DbfFileSize = cText.
describe field cText length nLen.
add nLen to DbfFileSize.
endform.
*---------------------------------------------------------------------*
* FORM DownloadHeader *
*---------------------------------------------------------------------*
form DownloadHeader using filename type string.
data: x0D(1) type x VALUE '0D'.
field-symbols <fs> type x.
refresh DbfBuffer.
clear: DbfBuffer, DbfFileSize.
* заголовок
assign DbfHeader to <fs> casting.
perform add_dbf using <fs>.
* дескрипторы
loop at iDbfDescriptor into DbfDescriptor.
assign DbfDescriptor to <fs> casting.
perform add_dbf using <fs>.
endloop.
* терминальный байт
perform add_dbf using x0D.
append DbfBuffer.
CALL FUNCTION 'GUI_DOWNLOAD'
EXPORTING
BIN_FILESIZE = DbfFileSize
FILENAME = filename
FILETYPE = 'BIN'
* APPEND = ' '
TABLES
DATA_TAB = DbfBuffer
EXCEPTIONS
OTHERS = 22.
if sy-subrc <> 0.
* Ошибка выгрузки в &
message e...(...) with filename raising error_download.
endif.
endform.
*---------------------------------------------------------------------*
* FORM DownloadData *
*---------------------------------------------------------------------*
form DownloadData using filename type string.
describe table <tab_to> lines DbfFileSize.
DbfFileSize = DbfFileSize * DbfRecordSize.
CALL FUNCTION 'GUI_DOWNLOAD'
EXPORTING
BIN_FILESIZE = DbfFileSize
FILENAME = filename
FILETYPE = 'BIN'
APPEND = 'X'
TABLES
DATA_TAB = <tab_to>
EXCEPTIONS
OTHERS = 22.
if sy-subrc <> 0.
* Ошибка выгрузки в &
message e...(...) with filename raising error_download.
endif.
endform.
*---------------------------------------------------------------------*
* FORM Download_EOF *
*---------------------------------------------------------------------*
form Download_EOF using filename type string.
data: x1A(1) type x VALUE '1A'.
refresh DbfBuffer.
clear: DbfBuffer, DbfFileSize.
* EOF
perform add_dbf using x1A.
append DbfBuffer.
CALL FUNCTION 'GUI_DOWNLOAD'
EXPORTING
BIN_FILESIZE = DbfFileSize
FILENAME = filename
FILETYPE = 'BIN'
APPEND = 'X'
TABLES
DATA_TAB = DbfBuffer
EXCEPTIONS
OTHERS = 22.
if sy-subrc <> 0.
* Ошибка выгрузки в &
message e...(...) with filename raising error_download.
endif.
endform.