Posted: Thu Feb 26, 2009 3:02 pm Post subject: Выгрузка внутренней таблицы в DBF
Выгрузка внутренней таблицы в файл DBF на сервер представления (клиентскую машину).
Написана после того, как стандартный WS_DOWNLOAD отказался выгружать данные в кодировке DOS.
Работает в версии 4.0, должна и в последующих.
Автор - Armann
Пояснения к параметрам:
FILENAME - полное имя файла
CODEPAGE - кодировка для текстовых данных, WIN или DOS. По умолчанию WIN
DATA_TAB - таблица с данными
NAME_TAB - таблица с наименованиями полей, структура вроде такой: data: NAME_TAB(80) Occurs 10 With Header Line.
PS. По уму желательно бы добавить проверку на соответствие количества наименований полей в NAME_TAB и количества полей в DATA_TAB, но руки не дошли
DATA: DBF_H LIKE ZDBF_HEADER
, DBF_F LIKE ZDBF_FIELD OCCURS 10 WITH HEADER LINE
, DATA_I TYPE I
, TYP
, LEN TYPE I
, LEN_FLDS_DESC TYPE I
, LEN_REC TYPE I
, BUFFER(1024) OCCURS 10 WITH HEADER LINE
, LEN_BUF TYPE I
, POS_BUF TYPE I
, SBUF(100)
, INX TYPE I
, SIZE_BUF TYPE I
, SPACEX(1) TYPE X
, DECI TYPE I
.
FIELD-SYMBOLS: <F>, <F_BUF>, <F_ANY>, <FX> TYPE X.
* Добавить символ номер &2 от переменной &1
DEFINE ADD_CHAR.
INX = &2 - 1.
ASSIGN BUFFER+POS_BUF(1) TO <F_BUF> TYPE 'C'.
ASSIGN &1+INX(1) TO <F_ANY> TYPE 'C'.
<F_BUF> = <F_ANY>.
ADD 1 TO POS_BUF.
IF POS_BUF >= LEN_BUF.
APPEND BUFFER.
CLEAR: BUFFER.
POS_BUF = 0.
ENDIF.
ADD 1 TO SIZE_BUF.
END-OF-DEFINITION.
* Проверим на наличие данных
IF DATA_TAB[] IS INITIAL OR NAME_TAB[] IS INITIAL.
RAISE NO_INPUT_DATA.
ENDIF.
DESCRIBE FIELD BUFFER LENGTH LEN_BUF.
* Заполняем заголовок
DBF_H-FILETYPE = '03'.
DATA_I = SY-DATUM(4) - 1900.
MOVE DATA_I TO DBF_H-LASTCHANGE_YY.
MOVE SY-DATUM+4(2) TO DBF_H-LASTCHANGE_MM.
MOVE SY-DATUM+6(2) TO DBF_H-LASTCHANGE_DD.
DESCRIBE TABLE DATA_TAB LINES DATA_I.
PERFORM I2HEX USING DATA_I CHANGING DBF_H-COUNT_RECORDS.
* Заполняем описание полей
READ TABLE DATA_TAB INDEX 1.
LOOP AT NAME_TAB.
CLEAR DBF_F.
LEN = STRLEN( NAME_TAB ).
ASSIGN NAME_TAB TO <FX> TYPE 'X'.
DBF_F-FIELDNAME = <FX>(LEN).
ASSIGN COMPONENT SY-TABIX OF STRUCTURE DATA_TAB TO <F>.
DESCRIBE FIELD <F> TYPE TYP.
DESCRIBE FIELD <F> OUTPUT-LENGTH LEN.
CASE TYP.
WHEN 'C'. DBF_F-DATATYPE = 'C'.
WHEN 'X'. DBF_F-DATATYPE = 'C'. ADD 1 TO LEN.
WHEN 'P'. DBF_F-DATATYPE = 'N'.
WHEN 'N'. DBF_F-DATATYPE = 'N'.
WHEN 'I'. DBF_F-DATATYPE = 'N'.
WHEN 'F'. DBF_F-DATATYPE = 'F'.
WHEN 's'. DBF_F-DATATYPE = 'N'.
WHEN 'b'. DBF_F-DATATYPE = 'N'.
WHEN 'D'. DBF_F-DATATYPE = 'D'. LEN = 8.
WHEN OTHERS. DBF_F-DATATYPE = 'C'.
ENDCASE.
IF DBF_F-DATATYPE = 'N'.
DESCRIBE FIELD <F> DECIMALS DECI.
IF DECI > 0.
PERFORM I2HEX USING DECI CHANGING DBF_F-DECIMALS.
ENDIF.
ENDIF.
DBF_F-LENGTH_FIELD = LEN. " Длина поля
ADD LEN TO LEN_REC. " Длина записи
DESCRIBE FIELD DBF_F LENGTH LEN. " Длина записи поля
ADD LEN TO LEN_FLDS_DESC. " Общий размер описаний полей
APPEND DBF_F.
ENDLOOP.
ADD 1 TO LEN_REC.
* Дозаполним заголовок
PERFORM I2HEX USING LEN_REC CHANGING DBF_H-LENGTH_REC.
DESCRIBE FIELD DBF_H LENGTH DATA_I.
ADD LEN_FLDS_DESC TO DATA_I.
ADD 1 TO DATA_I.
PERFORM I2HEX USING DATA_I CHANGING DBF_H-FIRST_REC.
* Заполним буфер
* Сначала заголовок
DESCRIBE FIELD DBF_H LENGTH LEN.
DO LEN TIMES.
ASSIGN DBF_H TO <F>.
ADD_CHAR <F> SY-INDEX.
ENDDO.
* Потом описания полей
DESCRIBE FIELD DBF_F LENGTH LEN.
ASSIGN DBF_F TO <F>.
LOOP AT DBF_F.
DO LEN TIMES.
ADD_CHAR <F> SY-INDEX.
ENDDO.
ENDLOOP.
* spacex = '0D'.
PERFORM I2HEX USING 13 CHANGING SPACEX.
ADD_CHAR SPACEX 1.
* Потом данные
LOOP AT DATA_TAB.
PERFORM I2HEX USING 32 CHANGING SPACEX.
* spacex = '20'.
ADD_CHAR SPACEX 1.
DO.
ASSIGN COMPONENT SY-INDEX OF STRUCTURE DATA_TAB TO <F>.
IF SY-SUBRC <> 0. EXIT. ENDIF.
READ TABLE DBF_F INDEX SY-INDEX.
DESCRIBE FIELD <F> TYPE TYP.
DESCRIBE FIELD <F> OUTPUT-LENGTH LEN.
CLEAR SBUF.
CASE TYP.
WHEN 'P' OR 'N' OR 'I' OR 'F'.
CLEAR SBUF.
WRITE <F> TO SBUF LEFT-JUSTIFIED NO-GAP.
DO.
REPLACE '.' WITH '' INTO SBUF.
IF SY-SUBRC <> 0. EXIT. ENDIF.
ENDDO.
REPLACE ',' WITH '.' INTO SBUF.
REPLACE '-' WITH '' INTO SBUF.
IF SY-SUBRC = 0.
CONCATENATE '-' SBUF INTO SBUF.
ENDIF.
CONDENSE SBUF NO-GAPS.
WRITE SBUF TO SBUF(LEN) RIGHT-JUSTIFIED NO-GAP.
DO LEN TIMES.
ADD_CHAR SBUF SY-INDEX.
ENDDO.
WHEN 'D'.
DO 8 TIMES.
ADD_CHAR <F> SY-INDEX.
ENDDO.
WHEN OTHERS.
CASE CODEPAGE.
WHEN 'DOS'. TRANSLATE <F> TO CODE PAGE '1503'.
WHEN 'WIN'. TRANSLATE <F> TO CODE PAGE '1504'.
ENDCASE.
DO LEN TIMES.
ADD_CHAR <F> SY-INDEX.
ENDDO.
ENDCASE.
ENDDO.
ENDLOOP.
************************************************************************
* Число типа integer перекладываем обратным порядком
************************************************************************
FORM I2HEX USING I TYPE I
CHANGING X TYPE X.
FIELD-SYMBOLS: <X> TYPE X.
DATA: LEN TYPE I.
DESCRIBE FIELD X LENGTH LEN.
ASSIGN I TO <X> TYPE 'X'.
CASE LEN.
WHEN 4. X+0(1) = <X>+3(1).
X+1(1) = <X>+2(1).
X+2(1) = <X>+1(1).
X+3(1) = <X>+0(1).
WHEN 2. X+0(1) = <X>+3(1).
X+1(1) = <X>+2(1).
WHEN 1. X+0(1) = <X>+3(1).
ENDCASE.
ENDFORM.
Выяснилось что забыл добавить описание структур ZDBF_HEADER и ZDBF_FIELD
Исправляюсь:
Code:
ZDBF_HEADER
Заголовок DBF-файла
Имя поля Тип Длина Комментарий
FILETYPE RAW 1 DBF: Тип файла
LASTCHANGE_YY RAW 1 DBF: Дата последнего изменения - год (2 символа)
LASTCHANGE_MM RAW 1 DBF: Дата последнего изменения - месяц (2 символа)
LASTCHANGE_DD RAW 1 DBF: Дата последнего изменения - день (2 символа)
COUNT_RECORDS RAW 4 DBF: Количество записей
FIRST_REC RAW 2 DBF: Положение первой записи с данными
LENGTH_REC RAW 2 DBF: Длина одной записи с данными
RESERVED16 RAW 16 DBF: Зарезервировано
CDX_FLAG RAW 1 DBF: Флаг наличия индексного файла (типа .CDX)
RESERVED3 RAW 3 DBF: Зарезервировано
ZDBF_FIELD
Структура описания поля в DBF-файле
Имя поля Тип Длина Комментарий
FIELDNAME RAW 11 DBF: Наименование поля
DATATYPE CHAR 1 DBF: тип данных
OFFSET_FIELD RAW 4 DBF: Расположение поля внутри записи
LENGTH_FIELD RAW 1 DBF: длина поля
DECIMALS RAW 1 DBF: Количество знаков после запятой
RESERVED14 RAW 14 DBF: зарезервировано
You cannot post new topics in this forum You cannot reply to topics in this forum You cannot edit your posts in this forum You cannot delete your posts in this forum You cannot vote in polls in this forum You cannot attach files in this forum You can download files in this forum
All product names are trademarks of their respective companies. SAPNET.RU websites are in no way affiliated with SAP AG. SAP, SAP R/3, R/3 software, mySAP, ABAP, BAPI, xApps, SAP NetWeaver and any other are registered trademarks of SAP AG. Every effort is made to ensure content integrity. Use information on this site at your own risk.
