OpenVMS Source Code Demos

VMS_LOGICAL_NAMES.BAS

1000	%title "vms_basic_logical_names_xxx.bas"
	%ident "version_100.1"
	!
	!0123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890
	!1         2         3         4         5         6         7         8         9         0         1         2         3
	!=========================================================================================================================
	! Title  : vms_basic_logical_names_xxx.bas
	! Author : Neil S. Rieck (Waterloo, Ontario, Canada)
	! Purpose: demoes logical name manipulation only using SYS$ calls
	! History:
	! 100 NSR 991126 1. original program
	!=========================================================================================================================
	! notes:
	! 1. to hack the 'STARLET' system library, do the following from DCL (need ~7000 blocks):
	!
	!  command                                       description
	!  =======                                       ===========
	!  $set def sys$login                            (go to your home directory)
	!  $lib/ext=* sys$library:basic$starlet.tlb/text (copy text from 'text libary' to 'text file')
	!  $edit/read/edt basic$starlet.txt              (edit large text file using EDT)
	!=========================================================================================================================
	option type=explicit							! no kid stuff
	!
	%include "starlet"	%from %library "sys$library:basic$starlet"	! system services (calls)
	%include "$ssdef"	%from %library "sys$library:basic$starlet"	! ss$ definitions
	%include "lib$routines"	%from %library "sys$library:basic$starlet"	! lib$ routines (calls)
	%include "$libclidef"	%from %library "sys$library:basic$starlet"	! lib$ cli definitions
	%include "$lnmdef"	%from %library "sys$library:basic$starlet"      ! lnm$
	%include "$psldef"	%from %library "sys$library:basic$starlet"      ! psl$
	!
	!
	record ItemListRec							! structure of item record
	    variant								! similar to a union in "c"
		case
		    group one
			word	BuffLen
			word	ItemCode
			long	BuffAddr
			long	RtnLenAdr
		    end group one
		case
		    group two							! this is overlayed over group one
			long	List_Terminator
			long	Junk1
			long	Junk2
		    end group two
	    end variant
	end record ItemListRec
	!
	declare ItemListRec MyList(9)						! expand or contract list length as required
	!
	declare ItemListRec MyList						! this is the variable declaration
	map(xyz)string	Equiv_Name$	= 255%					! equiv values can't be bigger than 255
	declare long	bytes_returned%	,					!			&
			my_attributes%	,					!			&
			my_test%	,					!			&
			rc%		,					!			&
		string	table_name$	,					!			&
			logical_name$	,					! 			&
			stuff$		,					!			&
		byte	access_mode%						!
	!
	access_mode%	= PSL$C_SUPER						! either SUPER or USER is all we need
!	my_attributes% = LNM$M_TERMINAL						x incase we want to specify this
	!
	!	<<< create/update a logical name >>>
	!
	print "-i- calling sys$crelnm to create/update logical name"
	table_name$	= "LNM$PROCESS_TABLE"
	logical_name$	= "EXAMPLE1"					! must be upper case
	Equiv_Name$	= "yada"
	MyList(0)::BuffLen		= len(edit$(Equiv_Name$,2))	! compute length of mapped string
	MyList(0)::ItemCode		= lnm$_String			! desired code
	MyList(0)::BuffAddr		= loc(Equiv_Name$)		!
	MyList(0)::RtnLenAdr		= 0				! don't care
	MyList(1)::List_Terminator	= 0%				! signal end-of-list
	!
	!	SYS$CRELNM [attr] ,tabnam ,lognam ,[acmode] ,[itmlst]
	!
	rc% = sys$crelnm(						! attributes	&
					,table_name$			! table name	&
					,logical_name$			! logical name	&
					,access_mode%			! access mode	&
					,MyList()		)	! argument list
	gosub display_rc
	!
	!	<<< read a logical name >>>
	!
	print ">>> calling sys$trnlnm to read 'test_name'"
	table_name$	= "LNM$PROCESS_TABLE"
	logical_name$	= "EXAMPLE1"					! must be upper case
	MyList(0)::BuffLen	= len(Equiv_Name$)			!
	MyList(0)::ItemCode	= lnm$_String				! desired code
	MyList(0)::BuffAddr	= loc(Equiv_Name$)			!
	MyList(0)::RtnLenAdr	= loc(Bytes_Returned%)			!
	!
	MyList(1)::List_Terminator	= 0%				! signal end-of-list
	!
	rc% = sys$trnlnm(						! attributes	&
					,table_name$			! table name	&
					,logical_name$			! logical name	&
					,access_mode%			! access mode	&
					,MyList()		)	! argument list
	gosub display_rc
	print "-i-Logical Name: ";logical_name$
	!
	select rc%
	    case ss$_nolognam
		stuff$ = ""
		print "-e-No Such Logical"
	    case ss$_normal
		stuff$ = left$(Equiv_Name$, bytes_returned%)
		print "-i-Equiv Name: ";stuff$
	    case else
		print "rc: "+str$(rc%)
	end select
	!
	!	<<< delete logical name >>>
	!
	!	SYS$DELLNM tabnam ,[lognam] ,[acmode]
	!
	print "-i- calling sys$dellnm to delete logical name"
	rc% = sys$dellnm(table_name$, logical_name$, access_mode%)
	gosub display_rc
	!
	goto fini								! adios...
	!------------------------------------------------------------------------------------------------------------------------
	!	<<< display VMS severity and return code >>>
	!------------------------------------------------------------------------------------------------------------------------
	display_rc:
	select (rc% and 7%)
	    case 0%
		print "-w-";
	    case 1%
		print "-s-";
	    case 2%
		print "-e-";
	    case 3%
		print "-i-";
	    case 4%
		print "-f-";
	    case else
		print "-?-";
	end select
	print " rc: ";str$(rc%)
	return
	!------------------------------------------------------------------------------------------------------------------------
	!	<<< that's all folks >>>
	!------------------------------------------------------------------------------------------------------------------------
	fini:
	end

---

Back to Home
Neil Rieck
Waterloo, Ontario, Canada.