VAUGHAN@CANISIUS.BITNET (Tom Vaughan @ Computer Center) (01/29/88)
Here are three companion routines from the Dec professional, as everyday tools
they are very handy!
enjoy!
..................... Cut between dotted lines and save ......................
$!..............................................................................
$! VAX/VMS archive file created by VMS_SHAR V-5.01 01-Oct-1987
$! which was written by Michael Bednarek (U3369429@ucsvc.dn.mu.oz.au)
$! To unpack, simply save and execute (@) this file.
$!
$! This archive was created by VAUGHAN
$! on Thursday 28-JAN-1988 11:54:21.13
$!
$! It contains the following 3 files:
$! ROOT.COM SD.COM FIND.COM
$!==============================================================================
$ Set Symbol/Scope=(NoLocal,NoGlobal)
$ Version=F$GetSYI("VERSION") ! See what VMS version we have here:
$ If Version.ges."V4.4" then goto Version_OK
$ Write SYS$Output "Sorry, you are running VMS ",Version, -
", but this procedure requires V4.4 or higher."
$ Exit 44
$Version_OK: CR[0,8]=13
$ Pass_or_Failed="failed!,passed."
$ Goto Start
$Convert_File:
$ Read/Time_Out=0/Error=No_Error1/Prompt="creating ''File_is'" SYS$Command ddd
$No_Error1: Define/User_Mode SYS$Output NL:
$ Edit/TPU/NoSection/NoDisplay/Command=SYS$Input/Output='File_is' -
VMS_SHAR_DUMMY.DUMMY
f:=Get_Info(Command_Line,"File_Name");b:=Create_Buffer("",f);
o:=Get_Info(Command_Line,"Output_File");Set(Output_File,b,o);
Position(Beginning_of(b));Loop x:=Erase_Character(1);Loop ExitIf x<>"V";
Move_Vertical(1);x:=Erase_Character(1);Append_Line;
Move_Horizontal(-Current_Offset);EndLoop;Move_Vertical(1);
ExitIf Mark(None)=End_of(b) EndLoop;Position(Beginning_of(b));Loop
x:=Search("`",Forward,Exact);ExitIf x=0;Position(x);Erase_Character(1);
If Current_Character='`' then Move_Horizontal(1);else
Copy_Text(ASCII(INT(Erase_Character(3))));EndIf;EndLoop;Exit;
$ Delete VMS_SHAR_DUMMY.DUMMY;*
$ Checksum 'File_is
$ Success=F$Element(Check_Sum_is.eq.CHECKSUM$CHECKSUM,",",Pass_or_Failed)+CR
$ Read/Time_Out=0/Error=No_Error2/Prompt=" CHECKSUM ''Success'" SYS$Command ddd
$No_Error2: Return
$Start:
$ File_is="ROOT.COM"
$ Check_Sum_is=1699028431
$ Copy SYS$Input VMS_SHAR_DUMMY.DUMMY
X$! Command procedure taken from 'DEC Profesional, Vol. 5, N0. 7. 1986'
X$! by William W. Hastings.
X$! Make the current directory a root directory and define the logical 'P1
X$! to be the associated rooted-device logical name. If no parameter is
X$! specified then "BASE" is used.
X$!
X$ IF P1 .EQS. "" THEN P1 = "BASE"
X$ NAME = F$TRNLNM("SYS$DISK")
X$!
V$ LOOP: !Keep translating until a physical device is found
X.
X$!
X$ NEXT = F$TRNLNM("NAME"-":")
X$ IF NEXT .EQS. "" THEN GOTO CHECK_ROOT
X$ NAME = NEXT
X$ GOTO LOOP
X$!
X$ CHECK_ROOT: !Is the current directory already rooted?
X$!
X$ IF F$LOCATE(".]",NAME) .NE. F$LENGTH(NAME) THEN GOTO ROOTED
X$ NAME = NAME + F$DIRECTORY() - "]" + ".]"
X$!
X$ DEFINE_LOG:
X$!
X$ DEFINE/TRANSLATION_ATTRIBUTES=CONCEALED 'P1 'NAME
X$ EXIT
X$!
X$ ROOTED: !Current default has a rooted logical device.
X$!
X$ DIR_NAME = F$DIRECTORY() - "[" - "]"
X$ IF DIR_NAME .EQS. "000000" THEN GOTO DEF_LOG
X$ NAME = NAME - "]" = DIR_NAME + ".]"
X$ GOTO DEF_LOG
$ GoSub Convert_File
$ File_is="SD.COM"
$ Check_Sum_is=270248012
$ Copy SYS$Input VMS_SHAR_DUMMY.DUMMY
X$! Command procedure taken from 'DEC Profesional, Vol. 5, N0. 7. 1986'
X$! by William W. Hastings.
X$! Change the default device and directory, and also change the DCL prompt
X$! to show the new directory. See further comments at end.
X$!
X$ ESC[0,7] = 27
X$ BOLDON = ESC+"[1m"
X$ UNDERON = ESC+"[4m"
X$ ATTRON = BOLDON+UNDERON
X$ ATTROFF = ESC+"[0m"
X$!
X$ START:
X$!
X$ IF P1 .EQS. "" THEN -
X INQUIRE P1 "Enter new directory specificatons"
X$ OLD_DEFAULT = F$ENVIRONMENT("DEFAULT")
X$ SET DEFAULT 'P1
X$ IF P1 .EQS. "" THEN GOTO NO_DIRECTORY
X$!
X$! Does the new directory exist?
X$!
X$ IF F$PARSE("*.*") .EQS. "" THEN GOTO NO_DIRECTORY
X$!
X$! Now lets check to see if P1 is a logical name.
X$!
X$ IF F$TRNLNM(P1) .NES. "" THEN GOTO LOGICAL_NAME
X$!
X$ FIND_PROMPT: ! Find the new prompt.
X$!
X$ NEW_DEFAULT = F$DIRECTORY()
X$ DIR = NEW_DEFAULT - "[" - "]"
X$!
X$! If the next five commands are deleted, then the DCL prompt would be set
X$! to the new default directory (without the square brackets). This might
X$! be quite long on deeply nested directories.
X$!
X$ LAST_DIR == OLD_DEFAULT
X$ IF F$LOCATE(".",DIR) .EQ. F$LENGTH(DIR) THEN GOTO SET_PROMPT
X$ SET DEFAULT [-]
X$ DELETE_STRING = F$DIRECTORY() - "[" - "]"
X$ SET DEFAULT 'NEW_DEFAULT
V$ DIR = DIR - DELETE_STRING - "." ! Remove the parent directory n
Xame
X$!
X$ SET_PROMPT:
X$!
X$ SET PROMPT = "''ATTRON'''DIR' $''ATTROFF' "
X$ EXIT
X$!
X$ LOGICAL_NAME: ! P1 is a logical name
X$!
X$ NAME = P1
X$!
X$ LOOP: ! Iteratively translate P1, looking for a search list.
X$!
X$ IF F$TRNLNM(NAME,,,,,"MAX_INDEX") .GT. 0 THEN GOTO USE_P1
X$ NEXT = F$TRNLNM(NAME)
X$ IF NEXT .EQS. "" THEN GOTO CHECK_LOGICAL
X$ NAME = NEXT
X$ GOTO LOOP
X$!
X$ CHECK_LOGICAL: ! Does the translation of P1 include a directory?
X$!
X$ IF F$LOCATE("[",NAME) .EQ. F$LENGTH(NAME) THEN GOTO FIND_PROMPT
X$!
X$ USE_P1: !P1 translates to a search list or directory spec.
X$!
X$ LAST_DIR == OLD_DEFAULT
X$ SET PROMPT = "''ATTRON'''P1' $''ATTROFF' "
X$ EXIT
X$!
X$ NO_DIRECTORY: ! P1 does not specify an existing directory.
X$!
X$ SET DEFAULT 'OLD_DEFAULT
X$ WRITE SYS$OUTPUT "`007***** No such directory, default not changed"
X$ EXIT
X$!
X$! To install this procedure:
X$! declare a symbol " $ SD :== @sd.com "in your login.com.
X$! for this to work correctly, the "@SD.COM"
X$! MUST include the full directory specification
X$! such as "SD :== @PUB3:[VAUGHAN.COMMANDSTREAMS]SD.COM".
X$! Otherwise, it won't work if not in the current directory.
X$!
X$! declare a symbol " $ LAST_DIR == <your home dir>"
X$! where you can use SYS$LOGIN for <your home dir>
X$!
X$! declare a symbol GOBACK :== 'SD "'LAST_DIR'"
X$!
X$! The last two symbols are extentions to this procedure as found in original
X$! form. Declaring LAST_DIR in the login.com prevents unexpected results if
X$! GOBACK is used before a SD <dir> is done.
X$!
X$! The parameter is either a directory specification (possibly with a device
X$! name) or a logical name. This procedure starts with SET DEFAULT 'P1. If
X$! is a logical name whose translations include a directory specification or
X$! or if P1 is a search list, then the DCL prompt is set to "'P1' $ ".
X$! Otherwise the DCL prompt is changed to the name of the lowest subdirectory
X$! of the new default directory. For example, if the current default is
X$! DISK$USER[USER.REPORTS], then the command SD [.MAY] will change the default
X$! to DISK$USER[USER.REPORTS.MAY] and set the DCL prompt to to "MAY $ ". The
X$! command SD SYS$MANAGER will change the default and set the prompt
X$! to "SYS$MANAGER $".
X$!
X$! Revision History:
X$! 1-003 31-Dec-86 Tom Vaughan
X$! Add command abort handling, and standard Dec entry/exit.
X$! 1-002 15-Aug-86 Tom Vaughan
X$! Entry and publication error corrections.
X$! 1-001 'DEC Profesional, Vol. 5, N0. 7. 1986' William W. Hastings.
X$! Original.
$ GoSub Convert_File
$ File_is="FIND.COM"
$ Check_Sum_is=942419563
$ Copy SYS$Input VMS_SHAR_DUMMY.DUMMY
X$ s_pver = F$Verify(0)
X$ s_iver = F$Environment("VERIFY_IMAGE")
X$ Set NoVerify
X$ If "''com_deb'" Then $ Set Verify ! Debug.
X$ On Severe_Error Then Continue
X$ On Control_Y Then $ Goto ABORT
X$ s_sts = 1 ! Assume success.
X$!-----------------------------------------------------------------------------
X$! Command procedure taken from 'DEC Profesional, Vol. 5, N0. 7. 1986'
X$! by William W. Hastings.
X$!
X$! Command procedure to find the directory containing the file 'P1.
X$! The default is changed to this directory using SD.COM.
X$!
X$ IF P1 .EQS. "" THEN -
X INQUIRE P1 "Enter new directory specifications"
X$ DISK = F$TRNLNM("SYSDISK") ! Current default device name.
X$!
X$ LOOP: !Keep translating until a physical device is found
X$!
X$! NEXT = F$TRNLNM(DISK-":") ! As found in text, too bad.
X$ NEXT = F$TRNLNM("DISK"-":") ! Correct way as of Ver 4.4
X$ IF NEXT .EQS. "" THEN GOTO CHECK_ROOT
X$ DISK = NEXT
X$ GOTO LOOP
X$!
X$ CHECK_ROOT: !Is the current default rooted ?
X$!
X$ IF F$LOCATE(".]",DISK) .NE. F$LENGTH(DISK) THEN GOTO ROOTED
X$!
X$! Extract from the current default the highest level directory.
X$! Add "..." to allow a search of subdirectories.
X$!
X$ OLD_DEFAULT = F$ENVIRONMENT("DEFAULT")
X$ LEN = F$LOCATE(".",OLD_DEFAULT)
X$ IF LEN .EQ. F$LENGTH(OLD_DEFAULT) THEN LEN = LEN - 1
X$ DEFAULTS = F$EXTRACT(0,LEN,OLD_DEFAULT) + "...]*.*;*"
X$!
X$ FIND_FILE:
X$!
X$ SEARCH_NAME = F$PARSE(P1,DEFAULTS)
X$ FULL_NAME = F$SEARCH(SEARCH_NAME)
X$ IF FULL_NAME .EQS. "" THEN GOTO NO_FILE
X$ NEW_DEFAULT = F$EXTRACT(0,F$LOCATE("]",FULL_NAME) + 1,FULL_NAME)
X$ @COMDIR:SD 'NEW_DEFAULT
X$ GOTO FINISH
X$!
X$ ROOTED: !Allow search of entire rooted directory.
X$!
X$ DEFAULTS = SYS$DISK:[*...]*.*;*
X$ GOTO FIND_FILE
X$!
X$ NO_FILE:
X$!
X$ IF SEARCH_NAME .EQS. "" THEN GOTO NO_DIRECTORY
X$ WRITE SYS$OUTPUT "`007**** File not found"
X$ GOTO FINISH
X$!
X$ NO_DIRECTORY: !A nonexistent directory was specified.
X$!
X$ WRITE SYS$OUTPUT "`007**** No such directory"
X$ GOTO FINISH
X$!
X$FINISH: ! Normal exit.
X$!
X$ Set NoOn ! So we don't loop here.
X$ s_ver = F$Verify(s_pver, s_iver) ! Restore verify.
X$ Exit '$STATUS' !Find.com
X$!
X$ ABORT: ! Aborted exit.
X$!
X$ SET DEFAULT 'OLD_DEFAULT
X$ WRITE SYS$OUTPUT "`007***** Aborted by user, default not changed"
X$ GOTO FINISH
X$!
X$! The parameter P1 is a file specification (see DCL dictionary, page 33)
X$! with (possibly) some fields missing. A search for this file is performed.
X$! If no directory is specified then an entire directory tree is searched.
X$! The root of this tree is the top level directory in the current default
X$! directory (as displayed by the SHOW DEFAULT command). The first directory
X$! (subdirectory) found to contain the file P1 becomes the default directory.
X$! The default directory is changed by invoking the companion procedure
X$! SD.COM. For example, if the current default is DISK$USER:[USER.REPORTS],
X$! the command @FIND JUNE12.*;* will invoke a search for the file
X$! DISK$USER:[USER...]JUNE12.*;* . The first directory found to contain a
X$! file named JUNE12 will become the default.
X$!
X$! Revision History:
X$! 1-002 31-Dec-86 Tom Vaughan
X$! Add command abort handling, and standard Dec entry/exit.
X$! 1-001 'DEC Profesional, Vol. 5, N0. 7. 1986' William W. Hastings.
X$! Original.
$ GoSub Convert_File
$ Exit
-------