Source Code Listing
*----------------------------------------------------------------------*
* Report: ZDIRLIST *
* Author: Kevin Barter *
*----------------------------------------------------------------------*
* Function : Use only SAP supplied functions/commands to display *
* : a file selection box under UNIX. The subroutines are *
* : self contained, and this can be made into an include *
* : module, or into a Function (better idea). *
*----------------------------------------------------------------------*
REPORT zdirlist.
DATA:
mc_filename LIKE rlgrap-filename,
mi_choice TYPE i,
mc_dirname LIKE epsf-epsdirnam,
mc_filesiz LIKE epsf-epsfilsiz,
mtab_dirlist LIKE w3html OCCURS 0 WITH HEADER LINE,
mtab_files LIKE w3html OCCURS 0 WITH HEADER LINE.
PARAMETERS:
p_filenm LIKE rlgrap-filename.
START-OF-SELECTION.
PERFORM get_filename USING p_filenm
CHANGING mc_filename.
END-OF-SELECTION.
WRITE: / 'You chose the file: ' INTENSIFIED OFF,
mc_filename COLOR COL_NORMAL.
*---------------------------------------------------------------------*
* FORM GET_FILENAME *
*---------------------------------------------------------------------*
* Form that can be called from other programs (or made into a *
* Function). All parameters required to return a filename are *
* passed to this subroutine. *
*---------------------------------------------------------------------*
* --> VALUE(F_DIRNAME) value is used here in case a constant is *
* passed into the routine. *
* --> F_FILENAME *
*---------------------------------------------------------------------*
FORM get_filename USING value(f_dirname) LIKE rlgrap-filename
CHANGING f_filename.
DATA:
*-- Internal table to hold directory entries
ltab_dir LIKE w3html OCCURS 0 WITH HEADER LINE,
*-- Flag to indicate if the directory entry is really a directory
lc_directory(1) TYPE c,
*-- filename returned from show_directory (no path info included)
lc_filename LIKE rlgrap-filename.
*-- Make sure directory meets a few basic rules
PERFORM check_dirname USING f_dirname
CHANGING f_dirname.
*-- Default to a directory so that the first time it hits the while
*-- loop, it will display the contents of the directory passed in
lc_directory = 'd'.
*-- Until a non directory is chosen, keep displaying the currently
*-- selected directories information
*----------------------------------------------------------------------*
*-- NOTE: As it stands, this program does not handle symbolic links.--*
*----------------------------------------------------------------------*
WHILE lc_directory = 'd'.
*-- Fill internal table with directory information
PERFORM get_directory_listing TABLES ltab_dir
USING f_dirname.
*-- Display the directory info, and allow user to make a selection
PERFORM show_directory TABLES ltab_dir
USING f_dirname
CHANGING lc_filename
lc_directory.
IF lc_directory = 'd'. " A directory
CASE lc_filename.
WHEN '../'. " Go up one directory level
PERFORM remove_last_dir CHANGING f_dirname.
WHEN './'.
*-- Same directory, do not change f_dirbname.
WHEN OTHERS. " Build new directory to display
CONCATENATE f_dirname
lc_filename
INTO f_dirname.
ENDCASE.
ENDIF.
ENDWHILE.
*-- Assign selected file to the changing parameter of this routine
f_filename = lc_filename.
ENDFORM. " GET_FILENAME
*---------------------------------------------------------------------*
* FORM GET_DIRECTORY_LISTING *
*---------------------------------------------------------------------*
* Use SAP functions that do not do security checks to get the *
* directory listing. *
*---------------------------------------------------------------------*
* --> FTAB_DIR *
* <-- F_DIRECTORY *
*---------------------------------------------------------------------*
FORM get_directory_listing TABLES ftab_dir
USING f_directory.
DATA:
ltab_protocol LIKE btcxpm OCCURS 0 WITH HEADER LINE,
lstr_start_request LIKE btcxp1 OCCURS 0 WITH HEADER LINE,
lstr_start_status LIKE btcxp2 OCCURS 0 WITH HEADER LINE,
lstr_termination_status LIKE btcxp3 OCCURS 0 WITH HEADER LINE,
lc_receiver LIKE btcxp1-receiver,
lc_service(8) VALUE 'sapdp',
lc_systemnr(2) TYPE c,
lc_jobname LIKE tbtco-jobname VALUE '_%SXPG:<+:+> '.
CLEAR ftab_dir.
REFRESH ftab_dir.
* Begin of setting defaults for lstr_start_request
CALL FUNCTION 'INIT_START_OF_EXTERNAL_PROGRAM'
IMPORTING
start_request = lstr_start_request.
CALL 'C_SAPGPARAM'
ID 'NAME' FIELD 'SAPSYSTEM'
ID 'VALUE' FIELD lc_systemnr.
IF sy-subrc > 0.
EXIT.
ENDIF.
lc_service+5(2) = lc_systemnr.
* These variables must always have these values
lstr_start_request-dpservice = lc_service.
* Values cannot be blank
lstr_start_request-abapprog = 'SOMENAME'.
lstr_start_request-abapform = 'FORM' .
* These variables can be changed
* Operating System Command
lstr_start_request-program = 'ls'.
* Parameters for the command
CONCATENATE '-lap'
f_directory
INTO lstr_start_request-params SEPARATED BY space.
* Parameters for the command
lstr_start_request-stdincntl = 'R'. " Stdin redirect
lstr_start_request-stdoutcntl = 'M'. " stdout to memory
lstr_start_request-stderrcntl = 'M'. " stderr to memory
lstr_start_request-termcntl = 'C'. " wait for termination
lstr_start_request-conncntl = 'H'.
lstr_start_request-tracecntl = '0'. " Do not trace
* Provide a name for the job
REPLACE '+' WITH 'Wonky' INTO lc_jobname.
REPLACE '+' WITH 'Bill' INTO lc_jobname.
CONDENSE lc_jobname NO-GAPS .
lstr_start_request-jobname = lc_jobname.
lstr_start_request-jobcount = 1 .
* End of setting defaults for lstr_start_request
lc_receiver = sy-host.
* Run the OS Command
CALL FUNCTION 'START_OF_EXTERNAL_PROGRAM'
EXPORTING
start_request = lstr_start_request
targetsystem = lc_receiver
IMPORTING
start_status = lstr_start_status
TABLES
exec_protocol = ltab_protocol
EXCEPTIONS
cpic_allocate_failed = 1 " CPIC_ALLOCATE_FAILED
cpic_init_failed = 2 " CPIC_INIT_FAILED
cpic_rec_stat_failed = 3 " CPIC_REC_STAT_FAILED
cpic_rec_prot_failed = 4 " CPIC_REC_PROT_FAILED
cpic_send_failed = 5 " CPIC_SEND_FAILED
parameter_error = 6 " PARAMETER_ERROR
protocol_missing = 7 " PROTOCOL_MISSING
OTHERS = 8.
* If OS Command completed successfully, then get the results
IF sy-subrc = 0.
CALL FUNCTION 'TERMINAT_OF_EXTERNAL_PROGRAM'
EXPORTING
online = 0
IMPORTING
termination_message = lstr_termination_status
TABLES
exec_protocol = ltab_protocol
EXCEPTIONS
cpic_accept_failed = 1
cpic_rec_prot_failed = 2
cpic_rec_stat_failed = 3
protocol_missing = 4
OTHERS = 5.
ENDIF.
*-- Move the results to the internal table parameter
LOOP AT ltab_protocol.
ftab_dir = ltab_protocol-message.
APPEND ftab_dir.
ENDLOOP.
ENDFORM. " GET_DIRECTORY_LISTING
*---------------------------------------------------------------------*
* FORM SHOW_DIRECTORY *
*---------------------------------------------------------------------*
* ........ *
*---------------------------------------------------------------------*
* --> FTAB_DIR List of directory entries *
* --> F_DIRNAME Name of the current directory (and path) *
* <-- F_FILENAME Filename/Directory chosen by user *
* <-- F_DIRECTORY Indicator if this is a directory (D or space) *
*---------------------------------------------------------------------*
FORM show_directory TABLES ftab_dir
USING f_dirname
CHANGING f_filename
f_directory.
DATA: li_choice TYPE i,
ltab_split LIKE w3html OCCURS 0 WITH HEADER LINE,
*-- Structure of ls -l under HPUX. Other operating systems may be
*-- different
BEGIN OF lstr_dir_list,
attributes(10) TYPE c,
flag(1) TYPE c,
owner(8) TYPE c,
group(8) TYPE c,
size(10) TYPE c,
month(3) TYPE c,
day(2) TYPE c,
year(4) TYPE c,
name(128) TYPE c,
END OF lstr_dir_list.
*-- Show the list and allow user to choose entry
CALL FUNCTION 'POPUP_WITH_TABLE_DISPLAY'
EXPORTING
endpos_col = 100
endpos_row = 20
startpos_col = 2
startpos_row = 2
titletext = f_dirname
IMPORTING
choise = li_choice
TABLES
valuetab = ftab_dir
EXCEPTIONS
break_off = 1
OTHERS = 2.
IF sy-subrc = 0.
*-- Read the line that the user selected
READ TABLE ftab_dir INDEX li_choice.
*-- Split the single line into individual entries
SPLIT ftab_dir AT space INTO TABLE ltab_split.
DELETE ltab_split WHERE line = space.
*-- Assign the individual entries to the proper variable
READ TABLE ltab_split INDEX 1.
lstr_dir_list-attributes = ltab_split.
READ TABLE ltab_split INDEX 2.
lstr_dir_list-flag = ltab_split.
READ TABLE ltab_split INDEX 3.
lstr_dir_list-owner = ltab_split.
READ TABLE ltab_split INDEX 4.
lstr_dir_list-group = ltab_split.
READ TABLE ltab_split INDEX 5.
lstr_dir_list-size = ltab_split.
READ TABLE ltab_split INDEX 6.
lstr_dir_list-month = ltab_split.
READ TABLE ltab_split INDEX 7.
lstr_dir_list-day = ltab_split.
READ TABLE ltab_split INDEX 8.
lstr_dir_list-year = ltab_split.
READ TABLE ltab_split INDEX 9.
lstr_dir_list-name = ltab_split.
f_directory = lstr_dir_list-attributes(1).
f_filename = lstr_dir_list-name.
ELSE.
*-- Non 0 return code, assume error or cancel button pressed
*-- clear return values
f_directory = space.
f_filename = space.
ENDIF.
ENDFORM. " SHOW_DIRECTORY
*---------------------------------------------------------------------*
* FORM REMOVE_LAST_DIR *
*---------------------------------------------------------------------*
* Strip the last directory off of the string passed in *
*---------------------------------------------------------------------*
* <-- VALUE(F_DIRNAME) Fully pathed directory name *
*---------------------------------------------------------------------*
FORM remove_last_dir CHANGING value(f_dirname).
CONSTANTS:
c_slash(1) TYPE c VALUE '/'.
DATA: ltab_split LIKE w3html OCCURS 0 WITH HEADER LINE,
li_rows TYPE i.
SPLIT f_dirname AT c_slash INTO TABLE ltab_split.
DESCRIBE TABLE ltab_split LINES li_rows.
*-- Remove the last directory
DELETE ltab_split INDEX li_rows.
*-- Delete any blank rows
DELETE ltab_split WHERE line = space.
f_dirname = space.
LOOP AT ltab_split.
CONCATENATE f_dirname
ltab_split-line
INTO f_dirname SEPARATED BY c_slash.
ENDLOOP.
*-- Add trailing slash
CONCATENATE f_dirname
c_slash
INTO f_dirname.
ENDFORM. " REMOVE_LAST_DIR
*---------------------------------------------------------------------*
* FORM CHECK_DIRNAME *
*---------------------------------------------------------------------*
* ........ *
*---------------------------------------------------------------------*
* --> VALUE(F_DIRNAME_IN) *
* --> VALUE(F_DIRNAME_OUT) *
*---------------------------------------------------------------------*
FORM check_dirname USING value(f_dirname_in)
CHANGING value(f_dirname_out).
CONSTANTS:
c_slash(1) TYPE c VALUE '/'.
DATA:
lc_char(1) TYPE c,
lc_dirname_in LIKE rlgrap-filename,
li_len TYPE i.
lc_dirname_in = f_dirname_in.
*-- Make sure the directory name starts at root
IF lc_dirname_in(1) NE c_slash.
CONCATENATE c_slash
f_dirname_in
INTO f_dirname_out.
lc_dirname_in = f_dirname_out.
ENDIF.
*-- Make sure the directory name ends in a slash
li_len = strlen( lc_dirname_in ).
li_len = li_len - 1.
lc_char = lc_dirname_in+li_len(1).
IF lc_char NE c_slash.
CONCATENATE lc_dirname_in
c_slash
INTO f_dirname_out.
ENDIF.
ENDFORM. " CHECK_DIRNAME
|
