*&---------------------------------------------------------------------*
*& Report Z_HTTP_STOCK
*&
*&---------------------------------------------------------------------*
*&Author: Alan Gu
*&本程序只作个人测试用途，
*&如用于其他目的，涉及新浪webservice服务版权，请跟新浪联系。
*&五秒钟更新一次
*&双击股票代码可以查看相关的K线图
*&---------------------------------------------------------------------*

REPORT Z_HTTP_STOCK.
TYPE-POOLS: abap,slis.
data:f_picture type ref to cl_gui_picture,
r_picture type ref to cl_gui_picture,
z_picture type ref to cl_gui_picture,
y_picture type ref to cl_gui_picture.

data: f_container type ref to cl_gui_custom_container,
r_container type ref to cl_gui_custom_container,
y_container type ref to cl_gui_custom_container,
z_container type ref to cl_gui_custom_container.
data:f_url type cndp_url,
r_url type cndp_url,
z_url type cndp_url,
y_url type cndp_url.

data:stock_url(20) TYPE c.
data:OK_CODE like sy-ucomm.

DATA :
ls_layout TYPE slis_layout_alv,
lt_sort TYPE slis_t_sortinfo_alv,
ls_sort TYPE slis_sortinfo_alv,
lt_event_exit TYPE slis_t_event_exit,
ls_event_exit TYPE slis_event_exit.
*-----------------------*
* ALV SYSTEM VARIABLES *
*-----------------------*
DATA: fieldtab TYPE slis_t_fieldcat_alv,
wa_fieldtab TYPE LINE OF slis_t_fieldcat_alv,
heading TYPE slis_t_listheader,
layout TYPE slis_layout_alv,
events TYPE slis_t_event,
excluding TYPE slis_t_extab,
filter TYPE slis_t_filter_alv,
repname LIKE sy-repid VALUE sy-repid,
f2code LIKE sy-ucomm VALUE '&ETA',
g_save TYPE c,
g_exit TYPE c,
g_variant LIKE disvariant,
gx_variant LIKE disvariant.

FIELD-SYMBOLS: TYPE STANDARD TABLE,
,
.
DATA: dy_table TYPE REF TO data,
dy_line TYPE REF TO data,
xfc TYPE lvc_s_fcat,
ifc TYPE lvc_t_fcat.
DATA: num(6) TYPE c.
DATA: BEGIN OF wa_num,
num(6) TYPE c,
END OF wa_num.
DATA: BEGIN OF wa_lin,
str(1000) TYPE c,
END OF wa_lin.
DATA: it_num LIKE TABLE OF wa_num WITH HEADER LINE,
it_res LIKE TABLE OF wa_lin WITH HEADER LINE.
DATA: tmp_num(6) TYPE n,
idx TYPE i,
idx_tmp TYPE i.
TYPES: BEGIN OF ty_list,
fl(30),
END OF ty_list.
DATA: it_list TYPE TABLE OF ty_list WITH HEADER LINE.

*----------------------------------------------------------------------*
* CLASS lcl_receiver DEFINITION
*----------------------------------------------------------------------*
*
*----------------------------------------------------------------------*
class lcl_receiver definition.
public section.
methods:
handle_finished for event finished of cl_gui_timer.
endclass. "lcl_receiver DEFINITION

*----------------------------------------------------------------------*
* CLASS lcl_receiver IMPLEMENTATION
*----------------------------------------------------------------------*
*
*----------------------------------------------------------------------*
class lcl_receiver implementation.
method handle_finished.
CALL METHOD cl_gui_cfw=>set_new_ok_code
EXPORTING
new_code = '&NTE'.
endmethod. "handle_finished
endclass. "lcl_receiver IMPLEMENTATION

DATA: receiver type ref to lcl_receiver,
timer type ref to cl_gui_timer.

DEFINE init_field.
clear &1.
&1-fieldname = &2.
&1-reptext_ddic = &3.
&1-HOTSPOT = &4.
if &5 = 'X'.
&1-emphasize = 'X'.
endif.
append &1 to fieldtab.
END-OF-DEFINITION.

DEFINE init_ifc.
clear xfc.
xfc-fieldname = &1.
xfc-datatype = &2.
xfc-inttype = &3.
xfc-intlen = &4.
xfc-decimals = &5.
xfc-HOTSPOT = &6.
append xfc to ifc.
END-OF-DEFINITION.

SELECT-OPTIONS:
s_num FOR num.

INITIALIZATION.
*默认自己设的变式U+登录用户名
PERFORM init_variant.

START-OF-SELECTION .
create object timer.
create object receiver.
set handler receiver->handle_finished for timer.
timer->interval = 5.
PERFORM set_number.
PERFORM READ_DATA.
PERFORM write_grid_output.

*&---------------------------------------------------------------------*
*& Form READ_DATA
*&---------------------------------------------------------------------*
* text
*----------------------------------------------------------------------*
FORM READ_DATA.
PERFORM send_http TABLES it_num it_res.
PERFORM build_fieldcat.
PERFORM process_data.
call method timer->run.
ENDFORM. "READ_DATA
*&---------------------------------------------------------------------*
*& Form send_http
*&---------------------------------------------------------------------*
* text
*----------------------------------------------------------------------*
* -->PT_NUM text
* -->RT_TAB text
*----------------------------------------------------------------------*
FORM send_http TABLES pt_num STRUCTURE wa_num rt_tab STRUCTURE wa_lin.
DATA: loc_conv TYPE REF TO cl_abap_conv_in_ce,
http_client TYPE REF TO if_http_client ,
abap_encoding TYPE abap_encoding,
l_xstr TYPE xstring,
l_str TYPE string,
l_tmp TYPE string,
l_url TYPE string,
l_result TYPE string,
r_str TYPE string .
DATA: result_tab TYPE TABLE OF string.
IF pt_num[] IS INITIAL.
RETURN.
ENDIF.
CLEAR:it_res.
REFRESH:it_res.
LOOP AT pt_num.
CLEAR l_tmp.
IF pt_num-num(1) < 6.
CONCATENATE 'sz' pt_num-num INTO l_tmp.
ENDIF.
IF pt_num-num(1) = '6'.
CONCATENATE 'sh' pt_num-num INTO l_tmp.
ENDIF.
CONCATENATE l_str l_tmp INTO l_str SEPARATED BY ','.
ENDLOOP.

CONCATENATE 'http://hq.sinajs.cn/list=' l_str INTO l_url .
CALL METHOD cl_http_client=>create_by_url
EXPORTING
url = l_url
IMPORTING
client = http_client
EXCEPTIONS
argument_not_found = 1
plugin_not_active = 2
internal_error = 3
OTHERS = 4.
CALL METHOD http_client->send
EXCEPTIONS
http_communication_failure = 1
http_invalid_state = 2.
CALL METHOD http_client->receive
EXCEPTIONS
http_communication_failure = 1
http_invalid_state = 2
http_processing_failed = 3.
CLEAR l_result .

l_xstr = http_client->response->get_data( ).
CALL METHOD cl_abap_conv_in_ce=>create
EXPORTING
input = l_xstr
encoding = '8400'
replacement = '?'
ignore_cerr = abap_true
RECEIVING
conv = loc_conv.

TRY.
CALL METHOD loc_conv->read
IMPORTING
data = l_str.
CATCH cx_sy_conversion_codepage.
CATCH cx_sy_codepage_converter_init.
CATCH cx_parameter_invalid_type.
CATCH cx_parameter_invalid_range.
ENDTRY.
SPLIT l_str AT 'var' INTO TABLE rt_tab .
ENDFORM. "send_http

*&---------------------------------------------------------------------*
*& Form build_fieldcat
*&---------------------------------------------------------------------*
* text
*----------------------------------------------------------------------*
FORM build_fieldcat.

IF IFC IS INITIAL.
init_ifc 'STNUM' 'CHAR' 'C' 6 0 'X'.
init_ifc 'STNAM' 'CHAR' 'C' 20 0 ' '.
init_ifc 'OPPRI' 'CHAR' 'C' 20 0 ' '. " openning price
init_ifc 'CLPRI' 'CHAR' 'C' 20 0 ' '. " closing price of last day
init_ifc 'CRPRI' 'CHAR' 'C' 20 0 ' '. " current price
init_ifc 'HIPRI' 'CHAR' 'C' 20 0 ' '. " high price
init_ifc 'LOPRI' 'CHAR' 'C' 20 0 ' '. " low price
init_ifc 'BYPRI' 'CHAR' 'C' 20 0 ' '. " buying price 1
init_ifc 'SLPRI' 'CHAR' 'C' 20 0 ' '. " selling price 1
init_ifc 'DUQTY' 'CHAR' 'C' 30 0 ' '. " due quantity
init_ifc 'DUAMT' 'CHAR' 'C' 30 0 ' '. " due amount
*颜色控制
clear xfc.
xfc-fieldname = 'T_CELLCOLORS'.
xfc-ref_field = 'COLTAB'.
xfc-ref_table = 'CALENDAR_TYPE'.
append xfc to ifc.
*
***ALV field category
init_field wa_fieldtab 'STNUM' '代码' 'X' '' .
init_field wa_fieldtab 'STNAM' '名称' '' '' .
init_field wa_fieldtab 'OPPRI' '开盘价' '' '' .
init_field wa_fieldtab 'CLPRI' '昨日收盘价' '' '' .
init_field wa_fieldtab 'CRPRI' '现价' '' '' .
init_field wa_fieldtab 'HIPRI' '最高价' '' '' .
init_field wa_fieldtab 'LOPRI' '最低价' '' '' .
init_field wa_fieldtab 'BYPRI' '买一价' '' '' .
init_field wa_fieldtab 'SLPRI' '卖一价' '' '' .
init_field wa_fieldtab 'DUQTY' '成交数' '' '' .
init_field wa_fieldtab 'DUAMT' '成交金额' '' '' .

* Create dynamic internal table and assign to FS

CALL METHOD cl_alv_table_create=>create_dynamic_table
EXPORTING
it_fieldcatalog = ifc
IMPORTING
ep_table = dy_table.
ASSIGN dy_table->* TO .
* Create dynamic work area and assign to FS
CREATE DATA dy_line LIKE LINE OF .
ASSIGN dy_line->* TO .
ELSE.
clear .
refresh: .
ENDIF.

ENDFORM. " BUILD_FIELDCAT


*&---------------------------------------------------------------------*
*& Form write_grid_output
*&---------------------------------------------------------------------*
* text
*----------------------------------------------------------------------*
FORM write_grid_output.
DEFINE m_sort.
add 1 to ls_sort-spos.
ls_sort-fieldname = &1.
append ls_sort to lt_sort.
END-OF-DEFINITION.

DEFINE m_event_exit.
clear ls_event_exit.
ls_event_exit-ucomm = &1.
ls_event_exit-after = 'X'.
append ls_event_exit to lt_event_exit.
END-OF-DEFINITION.

m_event_exit '&NTE'. " Refresh
ls_layout-zebra = 'X'.
ls_layout-colwidth_optimize = 'X'.

M_SORT 'STNUM'.
g_save = 'A'.
ls_layout-coltab_fieldname = 'T_CELLCOLORS'.
CALL FUNCTION 'REUSE_ALV_GRID_DISPLAY'
EXPORTING
i_callback_program = sy-cprog
I_CALLBACK_USER_COMMAND = 'USER_COMMAND'
is_layout = ls_layout
it_fieldcat = fieldtab
i_default = 'A'
i_save = g_save
it_sort = lt_sort
it_event_exit = lt_event_exit
TABLES
t_outtab = .
IF sy-subrc <> 0.
WRITE: 'SY-SUBRC: ', sy-subrc, 'REUSE_ALV_GRID_DISPLAY'.
ENDIF.
ENDFORM. " WRITE_GRID_OUTPUT

*&---------------------------------------------------------------------*
*& Form process_data
*&---------------------------------------------------------------------*
* text
*----------------------------------------------------------------------*
FORM process_data .
FIELD-SYMBOLS: TYPE lvc_t_scol.
data:wa_cellcolors TYPE LINE OF lvc_t_scol.
DATA:XJ TYPE P DECIMALS 2,
ZJ TYPE P DECIMALS 2.

LOOP AT it_res.
CLEAR it_list[].
IF STRLEN( it_res-str ) < 30.
CONTINUE.
ENDIF.

CLEAR:XJ,ZJ.
SPLIT it_res-str AT ',' INTO TABLE it_list .
READ TABLE it_list INDEX 1.
idx = 1.
ASSIGN COMPONENT idx
OF STRUCTURE TO .
= it_list-fl+10(6).
idx = 2.
ASSIGN COMPONENT idx
OF STRUCTURE TO .
= it_list-fl+18.

idx = 2.
WHILE idx < 11.
READ TABLE it_list INDEX idx.
idx = idx + 1.
ASSIGN COMPONENT idx
OF STRUCTURE TO .
= it_list-fl.

IF IDX = 4.
ZJ = .
ENDIF.

IF IDX = 5.
XJ = .
ENDIF.
ENDWHILE.

ASSIGN COMPONENT 'T_CELLCOLORS'
OF STRUCTURE TO .

clear:wa_cellcolors.
IF ZJ >= XJ.
wa_cellcolors-color-col = '5'. "跌
ELSE.
wa_cellcolors-color-col = '6'. "涨
ENDIF.

APPEND wa_cellcolors TO .

APPEND TO .
CLEAR .
ENDLOOP.
ENDFORM. " process_data

*&---------------------------------------------------------------------*
*& Form set_number
*&---------------------------------------------------------------------*
* text
*----------------------------------------------------------------------*
FORM set_number .
LOOP AT s_num.
CLEAR it_num.
IF s_num-option = 'EQ' .
IF s_num-low <> '' .
it_num-num = s_num-low.
APPEND it_num.
ENDIF.
IF s_num-high <> '' .
it_num-num = s_num-high.
APPEND it_num.
ENDIF.
ENDIF.
IF s_num-option = 'BT'.
tmp_num = s_num-low.
WHILE tmp_num <= s_num-high.
CLEAR it_num.
it_num-num = tmp_num.
APPEND it_num.
tmp_num = tmp_num + 1.
ENDWHILE.
ENDIF.
ENDLOOP.
ENDFORM. " set_number
*&---------------------------------------------------------------------*
*& Module STATUS_0100 OUTPUT
*&---------------------------------------------------------------------*
* text
*----------------------------------------------------------------------*
MODULE STATUS_0100 OUTPUT.
set PF-STATUS 'STATUS'.
*分时图
if f_picture is INITIAL.
create object f_container
EXPORTING
container_name = 'F_CONTROL'.

CREATE OBJECT f_picture
EXPORTING
parent = f_container.

CALL METHOD f_picture->SET_3D_BORDER
EXPORTING
border = 1.

CALL METHOD f_picture->LOAD_PICTURE_FROM_URL_ASYNC
EXPORTING
url = f_url.
else.
CALL METHOD f_picture->LOAD_PICTURE_FROM_URL_ASYNC
EXPORTING
url = f_url.
endif.
*日K线图
if r_picture is INITIAL.
create object r_container
EXPORTING
container_name = 'R_CONTROL'.

CREATE OBJECT r_picture
EXPORTING
parent = r_container.

CALL METHOD r_picture->SET_3D_BORDER
EXPORTING
border = 1.

CALL METHOD r_picture->LOAD_PICTURE_FROM_URL_ASYNC
EXPORTING
url = r_url.
else.
CALL METHOD r_picture->LOAD_PICTURE_FROM_URL_ASYNC
EXPORTING
url = r_url.
endif.

*周K线图
if z_picture is INITIAL.
create object z_container
EXPORTING
container_name = 'Z_CONTROL'.

CREATE OBJECT z_picture
EXPORTING
parent = z_container.

CALL METHOD z_picture->SET_3D_BORDER
EXPORTING
border = 1.

CALL METHOD z_picture->LOAD_PICTURE_FROM_URL_ASYNC
EXPORTING
url = z_url.
else.
CALL METHOD z_picture->LOAD_PICTURE_FROM_URL_ASYNC
EXPORTING
url = z_url.
endif.

*月K线图
if y_picture is INITIAL.
create object y_container
EXPORTING
container_name = 'Y_CONTROL'.

CREATE OBJECT y_picture
EXPORTING
parent = y_container.

CALL METHOD y_picture->SET_3D_BORDER
EXPORTING
border = 1.

CALL METHOD y_picture->LOAD_PICTURE_FROM_URL_ASYNC
EXPORTING
url = y_url.
else.
CALL METHOD y_picture->LOAD_PICTURE_FROM_URL_ASYNC
EXPORTING
url = y_url.
endif.
ENDMODULE. " STATUS_0100 OUTPUT

*&---------------------------------------------------------------------*
*& Form F_USER_COMMAND
*&---------------------------------------------------------------------*
* text
*----------------------------------------------------------------------*
* -->R_UCOMM text
* -->RS_SELFIELD text
*----------------------------------------------------------------------*
FORM USER_COMMAND USING r_ucomm LIKE sy-ucomm
rs_selfield TYPE slis_selfield.

CASE R_UCOMM.
WHEN '&IC1'.
clear: f_url,z_url,r_url,y_url.
f_url = 'http://image.sinajs.cn/newchart/min/n/'.
z_url = 'http://image.sinajs.cn/newchart/weekly/n/'.
r_url = 'http://image.sinajs.cn/newchart/daily/n/'.
y_url = 'http://image.sinajs.cn/newchart/monthly/n/'.

CHECK rs_selfield-fieldname cs 'STNUM'.
if rs_selfield-value+0(1) = 0.
CONCATENATE 'sz' rs_selfield-value '.gif' INTO stock_url.
else.
CONCATENATE 'sh' rs_selfield-value '.gif' INTO stock_url.
endif.

CHECK stock_url is NOT INITIAL.
CONCATENATE f_url stock_url INTO f_url.
CONCATENATE z_url stock_url INTO z_url.
CONCATENATE y_url stock_url INTO y_url.
CONCATENATE r_url stock_url INTO r_url.
call SCREEN 0100.
WHEN '&NTE'.
PERFORM read_data.
rs_selfield-refresh = 'X'.
call method timer->run.
ENDCASE.

ENDFORM. "F_USER_COMMAND
*&---------------------------------------------------------------------*
*& Module USER_COMMAND_EXIT INPUT
*&---------------------------------------------------------------------*
* text
*----------------------------------------------------------------------*
MODULE USER_COMMAND_EXIT INPUT.
CASE OK_CODE.
WHEN 'EXIT' OR 'BACK' OR 'CANC'.
LEAVE TO SCREEN 0.
ENDCASE.
ENDMODULE. " USER_COMMAND_EXIT INPUT
*&---------------------------------------------------------------------*
*& Module USER_COMMAND_0100 INPUT
*&---------------------------------------------------------------------*
* text
*----------------------------------------------------------------------*
MODULE USER_COMMAND_0100 INPUT.
CASE OK_CODE.

WHEN 'REF'.

ENDCASE.
ENDMODULE. " USER_COMMAND_0100 INPUT
*&---------------------------------------------------------------------*
*& Form INIT_VARIANT
*&---------------------------------------------------------------------*
* text
*----------------------------------------------------------------------*
* --> p1 text
* <-- p2 text
*----------------------------------------------------------------------*
FORM INIT_VARIANT .
DATA: h_variant LIKE rsvar-variant.
DATA: h_subrc LIKE sy-subrc.
CLEAR: h_variant,h_subrc .

CHECK sy-tcode <> 'SE38' and sy-tcode <> 'SA38' .
h_variant = 'U_'.
WRITE sy-uname TO h_variant+2.

CALL FUNCTION 'RS_VARIANT_EXISTS'
EXPORTING
report = sy-repid
variant = h_variant
IMPORTING
r_c = h_subrc.

IF h_subrc = 0.
* g_feldlist-g_var_flag = 'X'.
CALL FUNCTION 'RS_SUPPORT_SELECTIONS'
EXPORTING
report = sy-repid
variant = h_variant
EXCEPTIONS
variant_not_existent = 01
variant_obsolete = 02.
ENDIF.

ENDFORM. " INIT_VARIANT

[@more@]