!============================================================================= ! ! 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