пятница, 25 октября 2013 г.

Чтение XML средствами ABAP

Сегодня будем разбирать XML используя класс cl_xml_document и интерфейсы if_ixml_node, if_ixml_node_iterator, if_ixml_node_filter.

пятница, 18 октября 2013 г.

Курсы валют. Часть 2.

В первой части было описано как можно грузить курсы валют с сайта ЦБ РФ. Но иногда случаются ситуации, когда сервер ЦБ РФ временно перестает отвечать на запросы. В таком случае необходим другой источник курсов, т.к. ждать когда вновь поднимут сервер можно долго. Поиск в google навел на скромный API сайта РБК, который позволяет так же ежедневно грузить курсы валют.Ниже представлена реализация загрузки в SAP.

понедельник, 14 октября 2013 г.

Определение символа разделения дробной части

Может пригодиться при загрузке данных из Excel средствами OLE
Код
type-pools ole2. start-of-selection. data: curseparator. *------------перформа для определения знака разделения дробной части perform get_excel_decimal_separator using curseparator. write curseparator. *&---------------------------------------------------------------------* *& Form get_excel_decimal_separator *&---------------------------------------------------------------------* form get_excel_decimal_separator using result. data: app type ole2_object, usesystemseparators(10). create object app 'Excel.Application'. if sy-subrc = 0. get property of app 'UseSystemSeparators' = usesystemseparators. call function 'FLUSH'. if sy-subrc <> 0 or ( sy-subrc = 0 and usesystemseparators <> 0 ). perform get_system_decimal_separator using result. else. get property of app 'DecimalSeparator' = result. call function 'FLUSH'. endif. free object app. call function 'FLUSH'. endif. endform. "GET_EXCEL_DECIMAL_SEPARATOR *&---------------------------------------------------------------------* *& Form get_system_decimal_separator *&---------------------------------------------------------------------* form get_system_decimal_separator using result. data: hkey_current_user type i value 1. call function 'GUI_GET_REGVALUE' exporting root = hkey_current_user key = 'Control Panel' value_name = 'sDecimal' changing string = result exceptions registry_error = 1. endform. "GET_SYSTEM_DECIMAL_SEPARATOR

Пишем игры на C++

На заметку. Три урока по созданию игры на C++ с HabraHabr.
Урок1.
Урок2.
Урок3.

пятница, 11 октября 2013 г.

Читаем RSS ленты shortiki.com и bash.im


Развлечения ради представляю небольшой RSS клиент на VBA, которые читает и парсит ленты с сайтов Shortiki.com и bash.im
PS: Bash и Shortiki в коде - это листы в книге Excel
Читалка Shortiki.com
Dim ObjHTTP As MSXML2.XMLHTTP Dim sMsg As String Dim sURL As String Dim objXML As MSXML2.DOMDocument Dim xml As String Dim oNodeList As IXMLDOMSelection Dim curNode As IXMLDOMNode Dim oList As IXMLDOMSelection Dim stepNode As IXMLDOMNode Dim n As Long '*************** Запрашиваем RSS ***************' Set ObjHTTP = New MSXML2.XMLHTTP sURL = "http://shortiki.com/rss.php" 'use this code snippet to invoke a web service which requires authentication 'ObjHTTP.Open "Post", sURL, False, "username", "password" 'We use this code snippet to invoke a web service that doesn't require any user authentication ObjHTTP.Open "Post", sURL, False ObjHTTP.setRequestHeader "Content-Type", "text/xml" ObjHTTP.send xml = ObjHTTP.responseText '*************** Обрабатываем полученную XML ***************' ' Создаем VBA объект XML и загружаем в него XML Set objXML = New MSXML2.DOMDocument objXML.LoadXML (xml) ' Парсим XML Set oNodeList = objXML.SelectNodes("//channel/item") If oNodeList.Length - 1 > 0 Then Shortiki.UsedRange.Clear Shortiki.Cells(1, 1).Value = "Шортики (короткие и смешные)" Shortiki.Cells(1, 1).Interior.Color = RGB(255, 255, 0) End If For n = 0 To oNodeList.Length - 1 ' Получим текущий узел Set curNode = oNodeList.Item(n) Shortiki.Cells(n + 2, 1).Value = curNode.SelectNodes("description").Item(0).nodeTypedValue Debug.Print Shortiki.Cells(n + 2, 1).Value Debug.Print "-----------------------------" Next 'Shortiki.UsedRange.AutoFit ' Очистим переменные Set objXML = Nothing Set ObjHTTP = Nothing

Читалка Bash.im
Dim ObjHTTP As MSXML2.XMLHTTP Dim sMsg As String Dim sURL As String Dim objXML As MSXML2.DOMDocument Dim xml As String Dim oNodeList As IXMLDOMSelection Dim curNode As IXMLDOMNode Dim oList As IXMLDOMSelection Dim stepNode As IXMLDOMNode Dim n As Long Dim tbash As String '*************** Запрашиваем RSS ***************' Set ObjHTTP = New MSXML2.XMLHTTP sURL = "http://bash.im/rss/" 'use this code snippet to invoke a web service which requires authentication 'ObjHTTP.Open "Post", sURL, False, "username", "password" 'We use this code snippet to invoke a web service that doesn't require any user authentication ObjHTTP.Open "Get", sURL, False ObjHTTP.setRequestHeader "Content-Type", "text/xml" ObjHTTP.send xml = ObjHTTP.responseText '*************** Обрабатываем полученную XML ***************' ' Создаем VBA объект XML и загружаем в него XML Set objXML = New MSXML2.DOMDocument objXML.LoadXML (xml) ' Парсим XML Set oNodeList = objXML.SelectNodes("//channel/item") If oNodeList.Length - 1 > 0 Then Bash.UsedRange.Clear Bash.Cells(1, 1).Value = "Цитатник рунета" Bash.Cells(1, 1).Interior.Color = RGB(255, 255, 0) End If For n = 0 To oNodeList.Length - 1 ' Получим текущий узел Set curNode = oNodeList.Item(n) tbash = curNode.SelectNodes("description").Item(0).nodeTypedValue 'Debug.Print quote tbash = Replace(tbash, "
", Chr(13) & Chr(10)) tbash = Replace(tbash, """, """") Debug.Print tbash Debug.Print "-----------------------------" Bash.Cells(n + 2, 1) = tbash Next ' Очистим переменные Set objXML = Nothing Set ObjHTTP = Nothing

Курсы валют. Часть 1.

В первой части приведу пример отчета, который считывает курсы валют на дату с сервера ЦБ РФ, конвертирует трансформацией во внутреннюю таблицу и средствами BAPI актуализирует курсы валют в системе.

Код отчета
report ztest_forcurr. types: begin of t_fline, line(255) type c, end of t_fline . types: t_fline_tab type standard table of t_fline . types: begin of t_valute, numcode(20), charcode(20), nominal type vtb_dfans-cffact, name(150), value type vtb_dfans-value, end of t_valute . types: t_data type sorted table of t_valute with unique key numcode charcode. types: t_date_str(10) type c . start-of-selection. perform load_cbrf_rates_from_site using sy-datum. *&---------------------------------------------------------------------* *& Form LOAD_CBRF_RATES_FROM_SITE *&---------------------------------------------------------------------* form load_cbrf_rates_from_site using iv_date type bldat. data: lr_client type ref to if_http_client, lr_response type ref to if_http_response, l_response type string, l_url type string, lv_datetext(10) type c, lv_url_add(100) type c. data: lv_xml_string type string, lt_data type t_data, lv_date type t_date_str. *Подставление нужной даты (не обязательно) clear lv_datetext. if not iv_date is initial. write iv_date to lv_datetext dd/mm/yyyy. lv_datetext+2(1) = lv_datetext+5(1) = '/'. concatenate '?date_req=' lv_datetext into lv_url_add. endif. concatenate 'http://www.cbr.ru/scripts/XML_daily.asp' lv_url_add into l_url. call method cl_http_client=>create_by_url exporting url = l_url " 'http://www.cbr.ru/scripts/XML_daily.asp' importing client = lr_client exceptions internal_error = 1 argument_not_found = 2 plugin_not_active = 3 others = 4. if sy-subrc ne 0. " Ошибка обращения к серверу " message e002 raising create_url_err. endif. * Отправка запроса call method lr_client->send * exporting timeout = timeout exceptions http_communication_failure = 1 http_invalid_state = 2 http_processing_failed = 3 others = 4. if sy-subrc ne 0. " Ошибка запроса к серверу " message e003 raising send_error. endif. * Получение ответа сервера call method lr_client->receive exceptions http_communication_failure = 1 http_invalid_state = 2 http_processing_failed = 3 others = 4. if sy-subrc ne 0. " Ошибка получения ответа от сервера " message e004 raising receive_error. endif. lr_response = lr_client->response . l_response = lr_response->get_cdata( ). * Закрытие соединения call method lr_client->close exceptions http_invalid_state = 1 others = 2. check not l_response is initial . lv_xml_string = l_response. try. perform run_transformation using lv_xml_string changing lt_data lv_date. catch cx_root. * if sy-subrc ne 0. * "Ошибка преобразования XML * message e005 raising trans_error. * endif. endtry. perform check_rates changing lt_data. * perform create_exchrate using lt_data lv_date. endform. "load_cbrf_rates_from_site *&---------------------------------------------------------------------* *& Form run_transformation *&---------------------------------------------------------------------* form run_transformation using iv_xml type string changing et_data type t_data ev_date type t_date_str. data: oref type ref to cx_root, xslt_message type string. try . call transformation zm_cbrf_rates source xml iv_xml result valcurs = et_data[] gdate = ev_date . catch cx_xslt_exception into oref. xslt_message = oref->get_text( ). message xslt_message type 'E' raising trans_error. catch cx_st_match_element into oref. xslt_message = oref->get_text( ). message xslt_message type 'E' raising trans_error. catch cx_root into oref. xslt_message = oref->get_text( ). message xslt_message type 'E' raising trans_error. endtry. endform. "run_transformation *&---------------------------------------------------------------------* *& Form check_rates *&---------------------------------------------------------------------* form check_rates changing ct_data type t_data. data: begin of ls_waers, waers type waers_curc, end of ls_waers, lt_waers like standard table of ls_waers, ls_data like line of ct_data. select waers from tcurc into table lt_waers. loop at ct_data into ls_data. read table lt_waers with key waers = ls_data-charcode transporting no fields. if sy-subrc is not initial. delete table ct_data from ls_data. endif. endloop. endform. "check_rates *&---------------------------------------------------------------------* *& Form create_exchrate *&---------------------------------------------------------------------* form create_exchrate using it_data type t_data iv_date type t_date_str. data: ls_data like line of it_data, ls_rec type bapi1093_0, ls_rec2 type bapi1093_0, lt_rec type standard table of bapi1093_0, lt_return type standard table of bapiret2, ls_return like line of lt_return, lv_usd2_kurs type p length 9 decimals 4. loop at it_data into ls_data. replace all occurrences of ',' in ls_data-value with '.' . clear ls_rec. ls_rec-rate_type = 'M'. ls_rec-from_curr = ls_data-charcode. ls_rec-to_currncy = 'RUB'. ls_rec-valid_from = iv_date+6(4). ls_rec-valid_from+4(2) = iv_date+3(2). ls_rec-valid_from+6(2) = iv_date(2). ls_rec-exch_rate = ls_data-value. ls_rec-from_factor = ls_data-nominal. ls_rec-to_factor = '1'. if ls_data-charcode = 'USD'. "#EC NOTEXT move ls_rec to ls_rec2. ls_rec2-from_curr = 'USD2'. ls_rec2-exch_rate = ls_rec-exch_rate * '1.02'. lv_usd2_kurs = ls_rec2-exch_rate. ls_rec2-exch_rate = lv_usd2_kurs. append ls_rec2 to lt_rec. endif. append ls_rec to lt_rec. endloop. perform add_new_conversion tables lt_rec. call function 'BAPI_EXCHRATE_CREATEMULTIPLE' exporting upd_allow = 'X' * CHG_FIXED = ' ' * DEV_ALLOW = '000' tables exchrate_list = lt_rec return = lt_return . read table lt_return into ls_return with key type = 'E'. if sy-subrc = 0. message id ls_return-id type ls_return-type number ls_return-number with ls_return-message_v1 ls_return-message_v2 ls_return-message_v3 ls_return-message_v4. call function 'BAPI_TRANSACTION_ROLLBACK'. else. call function 'BAPI_TRANSACTION_COMMIT'. endif. endform. "create_exchrate *&---------------------------------------------------------------------* *& Form add_new_conversion *&---------------------------------------------------------------------* form add_new_conversion tables ct_rec structure bapi1093_0. data: ls_sap_data like line of ct_rec, lt_convers type standard table of tcurf, ls_curf type tcurf. data: lv_inv_date type gdatu_invv. loop at ct_rec into ls_sap_data. " get conversion customizing on date select * from tcurf up to 1 rows into ls_curf where kurst = ls_sap_data-rate_type and fcurr = ls_sap_data-from_curr and tcurr = ls_sap_data-to_currncy and gdatu ge lv_inv_date order by gdatu descending. exit. endselect. lv_inv_date = ls_sap_data-valid_from. translate lv_inv_date using '09182736455463728190'. if sy-subrc is not initial or ls_curf-ffact <> ls_sap_data-from_factor or ls_curf-tfact <> ls_sap_data-to_factor. clear ls_curf. ls_curf-kurst = ls_sap_data-rate_type. ls_curf-fcurr = ls_sap_data-from_curr. ls_curf-tcurr = ls_sap_data-to_currncy. ls_curf-gdatu = lv_inv_date. ls_curf-ffact = ls_sap_data-from_factor. ls_curf-tfact = ls_sap_data-to_factor. insert tcurf from ls_curf. if sy-subrc is not initial. modify tcurf from ls_curf. endif. endif. endloop. endform. "add_new_conversion

Код трансформации


четверг, 10 октября 2013 г.

Работы с файлами и директориями


За изучением чужого кода наткнулся на полезный Include для работы с файлами и директориями. Имя ему - FP_UTILITIES. Для тех, у кого нет под рукой системы, чтобы ознакомиться с его содержимым, выкладываю ниже код

INCLUDE FP_UTILITIES.
*&---------------------------------------------------------------------* *& Include FP_UTILITIES *&---------------------------------------------------------------------* *&---------------------------------------------------------------------* *& Form value_help_for_destination *&---------------------------------------------------------------------* * Get an RFC destination from a dialog box to select from. *----------------------------------------------------------------------* * <--P_DEST destination *----------------------------------------------------------------------* FORM value_help_for_destination USING p_fieldname TYPE dynfnam. "#EC CALLED TYPES: BEGIN OF ty_disp, rfcdest TYPE rfcdest, ssl TYPE rfcsnc, hostname TYPE icmhostnam, port TYPE rfcsysid, END OF ty_disp. DATA: lt_dest TYPE STANDARD TABLE OF rfcdes WITH KEY rfcdest, l_rfcdes TYPE rfcdes, l_display TYPE rfcdisplay, l_disp TYPE ty_disp. STATICS l_dests TYPE STANDARD TABLE OF ty_disp WITH KEY rfcdest. * Read all suitable RFC destinations from the database. IF l_dests IS INITIAL. SELECT rfcdest rfctype rfcoptions FROM rfcdes INTO TABLE lt_dest WHERE rfctype = 'G' AND rfcoptions LIKE '%AdobeDocument%' ORDER BY PRIMARY KEY. "#EC CI_GENBUFF LOOP AT lt_dest INTO l_rfcdes. CALL FUNCTION 'RFCDES2RFCDISPLAY' EXPORTING import_rfcdes = l_rfcdes IMPORTING export_rfcdisplay = l_display. MOVE: l_display-rfcdest TO l_disp-rfcdest, l_display-rfcsnc TO l_disp-ssl, l_display-rfchost TO l_disp-hostname, l_display-rfcsysid TO l_disp-port. INSERT l_disp INTO TABLE l_dests. ENDLOOP. ENDIF. * Show the value-help popup. CALL FUNCTION 'F4IF_INT_TABLE_VALUE_REQUEST' EXPORTING retfield = 'RFCDEST' dynpprog = sy-cprog dynpnr = sy-dynnr dynprofield = p_fieldname value_org = 'S' TABLES value_tab = l_dests. ENDFORM. "value_help_for_destination *&---------------------------------------------------------------------* *& Form value_help_for_file *&---------------------------------------------------------------------* * Get a local file name from a dialog box to select from. *----------------------------------------------------------------------* * -->P_EXTENSION extension * <--P_FILENAME selected file name *----------------------------------------------------------------------* FORM value_help_for_file USING p_extension TYPE string CHANGING p_filename TYPE localfile. "#EC CALLED DATA: l_filetable TYPE filetable, l_status TYPE i. CALL METHOD cl_gui_frontend_services=>file_open_dialog EXPORTING default_extension = p_extension file_filter = cl_gui_frontend_services=>filetype_all CHANGING file_table = l_filetable rc = l_status EXCEPTIONS file_open_dialog_failed = 1 cntl_error = 2 error_no_gui = 3 not_supported_by_gui = 4 OTHERS = 5. IF sy-subrc IS INITIAL AND l_status > 0. READ TABLE l_filetable INTO p_filename INDEX 1. ENDIF. ENDFORM. "value_help_for_file *&---------------------------------------------------------------------* *& Form value_help_for_output_file *&---------------------------------------------------------------------* * Get a local file name where to save data * from a dialog box to select from. *----------------------------------------------------------------------* * -->P_EXTENSION extension * <--P_FILENAME selected file name *----------------------------------------------------------------------* FORM value_help_for_output_file USING p_extension TYPE string CHANGING p_filename TYPE localfile. "#EC CALLED DATA: l_filename TYPE string, l_filename_dummy TYPE string. CALL METHOD cl_gui_frontend_services=>file_save_dialog EXPORTING default_extension = p_extension file_filter = cl_gui_frontend_services=>filetype_all CHANGING filename = l_filename_dummy path = l_filename_dummy fullpath = l_filename EXCEPTIONS cntl_error = 1 error_no_gui = 2 not_supported_by_gui = 3 OTHERS = 4. IF sy-subrc IS INITIAL. MOVE l_filename TO p_filename. ENDIF. ENDFORM. "value_help_for_output_file *&--------------------------------------------------------------------* *& Form load_file *&--------------------------------------------------------------------* * Load a file from the frontend. *---------------------------------------------------------------------* * -->P_FILENAME file name * <--P_CONTENT content of the file *---------------------------------------------------------------------* FORM load_file USING p_filename TYPE localfile CHANGING p_content TYPE xstring. "#EC CALLED DATA: l_filename TYPE string, l_rawtab TYPE STANDARD TABLE OF raw255, l_len TYPE i. MOVE p_filename TO l_filename. CALL METHOD cl_gui_frontend_services=>gui_upload EXPORTING filename = l_filename filetype = 'BIN' IMPORTING filelength = l_len CHANGING data_tab = l_rawtab 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 not_supported_by_gui = 17 error_no_gui = 18 OTHERS = 19. IF sy-subrc IS NOT INITIAL. MESSAGE ID sy-msgid TYPE sy-msgty NUMBER sy-msgno WITH sy-msgv1 sy-msgv2 sy-msgv3 sy-msgv4. ENDIF. CALL FUNCTION 'SCMS_BINARY_TO_XSTRING' EXPORTING input_length = l_len IMPORTING buffer = p_content TABLES binary_tab = l_rawtab EXCEPTIONS failed = 1 OTHERS = 2. IF sy-subrc IS NOT INITIAL. MESSAGE ID sy-msgid TYPE sy-msgty NUMBER sy-msgno WITH sy-msgv1 sy-msgv2 sy-msgv3 sy-msgv4. ENDIF. ENDFORM. "load_file *&---------------------------------------------------------------------* *& Form download_file *&---------------------------------------------------------------------* * Download a file to the frontend. *----------------------------------------------------------------------* * -->P_DATA content to be downloaded * -->P_FILE file name *----------------------------------------------------------------------* FORM download_file USING p_data TYPE xstring p_file TYPE localfile. "#EC CALLED DATA: l_len TYPE i, l_tab TYPE tsfixml, l_filename TYPE string. CALL FUNCTION 'SCMS_XSTRING_TO_BINARY' EXPORTING buffer = p_data IMPORTING output_length = l_len TABLES binary_tab = l_tab. MOVE p_file TO l_filename. CALL METHOD cl_gui_frontend_services=>gui_download EXPORTING bin_filesize = l_len filename = l_filename filetype = 'BIN' CHANGING data_tab = l_tab EXCEPTIONS OTHERS = 1. IF sy-subrc IS INITIAL. MESSAGE ID 'VER_MESSAGES' TYPE 'S' NUMBER '082' WITH p_file. ELSE. MESSAGE ID 'VER_MESSAGES' TYPE 'E' NUMBER '083'. ENDIF. ENDFORM. "download_file *&---------------------------------------------------------------------* *& Form error *&---------------------------------------------------------------------* * Show the error message. *----------------------------------------------------------------------* * -->P_EXCEPTION exception-class instance *----------------------------------------------------------------------* FORM error USING p_exception TYPE REF TO cx_fp_runtime. "#EC CALLED DATA: l_type TYPE string, l_errmsg TYPE string. CASE cl_abap_classdescr=>get_class_name( p_exception ). WHEN '\CLASS=CX_FP_RUNTIME_INTERNAL'. l_type = 'INTERNAL ERROR'. WHEN '\CLASS=CX_FP_RUNTIME_SYSTEM'. l_type = 'SYSTEM ERROR'. WHEN '\CLASS=CX_FP_RUNTIME_USAGE'. l_type = 'USAGE ERROR'. ENDCASE. l_errmsg = p_exception->get_short( ). CONCATENATE l_type ':' l_errmsg INTO l_errmsg SEPARATED BY space. MESSAGE l_errmsg TYPE 'E'. ENDFORM. "error