*&---------------------------------------------------------------------*
*& Report ZZINFOTYPES
*&
*&---------------------------------------------------------------------*
*& Join up various HR infotypes so you can see in one line the
*& relationship between the various tables
*& Mark Langenhoven
*& 2022/10/19
*&---------------------------------------------------------------------*
report zzinfotypes.
*--- Data declarations ----------------------------------------------
tables: pa0000.
data: lv_infotype(4) type n,
lv_infoname(30) type c,
lv_fieldname(30) type c,
overlapped type boole_d.
data: begin of fieldrec,
infotype like lv_infotype,
fieldname like dd03l-fieldname,
end of fieldrec,
begin of selrec,
infotype like lv_infotype,
whereclause type rsds_twhere,
end of selrec,
begin of looprec,
loop(2) type n,
infotype like lv_infotype,
end of looprec,
lt_loop like standard table of looprec,
ls_loop like looprec,
lt_disp like standard table of fieldrec,
ls_disp like fieldrec,
lt_sel like standard table of selrec,
ls_sel like selrec.
data: lt_cat type lvc_t_fcat,
lt_maincat type lvc_t_fcat,
ls_cat type line of lvc_t_fcat,
lt_dyntab type ref to data,
ls_dynwa type ref to data,
ls_dynwa2 type ref to data,
added type boole_d,
lv_loop(2) type n,
lv_maxloop(2) type n,
lv_tabix type i,
lt_split type string occurs 0 with header line,
lv_left type string,
lv_operand type string,
lv_right type string,
lv_and type string,
lv_pos type i,
lv_next type i,
lv_low type i,
lv_high type i,
dodel type boole_d,
lv_cnt type i.
data: ls_where type rsds_where,
lt_wheretab type rsds_where_tab,
ls_wheretab type rsdswhere,
lv_where type string.
data: begin of infotyperec,
fieldname like rp50g-choic, "Have to use a fieldname otherwise F4 doesn't work "lv_infotype,
desc like dd02t-ddtext,
end of infotyperec,
lt_infotypes like standard table of infotyperec,
ls_infotype like infotyperec,
lt_return like ddshretval occurs 0 with header line.
ranges: r_pernr for pa0000-pernr.
field-symbols: type table,
type table,
type table,
type table,
type table,
type table,
type table,
type table,
type table,
type table,
type table,
type table,
type table,
type table,
type table,
type table,
type table,
type table,
type table,
type table,
type table,
type table,
type any,
type any,
type any,
type any,
type any,
type any,
type any,
type any,
type any,
type any,
type any.
*--- Selection screen -----------------------------------------------
select-options: s_info for lv_infotype,
s_pernr for pa0000-pernr no-display.
selection-screen skip.
selection-screen begin of line.
selection-screen: pushbutton 1(18) p_disp user-command dis.
parameters: p_disc type i.
selection-screen end of line.
selection-screen begin of line.
selection-screen: pushbutton 1(18) p_sel user-command sel.
parameters: p_selc type i.
selection-screen end of line.
selection-screen skip.
parameters: p_curr as checkbox default 'X', "Only pull current records
p_hide as checkbox default 'X'. "Only show the first PERNR field
initialization.
p_disp = 'Fields'.
p_sel = 'Selections'.
lv_maxloop = 20.
p_disc = 0.
p_selc = 0.
at selection-screen.
if sy-ucomm = 'DIS'.
perform get_disp_fields.
endif.
if sy-ucomm = 'SEL'.
perform get_sel_fields.
endif.
at selection-screen output.
describe table lt_disp lines p_disc.
clear p_selc.
loop at lt_sel transporting no fields where whereclause is not initial.
p_selc = p_selc + 1.
endloop.
loop at screen.
if screen-name = 'P_DISC' or
screen-name = 'P_SELC'.
screen-input = 0.
modify screen.
endif.
endloop.
at selection-screen on value-request for s_info-low.
perform get_infotypes tables lt_infotypes.
call function 'F4IF_INT_TABLE_VALUE_REQUEST'
exporting
retfield = 'FIELDNAME'
value_org = 'S'
tables
value_tab = lt_infotypes
return_tab = lt_return
exceptions
parameter_error = 1
no_values_found = 2
others = 3.
if sy-subrc <> 0.
* Implement suitable error handling here
endif.
loop at lt_return.
s_info-low = lt_return-fieldval.
s_info-sign = 'I'.
s_info-option = 'EQ'.
append s_info.
endloop.
sort s_info.
delete adjacent duplicates from s_info.
at selection-screen on value-request for s_info-high.
perform get_infotypes tables lt_infotypes.
call function 'F4IF_INT_TABLE_VALUE_REQUEST'
exporting
retfield = 'FIELDNAME'
value_org = 'S'
tables
value_tab = lt_infotypes
return_tab = lt_return
exceptions
parameter_error = 1
no_values_found = 2
others = 3.
if sy-subrc <> 0.
* Implement suitable error handling here
endif.
loop at lt_return.
loop at s_info.
s_info-high = lt_return-fieldval.
s_info-sign = 'I'.
s_info-option = 'BT'.
modify s_info.
endloop.
if sy-subrc <> 0.
s_info-high = lt_return-fieldval.
s_info-sign = 'I'.
s_info-option = 'BT'.
append s_info.
endif.
endloop.
sort s_info.
delete adjacent duplicates from s_info.
*--- Helper macros --------------------------------------------------
"Create a field symbol table and select the right data into it
define tablesel.
assign lt_dyntab->* to .
lv_low = 1.
lv_high = 1000.
DESCRIBE TABLE s_pernr LINES lv_next.
do.
refresh r_pernr.
append lines of s_pernr from lv_low to lv_high to r_pernr.
if sy-subrc <> 0 or lv_low > lv_next.
exit.
endif.
lv_low = lv_low + 1000.
lv_high = lv_high + 1000.
if lv_where is initial.
if p_curr is INITIAL.
select * from (lv_infoname) APPENDING CORRESPONDING FIELDS OF table
where pernr in r_pernr
order by pernr begda endda.
else.
select * from (lv_infoname) APPENDING CORRESPONDING FIELDS OF table
where pernr in r_pernr
and begda <= sy-datum
and endda >= sy-datum
order by pernr begda endda.
endif.
else.
if p_curr is INITIAL.
select * from (lv_infoname) APPENDING CORRESPONDING FIELDS OF table
where (lv_where)
and pernr in r_pernr
order by pernr begda endda.
else.
select * from (lv_infoname) APPENDING CORRESPONDING FIELDS OF table
where (lv_where)
and pernr in r_pernr
and begda <= sy-datum
and endda >= sy-datum
order by pernr begda endda.
endif.
endif.
enddo.
end-of-definition.
"Move a value from to
define fieldmove.
"Add a loop modifier to the name to avoid name collisions
CONCATENATE &1 &2 into lv_fieldname.
ASSIGN COMPONENT lv_fieldname OF STRUCTURE to .
lv_fieldname = &1.
ASSIGN COMPONENT lv_fieldname of STRUCTURE to .
= .
end-of-definition.
"Get the key fields from the main table
define getfields.
CONCATENATE 'PERNR' '01' into lv_fieldname.
ASSIGN COMPONENT lv_fieldname of STRUCTURE to .
CONCATENATE 'BEGDA' '01' into lv_fieldname.
ASSIGN COMPONENT lv_fieldname of STRUCTURE to .
CONCATENATE 'ENDDA' '01' into lv_fieldname.
ASSIGN COMPONENT lv_fieldname of STRUCTURE to .
end-of-definition.
"Get the key fields from the selection table
define getfields2.
lv_fieldname = 'PERNR'.
ASSIGN COMPONENT lv_fieldname of STRUCTURE to .
lv_fieldname = 'BEGDA'.
ASSIGN COMPONENT lv_fieldname of STRUCTURE to .
lv_fieldname = 'ENDDA'.
ASSIGN COMPONENT lv_fieldname of STRUCTURE to .
end-of-definition.
"Build up the main table from each successive table
define buildmain.
read table lt_loop into ls_loop with key loop = &1.
if is assigned.
create data ls_dynwa2 like line of .
assign ls_dynwa2 to .
added = abap_false.
loop at assigning .
getfields2.
loop at assigning .
"Make sure we're dealing with the correct PERNR
getfields.
check = .
"Make sure we're in the right timeframe
perform check_overlap changing overlapped.
check overlapped = abap_true.
"Now decide if the main table needs another record or if the current record
"should go to multiple main records
"Check if the main table is blank for every field that's filled in this table
"If that's the case, then we just fill this record, if not, then we
"create a new record
concatenate 'PERNR' '&1' into lv_fieldname.
assign component lv_fieldname of structure to .
if is initial.
"Move all our values to this record
loop at lt_disp into ls_disp where infotype = ls_loop-infotype.
fieldmove ls_disp-fieldname '&1'.
endloop.
else.
"Move all our values to this record then append it to the table
move-corresponding to .
loop at lt_disp into ls_disp where infotype = ls_loop-infotype.
concatenate ls_disp-fieldname '&1' into lv_fieldname.
assign component lv_fieldname of structure to .
lv_fieldname = ls_disp-fieldname.
assign component lv_fieldname of structure to .
= .
endloop.
"Append to a new table so we don't process this record another time
append to .
endif.
added = abap_true.
endloop.
if sy-subrc <> 0 or added = abap_false.
"No records added yet, start off with this table's data
loop at lt_disp into ls_disp where infotype = ls_loop-infotype.
fieldmove ls_disp-fieldname '&1'.
endloop.
append to .
endif.
endloop.
endif.
append lines of to .
refresh .
end-of-definition.
*== Main program ====================================================
start-of-selection.
if lt_disp is initial or lt_sel is initial.
message e000(38) with 'Select fields to display'.
endif.
perform pre_select.
perform get_data.
perform disp_data.
*&---------------------------------------------------------------------*
*& Form GET_DISP_FIELDS
*&---------------------------------------------------------------------*
* Get all the fields we want to display for each infotype
*----------------------------------------------------------------------*
form get_disp_fields .
data: lt_popli type standard table of spopli,
ls_popli type spopli,
lt_options type string occurs 0 with header line.
refresh lt_disp.
lv_infotype = '0000'.
do 999 times.
refresh lt_popli.
if lv_infotype in s_info.
concatenate 'PA' lv_infotype into lv_infoname.
select single tabname from dd03l into @data(lv_tabname)
where tabname = @lv_infoname.
check sy-subrc = 0.
select l~tabname, l~fieldname, l~keyflag, l~rollname, t~ddtext
from dd03l as l
inner join dd04t as t
on l~rollname = t~rollname
into table @data(lt_dd03)
where l~tabname = @lv_infoname
and t~ddlanguage = @sy-langu
order by l~position.
delete lt_dd03 where fieldname cs '.INCL'.
delete lt_dd03 where rollname = 'MANDT'.
"Suppress these fields from the selection because we're going to default them
"in for every table
delete lt_dd03 where fieldname = 'PERNR' or fieldname = 'BEGDA' or fieldname = 'ENDDA'.
loop at lt_dd03 into data(ls_dd03).
clear ls_popli-selflag.
concatenate ls_dd03-tabname+2(4) ls_dd03-fieldname ls_dd03-ddtext into ls_popli-varoption separated by '~'.
append ls_popli to lt_popli.
endloop.
call function 'POPUP_TO_DECIDE_LIST'
exporting
mark_flag = 'X'
mark_max = 900
textline1 = lv_infoname
titel = 'Select fields'
tables
t_spopli = lt_popli
exceptions
not_enough_answers = 1
too_much_answers = 2
too_much_marks = 3
others = 4.
if sy-subrc <> 0.
* Implement suitable error handling here
endif.
ls_disp-infotype = lv_infotype.
ls_disp-fieldname = 'PERNR'.
append ls_disp to lt_disp.
ls_disp-fieldname = 'BEGDA'.
append ls_disp to lt_disp.
ls_disp-fieldname = 'ENDDA'.
append ls_disp to lt_disp.
loop at lt_popli into ls_popli where selflag = abap_true.
split ls_popli-varoption at '~' into table lt_options.
read table lt_options index 1.
clear ls_disp.
ls_disp-infotype = lt_options.
read table lt_options index 2.
ls_disp-fieldname = lt_options.
append ls_disp to lt_disp.
endloop.
endif.
lv_infotype = lv_infotype + 1.
enddo.
describe table lt_disp.
p_disc = sy-tfill.
endform.
*&---------------------------------------------------------------------*
*& Form GET_SEL_FIELDS
*&---------------------------------------------------------------------*
* See how the user wants to limit the selections
*----------------------------------------------------------------------*
form get_sel_fields .
data: lv_title like sy-title,
lv_expr type rsds_texpr,
lt_tables like rsdstabs occurs 0 with header line,
lt_fields like rsdsfields occurs 0 with header line,
lv_selid like rsdynsel-selid,
lv_actnum like sy-tfill,
lv_where type rsds_twhere.
check lt_disp is not initial.
refresh lt_sel.
lv_infotype = '0000'.
do 999 times.
if lv_infotype in s_info.
concatenate 'PA' lv_infotype into lv_infoname.
select single tabname from dd03l into @data(lv_tabname)
where tabname = @lv_infoname.
check sy-subrc = 0.
refresh: lt_tables, lt_fields.
clear: lv_where.
lt_tables-prim_tab = lv_infoname.
append lt_tables.
loop at lt_disp into ls_disp where infotype = lv_infotype.
lt_fields-tablename = lv_infoname.
lt_fields-fieldname = ls_disp-fieldname.
append lt_fields.
endloop.
call function 'FREE_SELECTIONS_INIT'
exporting
kind = 'T'
expressions = lv_expr
importing
selection_id = lv_selid
number_of_active_fields = lv_actnum
tables
tables_tab = lt_tables
fields_tab = lt_fields
exceptions
fields_incomplete = 1
fields_no_join = 2
field_not_found = 3
no_tables = 4
table_not_found = 5
expression_not_supported = 6
incorrect_expression = 7
illegal_kind = 8
area_not_found = 9
inconsistent_area = 10
kind_f_no_fields_left = 11
kind_f_no_fields = 12
too_many_fields = 13
dup_field = 14
field_no_type = 15
field_ill_type = 16
dup_event_field = 17
node_not_in_ldb = 18
area_no_field = 19
others = 20.
if sy-subrc <> 0.
* Implement suitable error handling here
endif.
concatenate 'Choose display fields for' lv_infoname into lv_title separated by space.
call function 'FREE_SELECTIONS_DIALOG'
exporting
selection_id = lv_selid
title = lv_title
tree_visible = ' '
importing
where_clauses = lv_where
number_of_active_fields = lv_actnum
tables
fields_tab = lt_fields
exceptions
internal_error = 1
no_action = 2
selid_not_found = 3
illegal_status = 4
others = 5.
if sy-subrc <> 0.
clear: lv_where.
endif.
ls_sel-infotype = lv_infotype.
ls_sel-whereclause = lv_where.
append ls_sel to lt_sel.
endif.
lv_infotype = lv_infotype + 1.
enddo.
data: lv_count type i.
loop at lt_sel into ls_sel where whereclause is not initial.
lv_count = lv_count + 1.
endloop.
p_selc = lv_count.
endform.
*&---------------------------------------------------------------------*
*& Form CHECK_OVERLAP
*&---------------------------------------------------------------------*
* See if the date ranges of the two table overlap
*----------------------------------------------------------------------*
form check_overlap changing p_overlapped.
clear p_overlapped.
if >= and
<= .
p_overlapped = abap_true.
exit.
endif.
if >= and
<= .
p_overlapped = abap_true.
exit.
endif.
if >= and
<= .
p_overlapped = abap_true.
exit.
endif.
if >= and
<= .
p_overlapped = abap_true.
exit.
endif.
endform.
*&---------------------------------------------------------------------*
*& Form GET_DATA
*&---------------------------------------------------------------------*
* Read the infotypes and fill the main table
*----------------------------------------------------------------------*
form get_data .
refresh lt_maincat.
lv_loop = 1.
lv_infotype = '0000'.
lv_cnt = 1.
do 999 times.
if lv_infotype in s_info.
concatenate 'PA' lv_infotype into lv_infoname.
select single tabname from dd03l into @data(lv_tabname)
where tabname = @lv_infoname.
check sy-subrc = 0.
refresh lt_cat.
clear lv_where.
"Dynamically create the table
loop at lt_disp into ls_disp where infotype = lv_infotype.
clear ls_cat.
ls_cat-tabname = lv_infoname.
ls_cat-fieldname = ls_disp-fieldname.
ls_cat-col_pos = lv_cnt.
lv_cnt = lv_cnt + 1.
ls_cat-ref_table = lv_infoname.
ls_cat-ref_field = ls_disp-fieldname.
append ls_cat to lt_cat.
concatenate ls_cat-fieldname lv_loop into ls_cat-fieldname.
append ls_cat to lt_maincat.
endloop.
call method cl_alv_table_create=>create_dynamic_table
exporting
it_fieldcatalog = lt_cat
importing
ep_table = lt_dyntab
exceptions
generate_subpool_dir_full = 1
others = 2.
if sy-subrc <> 0.
* Implement suitable error handling here
endif.
read table lt_sel into ls_sel with key infotype = lv_infotype.
if sy-subrc = 0 and ls_sel-whereclause is not initial.
read table ls_sel-whereclause into ls_where index 1.
lt_wheretab = ls_where-where_tab.
if lt_wheretab[] is not initial.
clear lv_where.
loop at lt_wheretab into ls_wheretab.
concatenate lv_where ls_wheretab-line into lv_where separated by space.
endloop.
endif.
endif.
case lv_loop.
when 1.
tablesel 01.
when 2.
tablesel 02.
when 3.
tablesel 03.
when 4.
tablesel 04.
when 5.
tablesel 05.
when 6.
tablesel 06.
when 7.
tablesel 07.
when 8.
tablesel 08.
when 9.
tablesel 09.
when 10.
tablesel 10.
when 11.
tablesel 11.
when 12.
tablesel 12.
when 13.
tablesel 13.
when 14.
tablesel 14.
when 15.
tablesel 15.
when 16.
tablesel 16.
when 17.
tablesel 17.
when 18.
tablesel 18.
when 19.
tablesel 19.
when 20.
tablesel 20.
when others.
message e000(38) with 'Maximum no. tables exceeded'.
endcase.
"Keep track of which loops handle which infotypes
ls_loop-loop = lv_loop.
ls_loop-infotype = lv_infotype.
append ls_loop to lt_loop.
lv_loop = lv_loop + 1.
endif.
lv_infotype = lv_infotype + 1.
enddo.
"Now build up the final table with all the data
call method cl_alv_table_create=>create_dynamic_table
exporting
it_fieldcatalog = lt_maincat
importing
ep_table = lt_dyntab
exceptions
generate_subpool_dir_full = 1
others = 2.
if sy-subrc <> 0.
* Implement suitable error handling here
endif.
assign lt_dyntab->* to .
call method cl_alv_table_create=>create_dynamic_table
exporting
it_fieldcatalog = lt_maincat
importing
ep_table = lt_dyntab
exceptions
generate_subpool_dir_full = 1
others = 2.
if sy-subrc <> 0.
* Implement suitable error handling here
endif.
assign lt_dyntab->* to .
"Create a work area for us to loop through
create data ls_dynwa like line of .
assign ls_dynwa->* to .
create data ls_dynwa like line of .
assign ls_dynwa->* to .
buildmain: 01, 02, 03, 04, 05, 06, 07, 08, 09, 10.
buildmain: 11, 12, 13, 14, 15, 16, 17, 18, 19, 20.
endform.
*&---------------------------------------------------------------------*
*& Form DISP_DATA
*&---------------------------------------------------------------------*
* Display the main table
*----------------------------------------------------------------------*
form disp_data .
data: lt_fcat type slis_t_fieldcat_alv,
ls_fcat type line of slis_t_fieldcat_alv,
ls_layout type slis_layout_alv,
lt_sort type slis_t_sortinfo_alv,
ls_sort type line of slis_t_sortinfo_alv.
loop at lt_maincat into ls_cat.
clear ls_fcat.
ls_fcat-fieldname = ls_cat-fieldname.
ls_fcat-ref_tabname = ls_cat-ref_table.
ls_fcat-ref_fieldname = ls_cat-ref_field.
"Hide subsequent PERNR, BEGDA, ENDDA fields to avoid clutter
if p_hide = abap_true.
if ls_fcat-fieldname cs 'PERNR' or
ls_fcat-fieldname cs 'BEGDA' or
ls_fcat-fieldname cs 'ENDDA'.
if ls_fcat-fieldname ns '01' and
ls_fcat-fieldname ns 'MAIN'. "Don't chop off the main pernr
ls_fcat-no_out = abap_true.
endif.
endif.
endif.
append ls_fcat to lt_fcat.
endloop.
refresh lt_sort.
ls_sort-fieldname = 'PERNR01'.
append ls_sort to lt_sort.
ls_sort-fieldname = 'BEGDA01'.
append ls_sort to lt_sort.
ls_sort-fieldname = 'ENDDA01'.
append ls_sort to lt_sort.
ls_layout-colwidth_optimize = abap_true.
ls_layout-zebra = abap_true.
call function 'REUSE_ALV_GRID_DISPLAY'
exporting
is_layout = ls_layout
it_sort = lt_sort
it_fieldcat = lt_fcat
tables
t_outtab =
exceptions
program_error = 1
others = 2.
if sy-subrc <> 0.
* Implement suitable error handling here
endif.
endform.
*&---------------------------------------------------------------------*
*& Form PRE_SELECT
*&---------------------------------------------------------------------*
* Go through all the selections and determine which PERNRs to select
* for all the tables
*----------------------------------------------------------------------*
form pre_select .
data: begin of pernrrec,
pernr like pa0000-pernr,
end of pernrrec.
data: lt_pernrs like standard table of pernrrec,
lt_small like standard table of pernrrec,
ls_pernr like pernrrec,
ls_old like pernrrec,
lv_small type i,
lv_pernrs type i,
lv_diff type i.
refresh: lt_pernrs, s_pernr.
loop at lt_sel into ls_sel where whereclause is not initial.
read table ls_sel-whereclause into ls_where index 1.
lt_wheretab = ls_where-where_tab.
if lt_wheretab[] is not initial.
clear lv_where.
loop at lt_wheretab into ls_wheretab.
concatenate lv_where ls_wheretab-line into lv_where separated by space.
endloop.
endif.
concatenate 'PA' ls_sel-infotype into lv_infoname.
if p_curr is initial.
select pernr from (lv_infoname) into table lt_pernrs
where (lv_where)
order by pernr.
else.
select pernr from (lv_infoname) into table lt_pernrs
where (lv_where)
and begda <= sy-datum
and endda >= sy-datum
order by pernr.
endif.
if lt_small is initial.
append lines of lt_pernrs to lt_small.
else.
"Only bring over the overlapping pernrs
loop at lt_small into ls_pernr.
read table lt_pernrs transporting no fields
with key pernr = ls_pernr-pernr
binary search.
check sy-subrc <> 0.
delete lt_small where pernr = ls_pernr-pernr.
endloop.
endif.
endloop.
sort lt_small.
delete adjacent duplicates from lt_small.
clear: ls_old, s_pernr.
loop at lt_small into ls_pernr.
lv_diff = ls_pernr - ls_old.
if lv_diff = 1 and ls_old is not initial.
s_pernr-option = 'BT'.
s_pernr-high = ls_pernr.
else.
if s_pernr is not initial.
append s_pernr.
clear s_pernr.
endif.
s_pernr-sign = 'I'.
s_pernr-option = 'EQ'.
s_pernr-low = ls_pernr.
endif.
ls_old = ls_pernr.
endloop.
if s_pernr is not initial.
append s_pernr.
endif.
endform.
*&---------------------------------------------------------------------*
*& Form GET_INFOTYPES
*&---------------------------------------------------------------------*
* Pull in table names and descriptions for each infotype
*----------------------------------------------------------------------*
form get_infotypes tables pt_infotypes structure infotyperec.
select tabname, ddtext from dd02t into table @data(lt_dd2)
where tabname like 'PA%'
and ddlanguage = @sy-langu.
lv_infotype = '0000'.
do 999 times.
concatenate 'PA' lv_infotype into lv_infoname.
read table lt_dd2 into data(ls_dd2) with key tabname = lv_infoname.
if sy-subrc = 0.
pt_infotypes-fieldname = lv_infotype.
pt_infotypes-desc = ls_dd2-ddtext.
append pt_infotypes.
endif.
lv_infotype = lv_infotype + 1.
enddo.
endform.
Tuesday, March 19, 2019
Copying files between your desktop and SAP
If you need to move a number of files or just move files between SAP and your desktop on a regular basis then you're probably not very happy with using CG3Z and CG3Y. I wrote a program to allow you to drag-and-drop files using just your mouse
On the selection screen you can enter starting paths for the PC and the server saving you time clicking around. You can also limit the file selection to just files you're interested in e.g. *.txt to get just text files.
The program uses a pair of CL_GUI_ALV_TREE controls sitting inside a splitter. You will need to create a screen with a huge custom control on it called MAINCONT.
*&---------------------------------------------------------------------*
*& Report ZZFILE
*&
*&---------------------------------------------------------------------*
*& File manager to move and copy files
*& Mark Langenhoven
*& 2019/02/14
*&---------------------------------------------------------------------*
report zzfile.
*--- Class deferring ------------------------------------------------
class lcl_tree_eventhandler definition deferred.
*--- Constants ------------------------------------------------------
constants: gc_windows(10) value 'WINDOWS',
gc_unix(4) value 'UNIX'.
*--- Types ----------------------------------------------------------
types: begin of t_file,
dirname type char600,
name type char300,
type_id type char1,
type type char40,
len(16) type p,
owner type char8,
mtime(6) type p,
mode type char9,
useable type char1,
subrc type char4,
errno type char3,
errmsg type char40,
mod_date type d,
mod_time type char8,
seen type char1,
changed type char1,
checked type c,
end of t_file.
data: begin of ls_tree,
directory(10) type c,
filename(10) type c,
len(16) type p,
date like sy-datum,
time like sy-uzeit,
end of ls_tree.
types: begin of tree_type,
parent_node type lvc_nkey,
node_key type lvc_nkey,
name type string,
filetype type c,
end of tree_type.
*--- Data declarations ----------------------------------------------
data: the_handler type ref to lcl_tree_eventhandler, "application,
custom type ref to cl_gui_custom_container,
v_split type ref to cl_gui_splitter_container,
l_tree_con type ref to cl_gui_container,
r_tree_con type ref to cl_gui_container,
server_tree type ref to cl_gui_alv_tree,
pc_tree type ref to cl_gui_alv_tree.
data: g_event(30),
g_node_key type lvc_nkey.
data: okcode like sy-ucomm,
firsttime.
data: gv_servtype(10),
gv_pctype(10).
data: gv_servdir type string,
gv_pcdir type string,
gv_serv_changed,
gv_pc_changed.
data: gs_file type t_file,
gt_servfiles type standard table of t_file,
gt_pcfiles type standard table of t_file.
data: gt_tree like standard table of ls_tree,
gt_fieldcat type lvc_t_fcat.
data: gt_serv_tree type standard table of tree_type,
gt_pc_tree type standard table of tree_type,
gs_tree type tree_type.
data: gv_serv_dragdrop type ref to cl_dragdrop,
gv_pc_dragdrop type ref to cl_dragdrop,
gv_serv_handle type i,
gv_pc_handle type i.
data: gv_answer type c,
gv_stop_copy type c,
gv_overwrite type c.
*--- Class implementations -----------------------------------------
class lcl_dragdropobj definition.
public section.
data: node_keys type lvc_t_nkey.
endclass.
class lcl_tree_eventhandler definition.
public section.
methods:
l_no_children
for event expand_nc
of cl_gui_alv_tree
importing node_key,
l_double
for event node_double_click
of cl_gui_alv_tree
importing node_key,
l_ondrag
for event on_drag_multiple
of cl_gui_alv_tree
importing
sender
drag_drop_object
fieldname
node_key_table,
l_ondrop
for event on_drop
of cl_gui_alv_tree
importing
drag_drop_object
node_key,
r_no_children
for event expand_nc
of cl_gui_alv_tree
importing node_key,
r_double
for event node_double_click
of cl_gui_alv_tree
importing node_key,
r_ondrag
for event on_drag_multiple
of cl_gui_alv_tree
importing
drag_drop_object
fieldname
node_key_table,
r_ondrop
for event on_drop
of cl_gui_alv_tree
importing
sender
drag_drop_object
node_key.
endclass.
class lcl_tree_eventhandler implementation.
"--- SERVER events --------------------------------------
method l_no_children.
data: lv_path type string.
g_node_key = node_key.
"Build up the path, so that we can add additional nodes in under here
clear lv_path.
do.
read table gt_serv_tree into gs_tree with key node_key = g_node_key.
perform build_path using gs_tree-name gv_servtype abap_false changing lv_path.
g_node_key = gs_tree-parent_node.
if g_node_key is initial.
exit.
endif.
enddo.
perform add_server_files using node_key lv_path.
endmethod.
"Refresh the current directory
method l_double.
data: lv_path type string.
g_node_key = node_key.
read table gt_serv_tree into gs_tree with key node_key = g_node_key.
check gs_tree-filetype = 'd'.
loop at gt_serv_tree into gs_tree where parent_node = g_node_key.
call method server_tree->delete_subtree
exporting
i_node_key = gs_tree-node_key
exceptions
node_key_not_in_model = 1
others = 2.
if sy-subrc <> 0.
* Implement suitable error handling here
endif.
delete gt_serv_tree.
endloop.
"Build up the path, so that we can add additional nodes in under here
clear lv_path.
do.
read table gt_serv_tree into gs_tree with key node_key = g_node_key.
perform build_path using gs_tree-name gv_servtype abap_false changing lv_path.
g_node_key = gs_tree-parent_node.
if g_node_key is initial.
exit.
endif.
enddo.
perform add_server_files using node_key lv_path.
endmethod.
method l_ondrag.
data: dataobj type ref to lcl_dragdropobj.
create object dataobj.
refresh dataobj->node_keys.
append lines of node_key_table to dataobj->node_keys.
"If you don't fill this object references, the drop event
"is never fired
drag_drop_object->object = dataobj.
endmethod.
method l_ondrop.
data: dataobj type ref to lcl_dragdropobj,
ls_node type lvc_nkey,
lv_movetype,
lv_num type i,
lv_perc type i.
catch system-exceptions move_cast_error = 1.
dataobj ?= drag_drop_object->object.
if drag_drop_object->effect = cl_dragdrop=>copy.
lv_movetype = 'C'.
else.
lv_movetype = 'M'.
endif.
clear gv_answer.
describe table dataobj->node_keys lines lv_num.
loop at dataobj->node_keys into ls_node.
lv_perc = sy-tabix * 100 / lv_num.
read table gt_pc_tree into gs_tree with key node_key = ls_node.
call function 'SAPGUI_PROGRESS_INDICATOR'
exporting
percentage = lv_perc
text = gs_tree-name.
perform copy2serv using ls_node node_key lv_movetype.
endloop.
endcatch.
if sy-subrc <> 0.
call method drag_drop_object->abort.
endif.
call method pc_tree->frontend_update.
call method server_tree->frontend_update.
message s000(38) with lv_num 'files completed'.
endmethod.
"--- PC events ------------------------------------------
method r_no_children.
data: lv_path type string.
g_node_key = node_key.
clear lv_path.
do.
read table gt_pc_tree into gs_tree with key node_key = g_node_key.
perform build_path using gs_tree-name gv_pctype abap_false changing lv_path.
g_node_key = gs_tree-parent_node.
if g_node_key is initial.
exit.
endif.
enddo.
perform add_pc_files using node_key lv_path.
endmethod.
"Refresh the current directory
method r_double.
data: lv_path type string.
g_node_key = node_key.
"Only operate on directories
read table gt_pc_tree into gs_tree with key node_key = g_node_key.
check gs_tree-filetype = 'd'.
"Wipe out all the file nodes in this directory
loop at gt_pc_tree into gs_tree where parent_node = g_node_key.
call method pc_tree->delete_subtree
exporting
i_node_key = gs_tree-node_key
exceptions
node_key_not_in_model = 1
others = 2.
if sy-subrc <> 0.
* Implement suitable error handling here
endif.
delete gt_pc_tree.
endloop.
clear lv_path.
do.
read table gt_pc_tree into gs_tree with key node_key = g_node_key.
perform build_path using gs_tree-name gv_pctype abap_false changing lv_path.
g_node_key = gs_tree-parent_node.
if g_node_key is initial.
exit.
endif.
enddo.
perform add_pc_files using node_key lv_path.
endmethod.
method r_ondrag.
data: dataobj type ref to lcl_dragdropobj.
create object dataobj.
refresh dataobj->node_keys.
append lines of node_key_table to dataobj->node_keys.
"If you don't fill this object references, the drop event
"is never fired
drag_drop_object->object = dataobj.
endmethod.
method r_ondrop.
data: dataobj type ref to lcl_dragdropobj,
ls_node type lvc_nkey,
lv_movetype,
lv_num type i,
lv_perc type i.
catch system-exceptions move_cast_error = 1.
dataobj ?= drag_drop_object->object.
if drag_drop_object->effect = cl_dragdrop=>copy.
lv_movetype = 'C'.
else.
lv_movetype = 'M'.
endif.
clear gv_answer.
describe table dataobj->node_keys lines lv_num.
loop at dataobj->node_keys into ls_node.
lv_perc = sy-tabix * 100 / lv_num.
read table gt_serv_tree into gs_tree with key node_key = ls_node.
call function 'SAPGUI_PROGRESS_INDICATOR'
exporting
percentage = lv_perc
text = gs_tree-name.
perform copy2pc using ls_node node_key lv_movetype.
endloop.
endcatch.
if sy-subrc <> 0.
call method drag_drop_object->abort.
endif.
call method pc_tree->frontend_update.
call method server_tree->frontend_update.
message s000(38) with lv_num 'files completed'.
endmethod.
endclass.
*--- Selection screen -----------------------------------------------
selection-screen begin of line.
selection-screen comment 1(25) ppc.
parameters: p_pc type string obligatory default 'C:\Users\' lower case.
selection-screen end of line.
selection-screen begin of line.
selection-screen comment 1(25) pserv.
parameters: p_serv type string obligatory lower case.
selection-screen end of line.
selection-screen skip.
selection-screen begin of line.
selection-screen comment 1(25) pmask.
parameters: p_mask type string lower case.
selection-screen end of line.
selection-screen skip.
selection-screen begin of line.
parameters: p_saplft as checkbox default 'X'.
selection-screen comment 3(25) psaplft.
selection-screen end of line.
at selection-screen on value-request for p_pc.
call method cl_gui_frontend_services=>directory_browse
exporting
window_title = 'Select a PC directory'
initial_folder = p_pc
changing
selected_folder = p_pc
exceptions
cntl_error = 1
error_no_gui = 2
not_supported_by_gui = 3
others = 4.
if sy-subrc <> 0.
* Implement suitable error handling here
endif.
at selection-screen on value-request for p_serv.
call function '/SAPDMC/LSM_F4_SERVER_FILE'
exporting
directory = p_serv
filemask = '?' "Bad filemask so we only show directories
importing
serverfile = p_serv
exceptions
canceled_by_user = 1
others = 2.
if sy-subrc <> 0.
* Implement suitable error handling here
endif.
initialization.
ppc = 'PC Directory'.
pserv = 'Server Directory'.
pmask = 'File mask (e.g. *.txt)'.
psaplft = 'SAP files on the left'.
concatenate '/tmp/' sy-sysid into p_serv.
*=== Main program ===================================================
start-of-selection.
perform init_systems.
call screen 0100
*&---------------------------------------------------------------------*
*& Form CREATE_CONTAINERS
*&---------------------------------------------------------------------*
* Create all the containers on the screen
*----------------------------------------------------------------------*
form create_containers .
data: events type cntl_simple_events,
event type cntl_simple_event.
data: dragtypes type i.
data: ls_fcat type lvc_s_fcat.
check firsttime = abap_true.
clear firsttime.
"Field catalog for the additional fields on both sides
clear ls_fcat.
ls_fcat-fieldname = 'DATE'.
ls_fcat-outputlen = 12.
ls_fcat-scrtext_s = 'Date'.
ls_fcat-ref_field = 'DATUM'.
ls_fcat-ref_table = 'SYST'.
append ls_fcat to gt_fieldcat.
clear ls_fcat.
ls_fcat-fieldname = 'TIME'.
ls_fcat-outputlen = 10.
ls_fcat-scrtext_s = 'Time'.
ls_fcat-ref_field = 'UZEIT'.
ls_fcat-ref_table = 'SYST'.
append ls_fcat to gt_fieldcat.
clear ls_fcat.
ls_fcat-fieldname = 'LEN'.
ls_fcat-outputlen = 10.
ls_fcat-scrtext_s = 'Size'.
append ls_fcat to gt_fieldcat.
create object the_handler.
"Create a screen with a huge custom container and allow it
"to resize as small as it wants
create object custom
exporting
container_name = 'MAINCONT'
exceptions
cntl_error = 1
cntl_system_error = 2
create_error = 3
lifetime_error = 4
lifetime_dynpro_dynpro_link = 5
others = 6.
if sy-subrc <> 0.
* MESSAGE ID SY-MSGID TYPE SY-MSGTY NUMBER SY-MSGNO
* WITH SY-MSGV1 SY-MSGV2 SY-MSGV3 SY-MSGV4.
endif.
"Split the screen in half vertically
create object v_split
exporting
parent = custom
rows = 1
columns = 2.
"Split each half in half again horizontally
call method v_split->get_container
exporting
row = 1
column = 1
receiving
container = l_tree_con.
call method v_split->get_container
exporting
row = 1
column = 2
receiving
container = r_tree_con.
"Create the SERVER tree
if p_saplft = abap_true.
create object server_tree
exporting
parent = l_tree_con
node_selection_mode = cl_tree_control_base=>node_sel_mode_multiple
no_html_header = abap_true
no_toolbar = abap_true
exceptions
cntl_error = 1
cntl_system_error = 2
create_error = 3
lifetime_error = 4
illegal_node_selection_mode = 5
failed = 6
illegal_column_name = 7
others = 8.
if sy-subrc <> 0.
* MESSAGE ID SY-MSGID TYPE SY-MSGTY NUMBER SY-MSGNO
* WITH SY-MSGV1 SY-MSGV2 SY-MSGV3 SY-MSGV4.
endif.
else.
create object server_tree
exporting
parent = r_tree_con
node_selection_mode = cl_tree_control_base=>node_sel_mode_multiple
no_html_header = abap_true
no_toolbar = abap_true
exceptions
cntl_error = 1
cntl_system_error = 2
create_error = 3
lifetime_error = 4
illegal_node_selection_mode = 5
failed = 6
illegal_column_name = 7
others = 8.
if sy-subrc <> 0.
* MESSAGE ID SY-MSGID TYPE SY-MSGTY NUMBER SY-MSGNO
* WITH SY-MSGV1 SY-MSGV2 SY-MSGV3 SY-MSGV4.
endif.
endif.
call method server_tree->get_registered_events
importing
events = events
exceptions
cntl_error = 1
others = 2.
if sy-subrc <> 0.
* Implement suitable error handling here
endif.
"Set the event handlers for the server
event-eventid = cl_gui_column_tree=>eventid_node_double_click.
append event to events.
event-eventid = cl_gui_column_tree=>eventid_expand_no_children.
append event to events.
call method server_tree->set_registered_events
exporting
events = events
exceptions
cntl_error = 1
cntl_system_error = 2
illegal_event_combination = 3
others = 4.
if sy-subrc <> 0.
* Implement suitable error handling here
endif.
set handler the_handler->l_no_children for server_tree.
set handler the_handler->l_ondrag for server_tree.
set handler the_handler->l_ondrop for server_tree.
set handler the_handler->l_double for server_tree.
create object gv_serv_dragdrop.
dragtypes = cl_dragdrop=>move + cl_dragdrop=>copy.
call method gv_serv_dragdrop->add
exporting
flavor = 'SERV2PC'
dragsrc = abap_true
droptarget = space
effect = dragtypes
exceptions
already_defined = 1
obj_invalid = 2
others = 3.
if sy-subrc <> 0.
* Implement suitable error handling here
endif.
call method gv_serv_dragdrop->add
exporting
flavor = 'PC2SERV'
dragsrc = space
droptarget = abap_true
effect = dragtypes
exceptions
already_defined = 1
obj_invalid = 2
others = 3.
if sy-subrc <> 0.
* Implement suitable error handling here
endif.
call method gv_serv_dragdrop->get_handle
importing
handle = gv_serv_handle
exceptions
obj_invalid = 1
others = 2.
if sy-subrc <> 0.
* Implement suitable error handling here
endif.
perform build_server_tree.
"Create the PC tree
if p_saplft = abap_true.
create object pc_tree
exporting
parent = r_tree_con
node_selection_mode = cl_tree_control_base=>node_sel_mode_multiple
no_toolbar = abap_true
no_html_header = abap_true
exceptions
cntl_error = 1
cntl_system_error = 2
create_error = 3
lifetime_error = 4
illegal_node_selection_mode = 5
failed = 6
illegal_column_name = 7
others = 8.
if sy-subrc <> 0.
* MESSAGE ID SY-MSGID TYPE SY-MSGTY NUMBER SY-MSGNO
* WITH SY-MSGV1 SY-MSGV2 SY-MSGV3 SY-MSGV4.
endif.
else.
create object pc_tree
exporting
parent = l_tree_con
node_selection_mode = cl_tree_control_base=>node_sel_mode_multiple
no_toolbar = abap_true
no_html_header = abap_true
exceptions
cntl_error = 1
cntl_system_error = 2
create_error = 3
lifetime_error = 4
illegal_node_selection_mode = 5
failed = 6
illegal_column_name = 7
others = 8.
if sy-subrc <> 0.
* MESSAGE ID SY-MSGID TYPE SY-MSGTY NUMBER SY-MSGNO
* WITH SY-MSGV1 SY-MSGV2 SY-MSGV3 SY-MSGV4.
endif.
endif.
refresh events.
call method pc_tree->get_registered_events
importing
events = events
exceptions
cntl_error = 1
others = 2.
if sy-subrc <> 0.
* Implement suitable error handling here
endif.
"Set the event handlers for the PC
event-eventid = cl_gui_column_tree=>eventid_node_double_click.
append event to events.
event-eventid = cl_gui_column_tree=>eventid_expand_no_children.
append event to events.
call method pc_tree->set_registered_events
exporting
events = events
exceptions
cntl_error = 1
cntl_system_error = 2
illegal_event_combination = 3
others = 4.
if sy-subrc <> 0.
* Implement suitable error handling here
endif.
set handler the_handler->r_no_children for pc_tree.
set handler the_handler->r_ondrag for pc_tree.
set handler the_handler->r_ondrop for pc_tree.
set handler the_handler->r_double for pc_tree.
create object gv_pc_dragdrop.
dragtypes = cl_dragdrop=>move + cl_dragdrop=>copy.
call method gv_pc_dragdrop->add
exporting
flavor = 'SERV2PC'
dragsrc = space
droptarget = abap_true
effect = dragtypes
exceptions
already_defined = 1
obj_invalid = 2
others = 3.
if sy-subrc <> 0.
* Implement suitable error handling here
endif.
call method gv_pc_dragdrop->add
exporting
flavor = 'PC2SERV'
dragsrc = abap_true
droptarget = space
effect = dragtypes
exceptions
already_defined = 1
obj_invalid = 2
others = 3.
if sy-subrc <> 0.
* Implement suitable error handling here
endif.
call method gv_pc_dragdrop->get_handle
importing
handle = gv_pc_handle
exceptions
obj_invalid = 1
others = 2.
if sy-subrc <> 0.
* Implement suitable error handling here
endif.
perform build_pc_tree.
endform.
*&---------------------------------------------------------------------*
*& Form BUILD_SERVER_TREE
*&---------------------------------------------------------------------*
* Using the supplied path as the starting point, build up a tree of the
* subdirectories below it
*----------------------------------------------------------------------*
form build_server_tree.
data: ls_layout type lvc_s_layn,
lv_relat_node_key type lvc_nkey,
lv_main_key type lvc_nkey,
ls_head type treev_hhdr,
lv_value type lvc_value.
ls_head-heading = 'Files on server'.
ls_head-width = 50.
ls_head-width_pix = ''.
call method server_tree->set_table_for_first_display
exporting
is_hierarchy_header = ls_head
changing
it_outtab = gt_tree
it_fieldcatalog = gt_fieldcat.
ls_layout-isfolder = abap_true.
ls_layout-expander = abap_true.
ls_layout-dragdropid = gv_serv_handle.
clear ls_tree.
lv_value = p_serv.
call method server_tree->add_node
exporting
i_relat_node_key = lv_relat_node_key
i_relationship = cl_tree_control_base=>relat_last_child
is_outtab_line = ls_tree
is_node_layout = ls_layout
i_node_text = lv_value
importing
e_new_node_key = lv_main_key
exceptions
relat_node_not_found = 1
node_not_found = 2
others = 3.
if sy-subrc <> 0.
* Implement suitable error handling here
endif.
refresh gt_serv_tree.
perform build_my_tree tables gt_serv_tree using lv_relat_node_key lv_main_key p_serv 'd'.
perform add_server_files using lv_main_key gv_servdir.
endform.
*&---------------------------------------------------------------------*
*& Module STATUS_0100 OUTPUT
*&---------------------------------------------------------------------*
module status_0100 output.
data: lv_mask type string.
set pf-status 'MAIN0100'.
clear lv_mask.
if p_mask is not initial.
concatenate '- (' p_mask ')' into lv_mask.
endif.
set titlebar 'FIL' with lv_mask.
perform create_containers.
endmodule.
*&---------------------------------------------------------------------*
*& Module USER_COMMAND_0100 INPUT
*&---------------------------------------------------------------------*
module user_command_0100 input.
if sy-ucomm = 'E'.
leave to screen 0.
endif.
call method cl_gui_cfw=>dispatch.
endmodule.
*&---------------------------------------------------------------------*
*& Form INIT_SYSTEMS
*&---------------------------------------------------------------------*
* Initialise the directories and operating systems
*----------------------------------------------------------------------*
form init_systems .
data: lv_platform type i.
firsttime = abap_true.
"Determine the operating system of the server
if sy-opsys cs 'Windows'.
gv_servtype = gc_windows.
else.
gv_servtype = gc_unix.
endif.
"Determine the starting directory for the server
if p_serv is initial.
if gv_servtype = gc_unix.
gv_servdir = '/'.
else.
gv_servdir = 'C:\'.
endif.
else.
gv_servdir = p_serv.
endif.
"Check that this is a valid starting directory
if gv_servtype = gc_unix.
if gv_servdir cs '\'.
message e000(38) with 'Invalid directory specified' 'Only Unix paths are accepted'.
exit.
endif.
else.
if gv_servdir cs '/'.
message e000(38) with 'Invalid directory specified' 'Only Windows paths are accepted'.
exit.
endif.
endif.
"Determine the operating system of the PC
call method cl_gui_frontend_services=>get_platform
receiving
platform = lv_platform
exceptions
error_no_gui = 1
cntl_error = 2
not_supported_by_gui = 3
others = 4.
if sy-subrc <> 0.
* Implement suitable error handling here
endif.
if lv_platform = cl_gui_frontend_services=>platform_windowsxp.
gv_pctype = gc_windows.
else.
gv_pctype = gc_unix.
message e000(38) with 'I do not support Unix frontends at the moment'.
endif.
"Determine the starting directory for the PC
if p_pc is initial.
if gv_pctype = gc_unix.
gv_pcdir = '/'.
else.
gv_pcdir = 'C:\'.
endif.
else.
gv_pcdir = p_pc.
endif.
"Check that this is a valid starting directory
if gv_pctype = gc_unix.
if gv_pcdir cs '\'.
message e000(38) with 'Invalid directory specified' 'Only Unix paths are accepted'.
exit.
endif.
else.
if gv_pcdir cs '/'.
message e000(38) with 'Invalid directory specified' 'Only Windows paths are accepted'.
exit.
endif.
endif.
"Mark both systems as changed initially so we can get the starting
"direcotry information
gv_serv_changed = abap_true.
gv_pc_changed = abap_true.
endform.
*&---------------------------------------------------------------------*
*& Form GET_SERV_FILES
*&---------------------------------------------------------------------*
* Find all the files and directories below the current directory
*----------------------------------------------------------------------*
form get_serv_files tables pt_files structure gs_file
using pv_dir.
constants: c_dir type char10 value 'DIR',
c_file type char10 value 'FILE',
c_name type char10 value 'NAME',
c_owner type char10 value 'OWNER',
c_len type char10 value 'LEN',
c_mode type char10 value 'MODE',
c_mtime type char10 value 'MTIME',
c_type type char10 value 'TYPE',
c_errmsg type char10 value 'ERRMSG',
c_errno type char10 value 'ERRNO'.
data: lv_path_name type localfile,
lv_file_name type localfile.
data: ls_file type t_file,
ctime(10) type c,
time like sy-uzeit,
date like sy-datum.
refresh pt_files.
lv_path_name = pv_dir.
* End of directory read (initialize the next call)
call 'C_DIR_READ_FINISH' id c_errno field ls_file-errno
id c_errmsg field ls_file-errmsg.
call 'C_DIR_READ_START' id c_dir field lv_path_name
id c_file field lv_file_name
id c_errno field ls_file-errno
id c_errmsg field ls_file-errmsg.
if sy-subrc <> 0.
message e000(38) with 'Error reading directory' gv_servdir ls_file-errmsg.
else.
do.
call 'C_DIR_READ_NEXT'
id c_type field ls_file-type
id c_name field ls_file-name
id c_len field ls_file-len
id c_owner field ls_file-owner
id c_mtime field ls_file-mtime
id c_mode field ls_file-mode
id c_errno field ls_file-errno
id c_errmsg field ls_file-errmsg.
ls_file-dirname = gv_servdir.
ls_file-subrc = sy-subrc.
translate ls_file-type to lower case.
case sy-subrc.
"Determine if a file is useable or not
when 0.
if ls_file-type(1) = 'f' or
ls_file-type(1) = 'd'.
"Add to the list of files to display
if ls_file-mode(1) >= '5'.
ls_file-useable = 'W'. "File or dir is writeable
elseif ls_file-mode(1) = '4'.
ls_file-useable = 'R'. "Only read permissions
else.
clear ls_file-useable. "No permissions
endif.
perform p6_to_date_time_tz(rstr0400) using ls_file-mtime
ctime
date.
translate ctime using ': '.
condense ctime no-gaps.
time = ctime.
ls_file-mod_date = date.
ls_file-mod_time = time.
append ls_file to pt_files.
endif.
when 1.
exit.
when others.
endcase.
enddo.
endif.
sort pt_files by name.
endform.
*&---------------------------------------------------------------------*
*& Form BUILD_MY_TREE
*&---------------------------------------------------------------------*
* Build my internal version of the tree to keep track of sub-directories
* and file locations
*----------------------------------------------------------------------*
form build_my_tree tables pt_tree structure gs_tree
using pv_header_node
pv_node
pv_name
value(pv_type).
clear gs_tree.
gs_tree-parent_node = pv_header_node.
gs_tree-node_key = pv_node.
gs_tree-name = pv_name.
gs_tree-filetype = pv_type.
append gs_tree to pt_tree.
endform.
*&---------------------------------------------------------------------*
*& Form BUILD_PATH
*&---------------------------------------------------------------------*
* Build up the path based on the OS type
*----------------------------------------------------------------------*
form build_path using pv_dir_name
pv_ostype
pv_file
changing pv_path.
data: separator type c.
if pv_ostype = gc_windows.
separator = '\'.
else.
separator = '/'.
endif.
if pv_file = abap_true and pv_path is initial.
clear separator.
endif.
concatenate pv_dir_name separator pv_path into pv_path.
"If the user added a slash to the end of the starting paths
"then we could end up with duplicated separators
replace all occurrences of '\\' in pv_path with '\'.
replace all occurrences of '//' in pv_path with '/'.
endform.
*&---------------------------------------------------------------------*
*& Form ADD_SERVER_FILES
*&---------------------------------------------------------------------*
* Add files to the specified node for the supplied path
*----------------------------------------------------------------------*
form add_server_files using pv_node
pv_path.
data: lv_name type lvc_value,
ls_layout type lvc_s_layn,
lv_relat_node_key type lvc_nkey,
lv_matched type c.
perform get_serv_files tables gt_servfiles using pv_path.
"First add any sub-directories
loop at gt_servfiles into gs_file where type(1) = 'd'.
lv_name = gs_file-name.
check lv_name <> '.' and
lv_name <> '..'.
clear ls_layout.
if gs_file-useable = 'W'.
ls_layout-isfolder = abap_true.
ls_layout-expander = abap_true.
ls_layout-dragdropid = gv_serv_handle.
endif.
if gs_file-useable = 'R'.
ls_layout-isfolder = abap_true.
ls_layout-expander = abap_true.
endif.
if gs_file-useable = abap_false.
ls_layout-isfolder = abap_true.
ls_layout-disabled = abap_true.
endif.
clear ls_tree.
ls_tree-date = gs_file-mod_date.
ls_tree-time = gs_file-mod_time.
clear ls_tree-len.
call method server_tree->add_node
exporting
i_relat_node_key = pv_node
i_relationship = cl_tree_control_base=>relat_last_child
is_outtab_line = ls_tree
is_node_layout = ls_layout
i_node_text = lv_name
importing
e_new_node_key = lv_relat_node_key
exceptions
relat_node_not_found = 1
node_not_found = 2
others = 3.
if sy-subrc <> 0.
* Implement suitable error handling here
endif.
perform build_my_tree tables gt_serv_tree using pv_node lv_relat_node_key gs_file-name gs_file-type(1).
endloop.
"Add the files
loop at gt_servfiles into gs_file where type(1) = 'f'.
"If there's a mask filter in place, then see if this file matches it
perform match_mask using gs_file-name changing lv_matched.
check lv_matched = abap_true.
lv_name = gs_file-name.
clear ls_layout.
if gs_file-useable = 'W'.
ls_layout-dragdropid = gv_serv_handle.
else.
ls_layout-disabled = abap_true.
endif.
clear ls_tree.
ls_tree-date = gs_file-mod_date.
ls_tree-time = gs_file-mod_time.
ls_tree-len = gs_file-len.
call method server_tree->add_node
exporting
i_relat_node_key = pv_node
i_relationship = cl_tree_control_base=>relat_last_child
is_outtab_line = ls_tree
is_node_layout = ls_layout
i_node_text = lv_name
importing
e_new_node_key = lv_relat_node_key
exceptions
relat_node_not_found = 1
node_not_found = 2
others = 3.
if sy-subrc <> 0.
* Implement suitable error handling here
endif.
perform build_my_tree tables gt_serv_tree using pv_node lv_relat_node_key gs_file-name gs_file-type(1).
endloop.
call method server_tree->expand_node
exporting
i_node_key = pv_node
exceptions
failed = 1
illegal_level_count = 2
cntl_system_error = 3
node_not_found = 4
cannot_expand_leaf = 5
others = 6.
if sy-subrc <> 0.
* Implement suitable error handling here
endif.
call method server_tree->frontend_update.
endform.
*&---------------------------------------------------------------------*
*& Form BUILD_PC_TREE
*&---------------------------------------------------------------------*
* Build up the tree containing the PC folders and files
*----------------------------------------------------------------------*
form build_pc_tree.
data: ls_layout type lvc_s_layn,
lv_relat_node_key type lvc_nkey,
lv_main_key type lvc_nkey,
ls_head type treev_hhdr,
ls_fcat type lvc_s_fcat,
lv_value type lvc_value.
ls_head-heading = 'Files on PC'.
ls_head-width = 50.
ls_head-width_pix = ''.
call method pc_tree->set_table_for_first_display
exporting
is_hierarchy_header = ls_head
changing
it_outtab = gt_tree
it_fieldcatalog = gt_fieldcat.
ls_layout-isfolder = abap_true.
ls_layout-expander = abap_true.
ls_layout-dragdropid = gv_pc_handle.
clear ls_tree.
lv_value = p_pc.
call method pc_tree->add_node
exporting
i_relat_node_key = lv_relat_node_key
i_relationship = cl_tree_control_base=>relat_last_child
is_outtab_line = ls_tree
is_node_layout = ls_layout
i_node_text = lv_value
importing
e_new_node_key = lv_main_key
exceptions
relat_node_not_found = 1
node_not_found = 2
others = 3.
if sy-subrc <> 0.
* Implement suitable error handling here
endif.
refresh gt_pc_tree.
perform build_my_tree tables gt_pc_tree using lv_relat_node_key lv_main_key p_pc 'd'.
perform add_pc_files using lv_main_key p_pc.
endform.
*&---------------------------------------------------------------------*
*& Form ADD_PC_FILES
*&---------------------------------------------------------------------*
* Add the folders and files found on the PC
*----------------------------------------------------------------------*
form add_pc_files using pv_node
pv_path.
data: lv_path type string,
ls_layout type lvc_s_layn,
lt_files type standard table of file_info,
ls_file type file_info,
lv_relat_node_key type lvc_nkey,
lv_value type lvc_value,
lv_matched type c,
lv_count type i.
lv_path = pv_path.
call method cl_gui_frontend_services=>directory_list_files
exporting
directory = lv_path
changing
file_table = lt_files
count = lv_count
exceptions
cntl_error = 1
directory_list_files_failed = 2
wrong_parameter = 3
error_no_gui = 4
not_supported_by_gui = 5
others = 6.
if sy-subrc <> 0.
* Implement suitable error handling here
endif.
sort lt_files by filename.
"First add all the sub-directories
ls_layout-isfolder = abap_true.
ls_layout-expander = abap_true.
ls_layout-dragdropid = gv_pc_handle.
loop at lt_files into ls_file where isdir = 1. "Insane moron using int for a flag
check ls_file-ishidden = 0.
clear ls_tree.
ls_tree-date = ls_file-createdate.
ls_tree-time = ls_file-createtime.
lv_value = ls_file-filename.
call method pc_tree->add_node
exporting
i_relat_node_key = pv_node
i_relationship = cl_tree_control_base=>relat_last_child
is_outtab_line = ls_tree
is_node_layout = ls_layout
i_node_text = lv_value
importing
e_new_node_key = lv_relat_node_key
exceptions
relat_node_not_found = 1
node_not_found = 2
others = 3.
if sy-subrc <> 0.
* Implement suitable error handling here
endif.
perform build_my_tree tables gt_pc_tree using pv_node lv_relat_node_key ls_file-filename 'd'.
endloop.
"Now add all the files
clear ls_layout.
ls_layout-dragdropid = gv_pc_handle.
loop at lt_files into ls_file where isdir = 0.
check ls_file-ishidden = 0.
clear ls_tree.
lv_value = ls_file-filename.
"If there's a mask filter in place, then see if this file matches it
perform match_mask using ls_file-filename changing lv_matched.
check lv_matched = abap_true.
clear ls_tree.
ls_tree-date = ls_file-createdate.
ls_tree-time = ls_file-createtime.
ls_tree-len = ls_file-filelength.
call method pc_tree->add_node
exporting
i_relat_node_key = pv_node
i_relationship = cl_tree_control_base=>relat_last_child
is_outtab_line = ls_tree
is_node_layout = ls_layout
i_node_text = lv_value
importing
e_new_node_key = lv_relat_node_key
exceptions
relat_node_not_found = 1
node_not_found = 2
others = 3.
if sy-subrc <> 0.
* Implement suitable error handling here
endif.
perform build_my_tree tables gt_pc_tree using pv_node lv_relat_node_key ls_file-filename 'f'.
endloop.
call method pc_tree->expand_node
exporting
i_node_key = pv_node
exceptions
failed = 1
illegal_level_count = 2
cntl_system_error = 3
node_not_found = 4
cannot_expand_leaf = 5
others = 6.
if sy-subrc <> 0.
* Implement suitable error handling here
endif.
call method pc_tree->frontend_update.
endform.
*&---------------------------------------------------------------------*
*& Form COPY2PC
*&---------------------------------------------------------------------*
* Copy a file to the PC
*----------------------------------------------------------------------*
form copy2pc using pv_server_node
pv_pc_node
pv_move_type.
data: lv_relat_node_key type lvc_nkey,
lv_pc_node type lvc_nkey,
lv_value type lvc_value,
ls_layout type lvc_s_layn,
lv_file_name type string.
"If the PC destination is a file, then find the directory that it's in
read table gt_pc_tree into gs_tree with key node_key = pv_pc_node.
if gs_tree-filetype = 'f'.
lv_pc_node = gs_tree-parent_node.
else.
lv_pc_node = pv_pc_node.
endif.
read table gt_serv_tree into gs_tree with key node_key = pv_server_node.
check sy-subrc = 0.
"If the SERVER origin is a directory, then copy all the files inside it
if gs_tree-filetype = 'd'.
"Loop through all the files in this directory and copy them over
loop at gt_serv_tree into gs_tree where parent_node = pv_server_node.
perform copy2pc using gs_tree-node_key lv_pc_node pv_move_type.
endloop.
exit.
endif.
"Copy the actual file -----------------------------------
clear gv_stop_copy.
perform file2pc using pv_server_node lv_pc_node pv_move_type changing lv_file_name.
check gv_stop_copy is initial.
if gv_overwrite is initial.
"Add the node to the PC tree ----------------------------
clear ls_tree.
lv_value = lv_file_name.
clear ls_layout.
ls_layout-dragdropid = gv_pc_handle.
call method pc_tree->add_node
exporting
i_relat_node_key = lv_pc_node
i_relationship = cl_tree_control_base=>relat_last_child
is_outtab_line = ls_tree
is_node_layout = ls_layout
i_node_text = lv_value
importing
e_new_node_key = lv_relat_node_key
exceptions
relat_node_not_found = 1
node_not_found = 2
others = 3.
if sy-subrc <> 0.
* Implement suitable error handling here
endif.
perform build_my_tree tables gt_pc_tree using lv_pc_node lv_relat_node_key lv_file_name 'f'.
endif.
"See if this was a move rather than a copy
check pv_move_type = 'M'.
"Remove the node from the SERVER tree -------------------
call method server_tree->delete_subtree
exporting
i_node_key = pv_server_node
exceptions
node_key_not_in_model = 1
others = 2.
if sy-subrc <> 0.
* Implement suitable error handling here
endif.
delete gt_serv_tree where node_key = pv_server_node.
endform.
*&---------------------------------------------------------------------*
*& Form COPY2SERV
*&---------------------------------------------------------------------*
* Copy files from the PC to the SERVER
*----------------------------------------------------------------------*
form copy2serv using pv_pc_node
pv_server_node
pv_move_type.
data: lv_relat_node_key type lvc_nkey,
lv_serv_node type lvc_nkey,
lv_value type lvc_value,
ls_layout type lvc_s_layn,
lv_file_name type string.
"If the SERVER destination is a file, then find the directory that it's in
read table gt_serv_tree into gs_tree with key node_key = pv_server_node.
if gs_tree-filetype = 'f'.
lv_serv_node = gs_tree-parent_node.
else.
lv_serv_node = pv_server_node.
endif.
read table gt_pc_tree into gs_tree with key node_key = pv_pc_node.
check sy-subrc = 0.
"If the PC origin is a directory, then copy all the files inside it
if gs_tree-filetype = 'd'.
loop at gt_pc_tree into gs_tree where parent_node = pv_pc_node.
perform copy2serv using gs_tree-node_key lv_serv_node pv_move_type.
endloop.
exit.
endif.
"Copy the actual file -----------------------------------
clear gv_stop_copy.
perform file2server using pv_pc_node lv_serv_node pv_move_type changing lv_file_name.
check gv_stop_copy is initial.
if gv_overwrite is initial.
"Add the node to the SERVER tree ------------------------
clear ls_tree.
lv_value = lv_file_name.
clear ls_layout.
ls_layout-dragdropid = gv_serv_handle.
call method server_tree->add_node
exporting
i_relat_node_key = lv_serv_node
i_relationship = cl_tree_control_base=>relat_last_child
is_outtab_line = ls_tree
is_node_layout = ls_layout
i_node_text = lv_value
importing
e_new_node_key = lv_relat_node_key
exceptions
relat_node_not_found = 1
node_not_found = 2
others = 3.
if sy-subrc <> 0.
* Implement suitable error handling here
endif.
perform build_my_tree tables gt_serv_tree using lv_serv_node lv_relat_node_key lv_file_name 'f'.
endif.
"See if this was a move rather than a copy
check pv_move_type = 'M'.
"Remove the node from the PC tree -----------------------
call method pc_tree->delete_subtree
exporting
i_node_key = pv_pc_node
exceptions
node_key_not_in_model = 1
others = 2.
if sy-subrc <> 0.
* Implement suitable error handling here
endif.
delete gt_pc_tree where node_key = pv_pc_node.
endform.
*&---------------------------------------------------------------------*
*& Form FILE2SERVER
*&---------------------------------------------------------------------*
* Copy a file to the server
*----------------------------------------------------------------------*
form file2server using pv_pc_node
pv_serv_node
pv_move_type
changing pv_file_name.
data: lv_pc_name type string,
lv_serv_name type string,
lv_file_size type i,
lv_len type i,
lv_lines type i,
lt_data type rcgrepfile occurs 0 with header line.
g_node_key = pv_pc_node.
clear lv_pc_name.
do.
read table gt_pc_tree into gs_tree with key node_key = g_node_key.
if gs_tree-filetype = 'f'.
pv_file_name = gs_tree-name.
endif.
perform build_path using gs_tree-name gv_pctype abap_true changing lv_pc_name.
g_node_key = gs_tree-parent_node.
if g_node_key is initial.
exit.
endif.
enddo.
g_node_key = pv_serv_node.
clear lv_serv_name.
do.
read table gt_serv_tree into gs_tree with key node_key = g_node_key.
perform build_path using gs_tree-name gv_servtype abap_false changing lv_serv_name.
g_node_key = gs_tree-parent_node.
if g_node_key is initial.
exit.
endif.
enddo.
concatenate lv_serv_name pv_file_name into lv_serv_name.
clear: gv_stop_copy, gv_overwrite.
"Check if the file already exists on the server
if gv_answer is initial.
open dataset lv_serv_name for input in binary mode.
if sy-subrc = 0.
call function 'POPUP_TO_CONFIRM'
exporting
titlebar = 'File already exists'
text_question = lv_serv_name
text_button_1 = 'Overwrite'
text_button_2 = 'Overwrite ALL'
default_button = '3'
display_cancel_button = 'X'
importing
answer = gv_answer
exceptions
text_not_found = 1
others = 2.
if sy-subrc <> 0.
* Implement suitable error handling here
endif.
"Cancel the file copying
if gv_answer = '3'.
clear gv_answer.
gv_stop_copy = abap_true.
close dataset lv_serv_name.
exit.
endif.
"Copy this file, but ask again next time
if gv_answer = '1'.
clear gv_answer.
gv_overwrite = abap_true.
close dataset lv_serv_name.
endif.
endif.
endif.
if gv_answer is not initial.
gv_overwrite = abap_true.
endif.
check gv_stop_copy is initial.
call function 'C13Z_UPLOAD'
exporting
filename = lv_pc_name
filetype = 'BIN'
importing
filelength = lv_file_size
tables
data_tab = lt_data
exceptions
conversion_error = 1
file_open_error = 2
file_read_error = 3
invalid_type = 4
no_batch = 5
unknown_error = 6
invalid_table_width = 7
gui_refuse_filetransfer = 8
customer_error = 9
no_authority = 10
bad_data_format = 11
header_not_allowed = 12
separator_not_allowed = 13
header_too_long = 14
unknown_dp_error = 15
access_denied = 16
dp_out_of_memory = 17
disk_full = 18
dp_timeout = 19
not_supported_by_gui = 20
error_no_gui = 21
others = 22.
if sy-subrc <> 0.
message e000(38) with 'Unable to upload the file'.
gv_stop_copy = abap_true.
exit.
endif.
open dataset lv_serv_name for output in binary mode.
if sy-subrc <> 0.
message e000(38) with 'Cannot open file on server'.
gv_stop_copy = abap_true.
exit.
endif.
describe table lt_data lines lv_lines.
lv_len = 2550.
loop at lt_data.
"Special handling for the last line
if sy-tabix = lv_lines.
lv_len = lv_file_size - ( 2550 * ( lv_lines - 1 ) ).
endif.
transfer lt_data to lv_serv_name length lv_len.
endloop.
close dataset lv_serv_name.
"If we're moving the file, then delete the original
check pv_move_type = 'M'.
call method cl_gui_frontend_services=>file_delete
exporting
filename = lv_pc_name
changing
rc = lv_len
exceptions
file_delete_failed = 1
cntl_error = 2
error_no_gui = 3
file_not_found = 4
access_denied = 5
unknown_error = 6
not_supported_by_gui = 7
wrong_parameter = 8
others = 9.
if sy-subrc <> 0.
* Implement suitable error handling here
endif.
endform.
*&---------------------------------------------------------------------*
*& Form FILE2PC
*&---------------------------------------------------------------------*
* Copy a file to the PC
*----------------------------------------------------------------------*
form file2pc using pv_server_node
pv_pc_node
pv_move_type
changing pv_file_name.
data: lv_pc_name type string,
lv_serv_name type string,
lv_file_size type i,
lv_len type i,
lv_lines type i,
lv_result type c,
lt_data type rcgrepfile occurs 0 with header line.
g_node_key = pv_server_node.
clear lv_serv_name.
do.
read table gt_serv_tree into gs_tree with key node_key = g_node_key.
if gs_tree-filetype = 'f'.
pv_file_name = gs_tree-name.
endif.
perform build_path using gs_tree-name gv_servtype abap_true changing lv_serv_name.
g_node_key = gs_tree-parent_node.
if g_node_key is initial.
exit.
endif.
enddo.
g_node_key = pv_pc_node.
clear lv_pc_name.
do.
read table gt_pc_tree into gs_tree with key node_key = g_node_key.
perform build_path using gs_tree-name gv_pctype abap_false changing lv_pc_name.
g_node_key = gs_tree-parent_node.
if g_node_key is initial.
exit.
endif.
enddo.
concatenate lv_pc_name pv_file_name into lv_pc_name.
clear: gv_stop_copy, gv_overwrite.
if gv_answer is initial.
"Check if the file exists on the PC
call method cl_gui_frontend_services=>file_exist
exporting
file = lv_pc_name
receiving
result = lv_result
exceptions
cntl_error = 1
error_no_gui = 2
wrong_parameter = 3
not_supported_by_gui = 4
others = 5.
if sy-subrc <> 0.
* Implement suitable error handling here
endif.
if lv_result = abap_true.
call function 'POPUP_TO_CONFIRM'
exporting
titlebar = 'File already exists'
text_question = lv_serv_name
text_button_1 = 'Overwrite'
text_button_2 = 'Overwrite ALL'
default_button = '3'
display_cancel_button = 'X'
importing
answer = gv_answer
exceptions
text_not_found = 1
others = 2.
if sy-subrc <> 0.
* Implement suitable error handling here
endif.
if gv_answer = '3'.
clear gv_answer.
gv_stop_copy = abap_true.
exit.
endif.
if gv_answer = '1'.
clear gv_answer.
gv_overwrite = abap_true.
endif.
endif.
endif.
if gv_answer is not initial.
gv_overwrite = abap_true.
endif.
check gv_stop_copy is initial.
"Copy the file
data: mtext type string.
open dataset lv_serv_name for input in binary mode message mtext.
if sy-subrc <> 0.
message e000(38) with 'Cannot open file on server'.
wait up to 3 seconds.
gv_stop_copy = abap_true.
exit.
endif.
do.
clear lv_len.
clear lt_data.
read dataset lv_serv_name into lt_data-orblk length lv_len.
if sy-subrc <> 0.
if lv_len > 0.
lv_file_size = lv_file_size + lv_len.
append lt_data.
endif.
exit.
endif.
lv_file_size = lv_file_size + lv_len.
append lt_data.
enddo.
close dataset lv_serv_name.
call function 'C13Z_DOWNLOAD'
exporting
bin_filesize = lv_file_size
filename = lv_pc_name
filetype = 'BIN'
importing
filelength = lv_len
tables
data_tab = lt_data
exceptions
file_open_error = 1
file_write_error = 2
invalid_filesize = 3
invalid_type = 4
no_batch = 5
unknown_error = 6
invalid_table_width = 7
gui_refuse_filetransfer = 8
customer_error = 9
no_authority = 10
header_not_allowed = 11
separator_not_allowed = 12
header_too_long = 13
dp_error_create = 14
dp_error_send = 15
dp_error_write = 16
unknown_dp_error = 17
access_denied = 18
dp_out_of_memory = 19
disk_full = 20
dp_timeout = 21
file_not_found = 22
dataprovider_exception = 23
control_flush_error = 24
not_supported_by_gui = 25
error_no_gui = 26
others = 27.
if sy-subrc <> 0.
message e000(38) with 'Unable to download the file'.
gv_stop_copy = abap_true.
exit.
endif.
"If this was a MOVE, then delete the original file
check pv_move_type = 'M'.
delete dataset lv_serv_name.
endform.
*&---------------------------------------------------------------------*
*& Form MATCH_MASK
*&---------------------------------------------------------------------*
* See if a given filename matches the selection screen mask
*----------------------------------------------------------------------*
form match_mask using pv_filename
changing pv_matched.
data: lv_mask type string,
lv_reg type string,
moff type i,
mlen type i.
pv_matched = abap_true.
check p_mask is not initial.
lv_mask = p_mask.
clear lv_reg.
while lv_mask is not initial.
if lv_mask(1) = '*'.
concatenate lv_reg '.{0,200}' into lv_reg. "Match anything from 0 to 200 chars
else.
if lv_mask(1) = '.'.
"Escape the "." so that it matches exactly rather than generically
concatenate lv_reg '\' lv_mask(1) into lv_reg.
else.
concatenate lv_reg lv_mask(1) into lv_reg. "Match this exact char
endif.
endif.
shift lv_mask left.
endwhile.
find regex lv_reg in pv_filename match offset moff match length mlen.
if sy-subrc <> 0.
pv_matched = abap_false.
else.
"If we only matched a partial filename, then throw it away
if mlen < strlen( pv_filename ).
pv_matched = abap_false.
endif.
endif.
endform.
Saturday, November 18, 2017
Transferring data between SAP systems - improved version
Sometimes you find the need to transfer the data from a table in one client to another client or another system. E.g. when you've built a Z table and you've copied production down to the test environment or you might want to keep a copy of the table's contents before you make some change in case you mess things up and want to restore back to the old copy.
The program below will copy the data down to a text or binary file and will then read that file to reload the table again. Obviously there are a few caveats;
- Table structures between the two systems must be completely identical.
- Default parameters for things like date formats need to be identical between the two systems.
The program has been left with a deliberate compile bug in it at the point where you should put some kind of appropriate authorization check in place to prevent people from uploading junk into your system.
This is an improvement of a previous program I wrote as this one will handle GUIDs and text in foreign languages as well provided you use the binary format.
It's possible to limit the data that gets downloaded by using the Data selection button after you've selected the table and field names. This will dynamically build a new selection screen where you can select values to limit your data selection. You can also automatically split the file at a predefined record count if you're going to be working with really huge files.
When you're uploading you can decide if you want to skip existing records with the same key fields or simply overwrite them.
*&---------------------------------------------------------------------*
*& Report ZZDATA_TRANSFER
*&---------------------------------------------------------------------*
*& Use this program to transfer data between systems.
*& If you have data like unicode text that might get scrambled then
*& use binary mode to transfer the data.
*& Mark Langenhoven 2014 - 2017
*&---------------------------------------------------------------------*
report zzdata_transfer.
*--- Data declarations ------------------------------------------------
tables: dd03l.
type-pools:rsds.
data: begin of finalrec,
fieldname like dd03l-fieldname,
desc like dd04t-ddtext,
end of finalrec.
data: it_final like finalrec occurs 0 with header line,
lt_dd03l like dd03l occurs 0 with header line,
ls_dd03l like dd03l,
ls_dd04t like dd04t,
it_return like ddshretval occurs 0 with header line.
data: gv_where type rsds_twhere.
*--- Selection screen -------------------------------------------------
"Up or down direction
selection-screen begin of block dir with frame title dir.
selection-screen begin of line.
parameters p_down radiobutton group grp1 default 'X' user-command dib.
selection-screen comment 3(30) pdown.
selection-screen end of line.
selection-screen begin of line.
parameters p_up radiobutton group grp1.
selection-screen comment 3(30) pup.
selection-screen end of line.
selection-screen end of block dir.
"ASCII or Binary file type
selection-screen begin of block typ with frame title typ.
selection-screen begin of line.
parameters p_asc radiobutton group grp2 default 'X' user-command asc.
selection-screen comment 3(15) pasc.
selection-screen end of line.
selection-screen begin of line.
parameters p_bin radiobutton group grp2.
selection-screen comment 3(15) pbin.
selection-screen end of line.
selection-screen end of block typ.
"File name
selection-screen begin of block fil with frame title fil.
selection-screen begin of line.
selection-screen comment 1(15) pfile.
parameters p_file like rlgrap-filename.
selection-screen end of line.
"Add a header line to the output
selection-screen begin of line.
parameters p_head as checkbox default 'X'.
selection-screen comment 3(20) phead.
selection-screen end of line.
"Split file at NNN number of records
selection-screen begin of line.
selection-screen comment 1(25) pbrk.
parameters p_brk type i default '50000'.
selection-screen end of line.
selection-screen end of block fil.
"Table and field names
selection-screen begin of block tab with frame title tab.
selection-screen begin of line.
selection-screen comment 1(18) ptab.
parameters p_tab like dd03l-tabname.
selection-screen end of line.
selection-screen begin of line.
selection-screen comment 1(15) pfield.
select-options: s_field for dd03l-fieldname no intervals.
selection-screen end of line.
selection-screen: pushbutton 1(18) p_btn user-command clk.
selection-screen end of block tab.
"Skip or overwrite uploaded data
selection-screen begin of block upd with frame title upd.
selection-screen begin of line.
parameters p_skip radiobutton group upg default 'X'.
selection-screen comment 3(28) pskip.
selection-screen end of line.
selection-screen begin of line.
parameters p_over radiobutton group upg.
selection-screen comment 3(28) pover.
selection-screen end of line.
selection-screen end of block upd.
initialization.
pdown = 'Transfer data down to a file'.
pup = 'Transfer data up from a file'.
pasc = 'ASCII text file'.
pbin = 'Binary file'.
pfile = 'File name'.
ptab = 'Table name'.
pfield = 'Field selection'.
p_btn = 'Data selection'.
pskip = 'Skip existing records'.
pover = 'Overwrite existing records'.
pbrk = 'Break files into records'.
phead = 'Header line'.
dir = 'Direction'.
typ = 'File type'.
fil = 'File information'.
tab = 'Table information'.
upd = 'Update method'.
"Grab any fieldnames the user wants to select by
at selection-screen on value-request for s_field-low.
"Build a custom search help because the dropdown on dd03l is terrible
refresh it_final.
select tabname fieldname keyflag rollname from dd03l
into corresponding fields of table lt_dd03l
where tabname = p_tab
order by position.
"Ignore includes
delete lt_dd03l where fieldname cs '.INCL'.
loop at lt_dd03l.
clear it_final.
it_final-fieldname = lt_dd03l-fieldname.
select single ddtext from dd04t into it_final-desc
where rollname = lt_dd03l-rollname
and ddlanguage = sy-langu.
append it_final.
endloop.
call function 'F4IF_INT_TABLE_VALUE_REQUEST'
exporting
retfield = 'FIELDNAME'
value_org = 'S'
tables
value_tab = it_final
return_tab = it_return
exceptions
parameter_error = 1
no_values_found = 2
others = 3.
if sy-subrc <> 0.
* Implement suitable error handling here
endif.
loop at it_return.
s_field-low = it_return-fieldval.
s_field-sign = 'I'.
s_field-option = 'EQ'.
append s_field.
endloop.
sort s_field.
delete adjacent duplicates from s_field.
at selection-screen on value-request for p_file.
"Pop up a file selector for the user to choose a file
data: objfile type ref to cl_gui_frontend_services.
data: lv_rc type i,
ls_files type line of filetable,
lt_files type filetable.
check sy-batch is initial.
create object objfile.
call method cl_gui_frontend_services=>file_open_dialog
exporting
window_title = 'Select file'
default_extension = 'TXT'
changing
file_table = lt_files
rc = lv_rc
exceptions
file_open_dialog_failed = 1
cntl_error = 2
error_no_gui = 3
not_supported_by_gui = 4
others = 5.
check sy-subrc = 0.
read table lt_files into ls_files index 1.
check sy-subrc = 0.
p_file = ls_files-filename.
at selection-screen.
if sy-ucomm = 'CLK'.
if s_field[] is initial.
message s000(38) with 'Select fields first'.
exit.
endif.
perform restrict_data.
endif.
"Check if everything is filled prior to running
if sy-ucomm = 'ONLI'.
if p_file is initial.
message e000(38) with 'Supply the filename'.
exit.
endif.
if p_tab is initial.
message e000(38) with 'Supply the table name'.
exit.
endif.
select single * from dd03l into ls_dd03l
where tabname = p_tab.
if sy-subrc <> 0.
message e000(38) with 'Invalid table name' p_tab.
exit.
endif.
endif.
at selection-screen output.
if p_up = abap_true.
"Show the upload parameters
loop at screen.
if screen-name cs 'OVER' or
screen-name cs 'SKIP'.
screen-invisible = 0.
modify screen.
endif.
if screen-name cs 'BTN' or
screen-name cs 'FIELD' or
screen-name cs 'BRK'.
screen-invisible = 1.
screen-input = 0.
modify screen.
endif.
endloop.
else.
"Hide the upload parameters
loop at screen.
if screen-name cs 'OVER' or
screen-name cs 'SKIP'.
screen-invisible = 1.
modify screen.
endif.
if screen-name cs 'BTN' or
screen-name cs 'FIELD' or
screen-name cs 'BRK'.
screen-invisible = 0.
modify screen.
endif.
endloop.
endif.
"No header record allowed on binary files
if p_bin = abap_true.
loop at screen.
if screen-name cs 'HEAD'.
screen-active = 0.
modify screen.
endif.
endloop.
endif.
"Needed because SAP messes around with our stuff after the fact
sort s_field.
delete adjacent duplicates from s_field.
*=== Main program =====================================================
start-of-selection.
if p_down = abap_true.
perform download.
else.
if p_tab(1) <> 'Z'.
message e000(38) with 'Only Z tables are allowed'.
exit.
endif.
Build your authorization check here.
perform upload.
endif.
*&---------------------------------------------------------------------*
*& Form RESTRICT_DATA
*&---------------------------------------------------------------------*
* Use the user's selection to restrict which data will be downloaded
*----------------------------------------------------------------------*
form restrict_data.
data: lv_title like sy-title,
lv_expr type rsds_texpr,
lt_tables like rsdstabs occurs 0 with header line,
lt_fields like rsdsfields occurs 0 with header line,
lv_selid like rsdynsel-selid,
lv_actnum like sy-tfill.
refresh: lt_tables, lt_fields.
clear: gv_where.
lt_tables-prim_tab = p_tab.
append lt_tables.
loop at s_field.
lt_fields-tablename = p_tab.
lt_fields-fieldname = s_field-low.
append lt_fields.
endloop.
call function 'FREE_SELECTIONS_INIT'
exporting
kind = 'T'
expressions = lv_expr
importing
selection_id = lv_selid
number_of_active_fields = lv_actnum
tables
tables_tab = lt_tables
fields_tab = lt_fields
exceptions
fields_incomplete = 1
fields_no_join = 2
field_not_found = 3
no_tables = 4
table_not_found = 5
expression_not_supported = 6
incorrect_expression = 7
illegal_kind = 8
area_not_found = 9
inconsistent_area = 10
kind_f_no_fields_left = 11
kind_f_no_fields = 12
too_many_fields = 13
dup_field = 14
field_no_type = 15
field_ill_type = 16
dup_event_field = 17
node_not_in_ldb = 18
area_no_field = 19
others = 20.
if sy-subrc <> 0.
* Implement suitable error handling here
endif.
concatenate 'Restrict data selections for' p_tab into lv_title separated by space.
call function 'FREE_SELECTIONS_DIALOG'
exporting
selection_id = lv_selid
title = lv_title
tree_visible = ' '
importing
where_clauses = gv_where
number_of_active_fields = lv_actnum
tables
fields_tab = lt_fields
exceptions
internal_error = 1
no_action = 2
selid_not_found = 3
illegal_status = 4
others = 5.
if sy-subrc <> 0.
clear: gv_where.
endif.
endform.
*&---------------------------------------------------------------------*
*& Form DOWNLOAD
*&---------------------------------------------------------------------*
* Download data to a file
*----------------------------------------------------------------------*
form download.
data: lv_file type string,
lv_ftype type char10,
lv_sep type char01.
data: ls_where type rsds_where,
lt_wheretab type rsds_where_tab,
ls_wheretab type rsdswhere,
lv_where type string.
data: begin of namerec,
fieldname like dd03l-fieldname,
end of namerec.
data: lt_dyntab type ref to data,
lt_dyntab2 type ref to data,
ls_dynwa type ref to data,
lt_cat type table of lvc_s_fcat,
lt_fields like dd03l occurs 0 with header line,
lt_fieldnames like namerec occurs 0 with header line,
wa_fields like dd03l,
wa_cat type lvc_s_fcat,
lv_cnt type i,
lv_sel type i,
lv_tabix type i,
lv_filecnt(3) type n.
field-symbols: <table> type table,
<load> type table,
<wa>.
select * from dd03l into table lt_fields
where tabname = p_tab.
sort lt_fields by position.
delete lt_fields where fieldname cp '.INCLU*'.
loop at lt_fields into wa_fields.
lv_cnt = lv_cnt + 1.
wa_cat-tabname = p_tab.
wa_cat-fieldname = wa_fields-fieldname.
wa_cat-col_pos = lv_cnt.
wa_cat-inttype = wa_fields-inttype.
wa_cat-datatype = wa_fields-datatype.
wa_cat-intlen = wa_fields-intlen.
wa_cat-seltext = wa_fields-fieldname.
wa_cat-decimals = wa_fields-decimals.
wa_cat-ref_field = wa_fields-fieldname.
wa_cat-ref_table = p_tab.
append wa_cat to lt_cat.
clear wa_cat.
endloop.
call method cl_alv_table_create=>create_dynamic_table
exporting
it_fieldcatalog = lt_cat
importing
ep_table = lt_dyntab
exceptions
generate_subpool_dir_full = 1
others = 2.
if sy-subrc <> 0.
message e000(38) with 'Error creating dynamic table'.
exit.
endif.
assign lt_dyntab->* to <table>.
call method cl_alv_table_create=>create_dynamic_table
exporting
it_fieldcatalog = lt_cat
importing
ep_table = lt_dyntab2
exceptions
generate_subpool_dir_full = 1
others = 2.
if sy-subrc <> 0.
message e000(38) with 'Error creating dynamic table'.
exit.
endif.
assign lt_dyntab2->* to <load>.
"Create a work area for us to loop through
create data ls_dynwa like line of <table>.
assign ls_dynwa->* to <wa>.
"Select the actual data to download
if gv_where is not initial.
read table gv_where into ls_where index 1.
lt_wheretab = ls_where-where_tab.
if lt_wheretab[] is not initial.
clear lv_where.
loop at lt_wheretab into ls_wheretab.
concatenate lv_where ls_wheretab-line into lv_where separated by space.
endloop.
select * from (p_tab) into table <table>
where (lv_where).
endif.
else.
select * from (p_tab) into table <table>.
endif.
describe table <table>.
if sy-tfill > 0.
write: / 'Selected ', sy-tfill, 'records'.
else.
write: / 'No data selected'.
exit.
endif.
lv_sel = sy-tfill.
lv_filecnt = 1.
loop at <table> into <wa>.
lv_tabix = sy-tabix.
append <wa> to <load>.
check lv_tabix mod p_brk = 0 or lv_tabix = lv_sel.
if lv_sel > p_brk and p_brk > 0.
perform build_filename using lv_filecnt changing lv_file.
lv_filecnt = lv_filecnt + 1.
else.
lv_file = p_file.
endif.
if p_asc = abap_true.
lv_ftype = 'ASC'.
lv_sep = 'X'.
else.
lv_ftype = 'BIN'.
clear: lv_sep.
endif.
refresh lt_fieldnames.
if p_head = abap_true and p_asc = abap_true.
loop at lt_fields.
lt_fieldnames = lt_fields-fieldname.
append lt_fieldnames.
endloop.
endif.
call function 'GUI_DOWNLOAD'
exporting
filename = lv_file
filetype = lv_ftype
write_field_separator = lv_sep
tables
data_tab = <load>
fieldnames = lt_fieldnames
exceptions
file_write_error = 1
no_batch = 2
gui_refuse_filetransfer = 3
invalid_type = 4
no_authority = 5
unknown_error = 6
header_not_allowed = 7
separator_not_allowed = 8
filesize_not_allowed = 9
header_too_long = 10
dp_error_create = 11
dp_error_send = 12
dp_error_write = 13
unknown_dp_error = 14
access_denied = 15
dp_out_of_memory = 16
disk_full = 17
dp_timeout = 18
file_not_found = 19
dataprovider_exception = 20
control_flush_error = 21
others = 22.
if sy-subrc <> 0.
write: / 'Error creating file', sy-subrc.
else.
write: / 'Downloaded file:', lv_file.
endif.
refresh <load>.
endloop.
endform.
*&---------------------------------------------------------------------*
*& Form UPLOAD
*&---------------------------------------------------------------------*
* Upload the data from a file
*----------------------------------------------------------------------*
form upload.
data: lv_file type string,
lv_ftype type char10,
lv_sep type char01,
lv_rc type i.
data: lt_dyntab type ref to data,
ls_dynwa type ref to data,
ls_dynwa2 type ref to data,
lt_cat type table of lvc_s_fcat,
lt_fields like dd03l occurs 0 with header line,
wa_fields like dd03l,
wa_cat type lvc_s_fcat,
lv_cnt type i,
lv_mandt,
lv_where type string,
lv_tmp type string.
field-symbols: <table> type table,
<wa>,
<field>,
<skip>.
lv_file = p_file.
if p_asc = abap_true.
lv_ftype = 'ASC'.
lv_sep = 'X'.
else.
lv_ftype = 'BIN'.
clear lv_sep.
endif.
select * from dd03l into table lt_fields
where tabname = p_tab.
sort lt_fields by position.
delete lt_fields where fieldname cp '.INCLU*'.
loop at lt_fields into wa_fields.
lv_cnt = lv_cnt + 1.
wa_cat-tabname = p_tab.
wa_cat-fieldname = wa_fields-fieldname.
wa_cat-col_pos = lv_cnt.
wa_cat-inttype = wa_fields-inttype.
wa_cat-datatype = wa_fields-datatype.
wa_cat-intlen = wa_fields-intlen.
wa_cat-seltext = wa_fields-fieldname.
wa_cat-decimals = wa_fields-decimals.
wa_cat-ref_field = wa_fields-fieldname.
wa_cat-ref_table = p_tab.
append wa_cat to lt_cat.
clear wa_cat.
endloop.
call method cl_alv_table_create=>create_dynamic_table
exporting
it_fieldcatalog = lt_cat
importing
ep_table = lt_dyntab
exceptions
generate_subpool_dir_full = 1
others = 2.
if sy-subrc <> 0.
message e000(38) with 'Error creating dynamic table'.
exit.
endif.
assign lt_dyntab->* to <table>.
"Create a work area for us to loop through
create data ls_dynwa like line of <table>.
assign ls_dynwa->* to <wa>.
create data ls_dynwa2 like line of <table>.
assign ls_dynwa2->* to <skip>.
if p_asc = abap_true and p_head = abap_true.
perform remove_header changing lv_file.
endif.
call function 'GUI_UPLOAD'
exporting
filename = lv_file
filetype = lv_ftype
has_field_separator = lv_sep
tables
data_tab = <table>
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
others = 17.
if sy-subrc <> 0.
write: / 'Upload file error', sy-subrc.
exit.
endif.
"Delete the temporary file
if p_asc = abap_true and p_head = abap_true.
call method cl_gui_frontend_services=>file_delete
exporting
filename = lv_file
changing
rc = lv_rc
exceptions
file_delete_failed = 1
cntl_error = 2
error_no_gui = 3
file_not_found = 4
access_denied = 5
unknown_error = 6
not_supported_by_gui = 7
wrong_parameter = 8
others = 9.
if sy-subrc <> 0.
* Implement suitable error handling here
endif.
endif.
read table lt_fields with key fieldname = 'MANDT'.
if sy-subrc = 0.
lv_mandt = abap_true.
else.
lv_mandt = abap_false.
endif.
clear lv_cnt.
loop at <table> into <wa>.
"Map to the current client
if lv_mandt = abap_true.
assign component 'MANDT' of structure <wa> to <field>.
<field> = sy-mandt.
endif.
"See if we want to skip existing records
if p_skip = abap_true.
"Build up a dynamic where clause to select with
clear lv_where.
loop at lt_fields where keyflag = abap_true.
check lt_fields-fieldname <> 'MANDT'.
assign component lt_fields-fieldname of structure <wa> to <field>.
concatenate '''' <field> '''' into lv_tmp.
concatenate lv_where 'AND' lt_fields-fieldname '=' lv_tmp into lv_where separated by space.
endloop.
"Remove the unneeded AND
shift lv_where left by 4 places.
select single * from (p_tab) into <skip>
where (lv_where).
if sy-subrc = 0.
continue.
endif.
endif.
modify (p_tab) from <wa>.
lv_cnt = lv_cnt + 1.
endloop.
commit work.
write: / 'Updated', lv_cnt , 'records'.
endform.
*&---------------------------------------------------------------------*
*& Form BUILD_FILENAME
*&---------------------------------------------------------------------*
* Build up a filename for the file split
*----------------------------------------------------------------------*
form build_filename using pv_cnt
changing pv_file.
data: lv_1 type string,
lv_2 type string.
pv_file = p_file.
split pv_file at '.' into lv_1 lv_2.
concatenate lv_1 pv_cnt '.' lv_2 into pv_file.
endform.
*&---------------------------------------------------------------------*
*& Form REMOVE_HEADER
*&---------------------------------------------------------------------*
* Remove the header record from the file
*----------------------------------------------------------------------*
form remove_header changing pv_file.
data: lt_dummy type table of string,
lt_path type string occurs 0 with header line.
call method cl_gui_frontend_services=>gui_upload
exporting
filename = pv_file
changing
data_tab = lt_dummy
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 <> 0.
* Implement suitable error handling here
endif.
check lt_dummy is not initial.
delete lt_dummy index 1.
split pv_file at '\' into table lt_path.
describe table lt_path.
delete lt_path index sy-tfill.
clear pv_file.
loop at lt_path.
concatenate pv_file '\' lt_path into pv_file.
endloop.
shift pv_file left.
concatenate pv_file '\tempheader.txt' into pv_file.
call method cl_gui_frontend_services=>gui_download
exporting
filename = pv_file
changing
data_tab = lt_dummy
exceptions
file_write_error = 1
no_batch = 2
gui_refuse_filetransfer = 3
invalid_type = 4
no_authority = 5
unknown_error = 6
header_not_allowed = 7
separator_not_allowed = 8
filesize_not_allowed = 9
header_too_long = 10
dp_error_create = 11
dp_error_send = 12
dp_error_write = 13
unknown_dp_error = 14
access_denied = 15
dp_out_of_memory = 16
disk_full = 17
dp_timeout = 18
file_not_found = 19
dataprovider_exception = 20
control_flush_error = 21
not_supported_by_gui = 22
error_no_gui = 23
others = 24.
if sy-subrc <> 0.
* Implement suitable error handling here
endif.
endform.
Subscribe to:
Posts (Atom)
