View our Guestbook
Provided as a free service by Delphi.
http://www.sitemeter.com
A copy of the actual .DML is available here, FILE_LIST_LOADER.DML Right click on the link to download it by selecting Save Target As.... It is strongly advised that you do this in preference to cutting it out of this page! The code is shown below:
!=============================================================================
!
! From: The Unofficial GEMBASE Home Page.
! At: https://members.tripod.com/GEMBASE/
!
! Desc: This program has been designed to populate a table with
! information derived from a provided file specification.
! The specification is passed in as two parameters:-
!
! #p_dir The directory specification.
! #p_file The file specification.
!
! At present, the add has been designed to use a virtual table.
! Both the add and the build of the VT are commented out, these
! can be replaced with your own table, or appropriate fields
! used to build the virtual table.
!
!=============================================================================
PROCEDURE_FORM BUILD_FILES_VT ( #p_dir, &
#p_file )
BEGIN_BLOCK INITIALISE
#dir_spec = #p_dir
#file_spec = #p_file
! Decide which file system we must deal with.
!
IF ( %UNIX )
#operating_system = "UNIX"
ELSE
IF ( %OPERATING_SYSTEM = "OPENVMS" )
#operating_system = "OPENVMS"
ELSE
#operating_system = "MICROSERF"
END_IF
END_IF
! Build the virtual table to store the matching files.
!
PERFORM CREATE_FILES_VT
END_BLOCK
BEGIN_BLOCK PROCESSING
! Retrieve the list of files.
!
PERFORM GET_ALL_FILES
! Store the return status.
!
#status = %STATUS
END_BLOCK
BEGIN_BLOCK OTHER_PROCESSING
! Any other processing on the table before returning goes here.
!
END_BLOCK
BEGIN_BLOCK RETURNS
! Exit with the status from GET_ALL_FILES
!
EXIT( #status )
END_BLOCK
END_FORM
PROCEDURE_FORM GET_ALL_FILES
BEGIN_BLOCK STARTUP
#scan_spec = #dir_spec &
& #file_spec
! Clear any previous FIND_FILE criteria.
! Capture any errors and exit if found.
!
BEGIN_SIGNAL_TO_STATUS
#dummy = FIND_FILE( "" )
END_SIGNAL_TO_STATUS
IF ( %STATUS <> %NORMAL ) EXIT( %STATUS )
! Do an initial FIND_FILE
!
BEGIN_SIGNAL_TO_STATUS
#preprocess = FIND_FILE( #scan_spec )
END_SIGNAL_TO_STATUS
IF ( %STATUS <> %NORMAL AND &
#preprocess = "" )
EXIT( %STATUS )
END_IF
END_BLOCK
BEGIN_BLOCK PROCESS_LOOP
! In the while loop, we break up the filename, then carry out
! any special processing to arrive at the file type, finally
! write to the table and retrieve the next file name.
!
WHILE ( #preprocess <> "" )
PERFORM PARSE_FILENAME( #preprocess, &
#r_device, &
#r_dir, &
#r_file, &
#r_ext, &
#r_vers )
PERFORM SPECIAL_CHECKS ( #r_device, &
#r_dir, &
#r_file, &
#r_ext, &
#r_vers, &
#r_type )
PERFORM ADD_FILE_RECORD ( #r_device, &
#r_dir, &
#r_file, &
#r_ext, &
#r_vers, &
#r_type )
BEGIN_SIGNAL_TO_STATUS
#preprocess = FIND_FILE( #scan_spec )
END_SIGNAL_TO_STATUS
END_WHILE
END_BLOCK
END_FORM
PROCEDURE_FORM PARSE_FILENAME ( #filename, &
#r_device, &
#r_dir, &
#r_file, &
#r_ext, &
#r_vers )
BEGIN_BLOCK DISMANTLE_FILE_SPEC
! This is the difficult bit, the string handling is different for
! each file system and the work to get all the details is slightly
! complex. This must be tackled based on several criteria to handle
! all possible results. The result is a long form containing lengthy
! blocks to handle each section of the full filename for each
! operating system.
!
END_BLOCK
BEGIN_BLOCK DEVICE
#separator_pos = 0
BEGIN_CASE ( #operating_system )
CASE "UNIX"
! On UNIX systems, the disks/devices appear as the first part of the
! directory name, for example "/disk1".
!
#separator_pos = POS( #filename, "/", 2 )
#r_device = LEFT( #filename, #separator_pos )
CASE "OPENVMS"
! OpenVMS devices are more complex, not all cases are handled here.
! The device is taken as all text before the last ":", since
! the full file specification can contain node, username, and password
! information, any ocurrence of "::" is skipped and the node name etc
! is included in the device spec.
!
#pointer = 1
#separator_pos = POS( #filename, ":", #pointer )
WHILE ( POS( #filename, ":", (#separator_pos + 1) ) <> 0 )
#pointer = POS( #filename, &
":", &
(#separator_pos + 1) )
IF ( #pointer <> 0 )
#separator_pos = #pointer
END_IF
END_WHILE
#r_device = LEFT( #filename, #separator_pos )
CASE "MICROSERF"
! For PC-based systems running one of Microserf's operating
! systems, the device is usually followed by a ":". However
! on a network, shares can be directly referenced by having
! a "\\" as the first two characters. In this case, the
! device is taken to be the machine name. If the current
! path has been specified, then the device may be returned
! as ".\"
!
#separator_pos = POS( #filename, ":", 1 )
IF ( #separator_pos <> 0 )
#r_device = LEFT( #filename, #separator_pos )
ELSE
IF ( LEFT( #filename, 2 ) = "\\" )
#separator_pos = POS( #filename, "\", 3 )
#r_device = LEFT( #filename, #separator_pos )
ELSE
#separator_pos = POS( #filename, "\", 1 )
#r_device = LEFT( #filename, #separator_pos )
END_IF
END_IF
END_CASE
END_BLOCK
BEGIN_BLOCK DIRECTORY
BEGIN_CASE ( #operating_system )
CASE "UNIX"
! For UNIX, the directory is everything from after the
! first "/", up to and including the last "/", if there
! is no directory then it must be set to blank.
!
#pointer = #separator_pos
#dir_endpos = #separator_pos
#pointer = POS( #filename, "/", (#pointer + 1) )
WHILE ( #pointer <> 0 )
#dir_endpos = #pointer
#pointer = POS( #filename, "/", (#pointer + 1) )
END_WHILE
#dir_len = #dir_endpos &
- #separator_pos
#r_dir = MID( #filename, (#separator_pos + 1), #dir_len )
CASE "OPENVMS"
! For VMS directories, the directory can be contained in
! sections from translated rooted logicals. Each directory
! level is separated by a ".". The sections are enclosed in
! "[" & "]" or "<" & ">". The returned structure should
! have all of the enclosing characters removed.
!
#pointer = #separator_pos + 2
#r_dir = ""
! The first close (either ">" or "]") must be found.
!
#pointer_gt = POS( #filename, ">", #pointer )
#pointer_sb = POS( #filename, "]", #pointer )
! Check for none - it might be a tape device.
!
IF ( #pointer_gt = 0 AND &
#pointer_sb = 0 )
! Decrease the pointer.
!
#pointer = #pointer - 1
END_IF
! Set the separator position to first closing character
! or zero.
!
IF ( #pointer_gt <> 0 AND &
#pointer_gt < #pointer_sb )
#separator_pos = #pointer_gt
ELSE
#separator_pos = #pointer_sb
END_IF
! This while loop builds the directory name without any
! of the "<", ">", "[", or "]" characters.
!
WHILE( #separator_pos <> 0 )
#length = #pointer &
- #separator_pos
#r_dir = #r_dir &
& MID( #filename, #pointer, #length )
#pointer = #separator_pos + 2
#pointer_gt = POS( #filename, ">", #pointer )
#pointer_sb = POS( #filename, "]", #pointer )
IF ( #pointer_gt <> 0 AND &
#pointer_gt < #pointer_sb )
#separator_pos = #pointer_gt
ELSE
#separator_pos = #pointer_sb
END_IF
END_WHILE
! The end pointer must be moved back by 1 character to match all
! other cases where it points to the last character of the
! directory name.
!
#dir_endpos = #pointer - 1
CASE "MICROSERF"
! Microserf operating systems are as per UNIX, but the
! "/" is replaced with "\"
!
! "For UNIX, the directory is everything from after the
! first "/", up to and including the last "/", if there
! is no directory then it must be set to blank."
!
#pointer = #separator_pos
#dir_endpos = #separator_pos
#pointer = POS( #filename, "\", (#pointer + 1) )
WHILE ( #pointer <> 0 )
#dir_endpos = #pointer
#pointer = POS( #filename, "\", (#pointer + 1) )
END_WHILE
#dir_len = #dir_endpos &
- #separator_pos
#r_dir = MID( #filename, (#separator_pos + 1), #dir_len )
END_CASE
END_BLOCK
BEGIN_BLOCK FILE_NAME
#temp = RIGHT( #filename, (#dir_endpos + 1) )
! For OPENVMS, we strip off the version number.
!
IF ( #operating_system = "OPENVMS" )
#pointer = POS( #temp, ";", 1 )
#temp = LEFT( #temp, (#pointer - 1) )
END_IF
#r_file = #temp
END_BLOCK
BEGIN_BLOCK EXTENSION
#r_ext = ""
#pointer = POS( #r_file, ".", 1 )
IF ( #pointer <> 0 )
#r_ext = RIGHT( #r_file, (#pointer + 1) )
END_IF
END_BLOCK
BEGIN_BLOCK VERSION
! On OPENVMS, the version number will be present, for non-VMS systems, or in the
! event it cannot be retrieved, we assume version 0. If special file naming
! conventions are in use (e.g. on NT storing the version number within the extension)
! then the special handling should be put here.
!
#r_vers = 0.0
IF ( #operating_system = "OPENVMS" )
#pointer = POS( #filename, ";", 1 )
IF ( #pointer <> 0 )
#r_vers = 1.0 &
* RIGHT( #filename, (#pointer + 1) )
END_IF
END_IF
END_BLOCK
END_FORM
PROCEDURE_FORM SPECIAL_CHECKS ( #p_device, &
#p_dir, &
#p_file, &
#p_ext, &
#p_vers, &
#r_type )
BEGIN_BLOCK FILE_TYPE_CHECKS_OS
! This form is to be used for any special file handling checks, this
! can be dependent on pperating system, or on extension (useful for
! DML and LIS files!). At present, the only included check is for DIR
! extensions under VMS - These are directories.
!
#r_type = 0
BEGIN_CASE ( #operating_system )
CASE "OPENVMS"
IF ( UPPERCASE( #p_ext ) = "DIR" ) #r_type = 1
END_CASE
END_BLOCK
BEGIN_BLOCK FILE_TYPE_CHECKS_ALL
END_BLOCK
END_FORM
PROCEDURE_FORM ADD_FILE_RECORD ( #p_device, &
#p_dir, &
#p_file, &
#p_ext, &
#p_vers, &
#p_type )
! This is all commented out as the virtual table needs set up.
! It can be removed and replaced with a more appropriate add
! routine if required.
!
!BEGIN_BLOCK ADD_RECORD
!
! CLEAR_BUFFER CCL_FILES_LIST_VT
!
! CCL_FILES_LIST_VT(DEVICE) = #p_device
! CCL_FILES_LIST_VT(DIR_PATH) = #p_dir
! CCL_FILES_LIST_VT(FILE_FULLNAME) = #p_file
! CCL_FILES_LIST_VT(FILE_EXTENSION) = #p_ext
! CCL_FILES_LIST_VT(FILE_VERSION) = #p_vers
! CCL_FILES_LIST_VT(ENTRY_TYPE) = #p_type
!
! ADD TO CCL_FILES_LIST_VT
!END_BLOCK
END_FORM
PROCEDURE_FORM CREATE_FILES_VT
! Dummied out as the VT still needs set up using correct BASED_ON fields, this
! is dependent on your database. Alternatively, you can remove this form and
! write to an existing table in your database.
!
!BEGIN_BLOCK ZAP_OLD
! IF ( TABLE_CHECK( "CCL_FILES_LIST_VT", "" ) = %NORMAL )
! DELETE TABLE CCL_FILES_LIST_VT
! END_IF
!END_BLOCK
!
!BEGIN_BLOCK CREATE_FRESH
! ! This virtual table will contain the broken down file specification for
! ! each file matching the given input criteria.
! !
! ! DEVICE The drive or rooted logical (VMS only) on which the files
! ! exist.
! ! DIR_PATH The directory path to the file, this deals with situations
! ! where several directories are specified, or a tree search
! ! is requested.
! ! FILE_FULLNAME The complete file name stripped of any locating information.
! ! FILE_EXTENSION The extension of the file.
! ! FILE_VERSION The file version number (currently only on VMS).
! ! ENTRY_TYPE The entry type for the record. This can be as follows:-
! ! 0 : File entry.
! ! 1 : Directory entry.
! ADD TABLE CCL_FILES_LIST_VT &
! /VIRTUAL &
! /ADD_FIELD = DEVICE &
! /ADD_FIELD = DIR_PATH &
! /ADD_FIELD = FILE_FULLNAME &
! /ADD_FIELD = FILE_EXTENSION &
! /ADD_FIELD = FILE_VERSION &
! /ADD_FIELD = ENTRY_TYPE
!END_BLOCK
END_FORM
!=============================================================================
!
! Code Sample, From "The Unofficial GEMBASE Home Page".
! http://members.tripop.com/GEMBASE/
!
! This code sample can be placed at the bottom of any program to prevent
! it from being loaded into the Forms Editor.
!=============================================================================
!
PROCEDURE_FORM FED_BLOCK
BEGIN_BLOCK STOP_1
OUTPUT_BLOCK STOP_2 /ROW=1 /COL=1 &
/SOURCE = "By using two output blocks inside one BEGIN_BLOCK/END_BLOCK construct"
OUTPUT_BLOCK STOP_3 /ROW=1 /COL=1 &
/SOURCE = "The forms editor is blocked from opening the program"
END_BLOCK
END_FORM
When developing in Gembase, personal preferences will dictate which editor you use, on VMS systems the supplied editors are pretty good, we advise setting the cursor to be bound to the flow of the text, and ensuring the initial indentation of code is done with tabs. For developing on the PC, we recommend P.F.E. (Programmer's File Editor). This has been developed at Lancaster University's Computer Centre by Alan Phillips. It can be downloaded from http://www.lancs.ac.uk/people/cpaap/pfe It is free software, but please read the terms of use. For those of you developing on UNIX - get something better than vi!
Please note that this site is currently under development! Development was started on the 24th of February 1999, and will be an ongoing process. Check back regularly for updates to this site.
|
Sign our Guestbook. View our Guestbook |
Make your contribution on our Forum Provided as a free service by Delphi. |
View our site statistics http://www.sitemeter.com |
This page last updated on 3rd April 1999.