пятница, 25 октября 2013 г.
пятница, 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
пятница, 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
", 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
Подписаться на:
Сообщения (Atom)

.jpg)

