          <<< NOTED::DISK$NOTES7:[NOTES$LIBRARY_7OF4]HACKERS.NOTE;1 >>>
                               -< ** Hackers ** >-
================================================================================
Note 1743.3              SET FILE/ENTER from a program ?                  3 of 3
UBOHUB::DRSD11::THRUSSELL "Fate never smiled my wa" 110 lines  29-JUN-1995 09:34
                -< Here is a Fortran version of set file/enter >-
--------------------------------------------------------------------------------
Since I looked here hoping to find an example and didn't I thought I'd add one.

To run:

mc device:[dir]enter_file existing_file_name alias

Note: Command line parsing is primitive, error handling almost none existant,
      and no warranty. I'm not sure I entirely understand whats going on but
      it works !
 

C*******************************************************************************

	OPTIONS/EXTEND

	PROGRAM Enter_File

C*******************************************************************************
C Include files
C*******************************************************************************

	INCLUDE '($FABDEF)'
	INCLUDE '($NAMDEF)'
	INCLUDE	'($RMSDEF)'
	INCLUDE	'($SYSSRVNAM)'

C*******************************************************************************
C Local variables
C*******************************************************************************

	INTEGER*4	Fid (3)			! RMS File Identification
	CHARACTER*510	Files			! Command line buffer
	INTEGER		Files_Len		! Command line buffer length

	CHARACTER*255	New_File_Name		! New file name (or alias)
	INTEGER		New_File_Name_Len	! New file name length
	CHARACTER*255	Old_File_Name		! Existing file name
	INTEGER		Old_File_Name_Len	! Existing file name length

	CHARACTER*255	Expanded_Spec		! RMS buffer
	CHARACTER*255	Resultant_Spec		! RMS buffer

	INTEGER*4	RMS_Status		! Status return
	INTEGER*4	Status			! Status return

	RECORD /FabDef/	Fab			! RMS File Access Block (Fab) block
	RECORD /NamDef/	Nam			! RMS Name (Nam) block

C*******************************************************************************
C Get old and new file names from the command line
C*******************************************************************************

	Status = LIB$GET_FOREIGN (Files,, Files_Len) 
	Old_File_Name = Files (1 : INDEX (Files, ' ') -1)
	Old_File_Name_Len = INDEX (Old_File_Name // ' ', ' ') - 1
	New_File_Name = Files (INDEX (Files, ' ') + 1 : Files_Len)
	New_File_Name_Len = INDEX (New_File_Name // ' ', ' ') - 1

C*******************************************************************************
C Establish RMS FAB and NAM blocks using required defaults
C*******************************************************************************

	Fab.FAB$B_BID = FAB$C_BID
	Fab.FAB$B_BLN = FAB$C_BLN
	Fab.FAB$W_IFI = 0
	Fab.FAB$L_NAM = %LOC (Nam)

	Nam.NAM$B_BID = NAM$C_BID
	Nam.NAM$B_BLN = NAM$C_BLN
	Nam.NAM$L_ESA = %LOC (Expanded_Spec)
	Nam.NAM$B_ESS = LEN (Expanded_Spec)
	Nam.NAM$L_RSA = %LOC (Resultant_Spec)
	Nam.NAM$B_RSS = LEN (Resultant_Spec)

C*******************************************************************************
C Get the FID for the existing file
C*******************************************************************************

	Fab.FAB$L_FNA = %LOC (Old_File_Name)
	Fab.FAB$B_FNS = Old_File_Name_Len

	RMS_Status = SYS$PARSE (Fab)
	RMS_Status = SYS$SEARCH (Fab)

	Fid (1) = Nam.NAM$W_FID (1)
	Fid (2) = Nam.NAM$W_FID (2)
	Fid (3) = Nam.NAM$W_FID (3)

C*******************************************************************************
C Parse the new file name or alias
C*******************************************************************************

	Fab.FAB$L_FNA = %LOC (New_File_Name)
	Fab.FAB$B_FNS = New_File_Name_Len

	RMS_Status = SYS$PARSE (Fab)

C*******************************************************************************
C Create the new entry using the original FID
C*******************************************************************************

	Nam.NAM$W_FID (1) = Fid (1)
	Nam.NAM$W_FID (2) = Fid (2)
	Nam.NAM$W_FID (3) = Fid (3)

	RMS_Status = SYS$ENTER (Fab)

	CALL EXIT (RMS_Status)

	END