10 ! ----- DEFAULT_FILESPEC.FUN ----- ! ! ----- FUNCTION TO RETURN A DEFAULT FILESPEC FOR A PASSED STRING ----- ! ! ----- RESTRICTION: DOES NOT HANDLE ROOTED DIRECTORIES ----- ! ! ---------- PASSED: ---------- ! ! ----- PASSED_STRING = FILESPEC TO CREATE DEFAULT FROM ----- ! ! ---------- RETURNED: ---------- ! ! ----- DEFAULT_FILESPEC = DEFAULTED FILE SPECIFICATION, OR BLANK ----- ! ----- IF ANY VMS ERROR STATUS ----- ! ! ----- (DEFAULT DEVICE/DIR OF SINGLE TRANSLATION OF SYS$DISK:) ----- ! ----- (DEFAULT EXTENSION OF .COM) ----- ! ----- (DEFAULT OF NO VERSION) ----- ! ! ----- Last Change 05/01/89 by Brian Lomasky ----- ! ! ----- Teradyne, Inc., 179 Lincoln Street, Boston, MA 02111 ----- ! ----- (617) 482-2706, x3259 ----- ! ! ----- Neither Brian Lomasky nor Teradyne, Inc. implicitly or ----- ! ----- explicitly implies this program is usable in any way. ----- ! ----- This program is released to the public domain in an ----- ! ----- "AS-IS" condition. ----- ! ! ----- Restrictions: ----- ! ----- 1) Requires VAX BASIC V2.4 or later. ----- ! ----- 2) Must be linked with LNMDEF and PSLDEF ----- ! FUNCTION STRING DEFAULT_FILESPEC(STRING PASSED_STRING) OPTION TYPE = EXPLICIT %LET %DEBUG = 0% ! 1 IF DEBUG MODE, 0 IF NOT ! ----- SYSTEM SERVICE ERROR CODES AND FUNCTION VALUES ----- EXTERNAL LONG CONSTANT LNM$_STRING ! RETURN LOGICAL NAME STRING EXTERNAL LONG CONSTANT PSL$C_EXEC ! ONLY TRANSLATE EXEC MODE EXTERNAL LONG CONSTANT SS$_NOLOGNAM ! NO LOGICAL NAME TRANS EXTERNAL LONG CONSTANT SS$_NORMAL ! SUCCESS STATUS RECORD TRNBUF ! $TRNLNM RECORD WORD BUFFER_LENGTH1 WORD ITEM_CODE1 LONG BUFFER_ADDRESS1 LONG RETURN_LENGTH_ADDRESS1 LONG LIST_TERMINATOR END RECORD TRNBUF DECLARE BYTE ACCESS_MODE ! ACCESS MODE FOR $TRNLNM DECLARE WORD COLON_POS ! POSITION OF COLON IN STRING DECLARE STRING FILENAME ! EXTRACTED FILENAME DECLARE STRING FILETYPE ! EXTRACTED FILETYPE DECLARE WORD FIRST_FILENAME_POS ! POS OF FIRST FILENAME CHAR DECLARE WORD FIRST_FILETYPE_POS ! POS OF FIRST FILETYPE CHAR DECLARE WORD FIRST_VERSION_POS ! POS OF FIRST VERSION CHAR DECLARE WORD LAST_FILENAME_POS ! POSITION OF LAST FILENAME CHAR DECLARE WORD LAST_FILETYPE_POS ! POSITION OF LAST FILETYPE CHAR DECLARE WORD LEFT_BRACKET_POS ! POSITION OF LEFT BRACKET DECLARE WORD LOG_LENGTH ! LENGTH OF LOGICAL NAME DECLARE WORD RIGHT_BRACKET_POS ! POSITION OF RIGHT BRACKET DECLARE LONG SYS_STATUS ! SYSTEM STATUS VALUE DECLARE LONG TEMP ! TEMPORARY WORD DECLARE STRING TEMP_STRING ! TEMPORARY STRING DECLARE STRING THE_DEVICE ! EXTRACTED DEVICE SPECIFIER DECLARE STRING THE_DIR ! EXTRACTED DIRECTORY DECLARE TRNBUF TRNITEM ! EQUATE $TRNLNM RECORD DECLARE STRING VERSION ! EXTRACTED VERSION EXTERNAL STRING FUNCTION & CURRENT_DIRECTORY ! RETURN CURRENT DIR AS [xxxx] EXTERNAL LONG FUNCTION & SYS$TRNLNM ! TRANSLATE LOGICAL NAME ! ----- MAPPED VARIABLES FOR $TRNLNM SYSTEM SERVICE ----- MAP (TRNDSC) & STRING LOG_NAME = 255% ! LOGICAL NAME FROM $TRNLNM %IF %DEBUG = 1% %THEN PRINT "DEBUG>PASSED_STRING=*"; PASSED_STRING; "*" %END %IF ACCESS_MODE = PSL$C_EXEC ! ONLY TRANSLATE EXEC MODE ! ----- STORE DATA FOR $TRNLNM --- TRNITEM::BUFFER_LENGTH1 = 255% TRNITEM::ITEM_CODE1 = LNM$_STRING TRNITEM::BUFFER_ADDRESS1 = LOC(LOG_NAME) TRNITEM::RETURN_LENGTH_ADDRESS1 = LOC(LOG_LENGTH) TRNITEM::LIST_TERMINATOR = 0% THE_DIR = "" ! ASSUME NO DIRECTORY SPECIFIER IF LEN(PASSED_STRING) = 0% THEN ! ----- DEFAULT DEVICE, DIRECTORY, FILENAME, ----- ! ----- FILETYPE, AND VERSION ----- THE_DEVICE = "SYS$DISK" FILENAME = "" FILETYPE = ".COM" VERSION = "" ELSE ! ----- EXTRACT DEVICE SPECIFIER ----- COLON_POS = POS(PASSED_STRING, ":", 1%) IF COLON_POS = 0% THEN THE_DEVICE = "SYS$DISK" FIRST_FILENAME_POS = 1% ELSE ! ----- ERROR IF INVALID DEVICE ----- IF COLON_POS = 1% THEN ! ----- RETURN ERROR CONDITION ----- DEFAULT_FILESPEC = "" EXIT FUNCTION END IF THE_DEVICE = LEFT(PASSED_STRING, COLON_POS - 1%) FIRST_FILENAME_POS = COLON_POS + 1% END IF ! ----- EXTRACT DIRECTORY SPECIFIER ----- LEFT_BRACKET_POS = POS(PASSED_STRING, "[", 1%) RIGHT_BRACKET_POS = POS(PASSED_STRING, "]", 1%) ! ----- ERROR IF INVALID DIRECTORY ----- IF LEFT_BRACKET_POS <> 0% THEN IF LEFT_BRACKET_POS < COLON_POS THEN ! ----- RETURN ERROR CONDITION ----- DEFAULT_FILESPEC = "" EXIT FUNCTION END IF IF LEFT_BRACKET_POS + 1% >= RIGHT_BRACKET_POS THEN ! ----- RETURN ERROR CONDITION ----- DEFAULT_FILESPEC = "" EXIT FUNCTION END IF THE_DIR = SEG$(PASSED_STRING, & LEFT_BRACKET_POS, RIGHT_BRACKET_POS) FIRST_FILENAME_POS = RIGHT_BRACKET_POS + 1% ELSE IF RIGHT_BRACKET_POS <> 0% THEN ! ----- RETURN ERROR CONDITION ----- DEFAULT_FILESPEC = "" EXIT FUNCTION END IF END IF ! ----- EXTRACT FILENAME ----- LAST_FILENAME_POS = POS(PASSED_STRING, ".", & FIRST_FILENAME_POS) IF LAST_FILENAME_POS = 0% THEN LAST_FILENAME_POS = POS(PASSED_STRING, & ";", FIRST_FILENAME_POS) IF LAST_FILENAME_POS = 0% THEN LAST_FILENAME_POS = & LEN(PASSED_STRING) + 1% END IF END IF IF LAST_FILENAME_POS <= FIRST_FILENAME_POS THEN FILENAME = "" ELSE FILENAME = SEG$(PASSED_STRING, & FIRST_FILENAME_POS, & LAST_FILENAME_POS - 1%) END IF ! ----- EXTRACT FILETYPE ----- FIRST_FILETYPE_POS = POS(PASSED_STRING, ".", & FIRST_FILENAME_POS) IF FIRST_FILETYPE_POS = 0% THEN FILETYPE = ".COM" ELSE LAST_FILETYPE_POS = POS(PASSED_STRING, & ";", FIRST_FILETYPE_POS) IF LAST_FILETYPE_POS = 0% THEN LAST_FILETYPE_POS = & LEN(PASSED_STRING) + 1% END IF FILETYPE = SEG$(PASSED_STRING, & FIRST_FILETYPE_POS, & LAST_FILETYPE_POS - 1%) END IF ! ----- EXTRACT VERSION ----- FIRST_VERSION_POS = POS(PASSED_STRING, ";", & FIRST_FILENAME_POS) IF FIRST_VERSION_POS = 0% THEN VERSION = "" ELSE VERSION = RIGHT(PASSED_STRING, & FIRST_VERSION_POS) END IF END IF %IF %DEBUG = 1% %THEN PRINT "DEBUG>THE_DEVICE=*"; THE_DEVICE; "*" PRINT "DEBUG>THE_DIR=*"; THE_DIR; "*" PRINT "DEBUG>FILENAME=*"; FILENAME; "*" PRINT "DEBUG>FILETYPE=*"; FILETYPE; "*" PRINT "DEBUG>VERSION=*"; VERSION; "*" %END %IF IF THE_DEVICE = "SYS$DISK" THEN ! ----- TRY TO TRANSLATE SYS$DISK LOGICAL NAME ----- SYS_STATUS = SYS$TRNLNM(, "LNM$PROCESS", & "SYS$DISK", ACCESS_MODE, TRNITEM) %IF %DEBUG = 1% %THEN PRINT "DEBUG>Try to translate SYS$DISK" PRINT "DEBUG>SYS_STATUS from $TRNLNM="; & SYS_STATUS %END %IF ELSE ! ----- TRY TO TRANSLATE THE_DEVICE LOGICAL NAME ----- SYS_STATUS = SYS$TRNLNM(, "LNM$DCL_LOGICAL", & THE_DEVICE, , TRNITEM) %IF %DEBUG = 1% %THEN PRINT "DEBUG>Try to translate "; THE_DEVICE PRINT "DEBUG>SYS_STATUS from $TRNLNM="; & SYS_STATUS %END %IF END IF SELECT SYS_STATUS CASE SS$_NOLOGNAM ! IF NO LOGICAL EQUIVALENT: %IF %DEBUG = 1% %THEN PRINT "DEBUG>SYS_STATUS=SS$_NOLOGNAM" %END %IF DEFAULT_FILESPEC = "" ! RETURN ERROR CONDITION EXIT FUNCTION CASE SS$_NORMAL %IF %DEBUG = 1% %THEN PRINT "DEBUG>SYS_STATUS=SS$_NORMAL" PRINT "DEBUG>LOG_LENGTH="; LOG_LENGTH PRINT "DEBUG>LOG_NAME(1:25)="; & LEFT(LOG_NAME, 25%) %END %IF IF THE_DEVICE = "SYS$DISK" THEN ! ----- EXTRACT LOGICAL NAME ----- IF LOG_LENGTH < 1% THEN ! ----- RETURN ERROR CONDITION ----- DEFAULT_FILESPEC = "" EXIT FUNCTION END IF THE_DEVICE = LEFT(LOG_NAME, LOG_LENGTH) ! ----- SEE IF ANY COLON IN THE DEVICE ----- TEMP = POS(THE_DEVICE, ":", 1%) IF TEMP <> 0% THEN IF TEMP = LEN(THE_DEVICE) THEN THE_DEVICE = LEFT( & LOG_NAME, & LOG_LENGTH - 1%) ! ----- DEFAULT DIRECTORY ----- ! ----- TO CURRENT ----- ! ----- DIRECTORY ----- IF THE_DIR = "" THEN THE_DIR = & CURRENT_DIRECTORY END IF ELSE ! ----- RETURN ERROR ----- ! ----- CONDITION IF ----- ! ----- TWO DIRECTORIES ----- ! ----- WERE SPECIFIED ----- IF THE_DIR <> "" THEN DEFAULT_FILESPEC = "" EXIT FUNCTION END IF END IF ELSE ! ----- DEFAULT DIRECTORY TO ----- ! ----- CURRENT DIRECTORY ----- THE_DIR = CURRENT_DIRECTORY & IF THE_DIR = "" END IF ELSE ! ----- EXTRACT LOGICAL NAME ----- IF LOG_LENGTH < 1% THEN ! ----- RETURN ERROR CONDITION ----- DEFAULT_FILESPEC = "" EXIT FUNCTION END IF TEMP_STRING = LEFT(LOG_NAME, LOG_LENGTH) ! ----- SEE IF ANY COLON IN THE DEVICE ----- TEMP = POS(TEMP_STRING, ":", 1%) IF TEMP <> 0% THEN IF TEMP <> LEN(TEMP_STRING) THEN ! ----- RETURN ERROR ----- ! ----- CONDITION IF ----- ! ----- TWO DIRECTORIES ----- ! ----- WERE SPECIFIED ----- IF THE_DIR <> "" THEN DEFAULT_FILESPEC = "" EXIT FUNCTION END IF ELSE ! ----- DEFAULT DIRECTORY ----- ! ----- TO CURRENT ----- ! ----- DIRECTORY ----- IF THE_DIR = "" THEN THE_DIR = & CURRENT_DIRECTORY END IF END IF END IF END IF CASE ELSE PRINT "Unexpected Error from"; & " DEFAULT_FILESPEC: "; SYS_STATUS ! ----- ABORT PROGRAM DUE TO ERROR ----- CALL LIB$STOP(SYS_STATUS BY VALUE) END SELECT %IF %DEBUG = 1% %THEN PRINT "DEBUG2>THE_DEVICE=*"; THE_DEVICE; "*" PRINT "DEBUG2>THE_DIR=*"; THE_DIR; "*" PRINT "DEBUG2>FILENAME=*"; FILENAME; "*" PRINT "DEBUG2>FILETYPE=*"; FILETYPE; "*" PRINT "DEBUG2>VERSION=*"; VERSION; "*" %END %IF ! ----- RETURN CONCATENATED FIELDS ----- DEFAULT_FILESPEC = THE_DEVICE + ":" + THE_DIR + & FILENAME + FILETYPE + VERSION END FUNCTION