OpenVMS Source-Code Demos

RMS_SEQUENTIAL_DEMO.BAS

1000	%title "OpenVMS-basic-rms-sequential-demo_xxx.bas"			!
	%sbttl "RMS (Record Management Services) Demo"				!
	%ident                      "version 100.1"				! <<<---+--- must match
	declare string constant k_version = "100.1"			,	! <<<---+		&
				k_program = "OpenVMS-BASIC-RMS-Sequential-Demo"	!
	!========================================================================================
	! title  : OpenVMS-basic-rms-sequential-demo_xxx.bas
	! author : Neil Rieck (http://www3.sympatico.ca/n.rieck/links/cool_openvms.html)
	! purpose: demos the use of RMS-based relative file access for novice OpenVMS programmers
	! scope  : this educational program comes free of charge with no strings attached
	! notes  : 1. OpenVMS-BASIC has 'built in' support for RMS (Record Management Services)
	!        : 2. edit environment: VT-220, 132 column, 8 column tab stops at 1,9,17,25,....
	!        : 3. all remarks begin in column 81
	! history:
	! ver who when   what
	! --- --- ------ ------------------------------------------------------------------------
	! 100 NSR 020828 1. original program
	!========================================================================================
	option type=explicit							! cuz tricks are for kids
	set no prompt								! no ? with INPUT
	!
	declare string constant k_seq_fs$ = "OpenVMS-basic-rms-sequential-demo.dat"
	!
	!	<<< declare some variables >>>
	!
	declare	long	record_num%					,	&
			handler_error%					,	&
			i%						,	&
			ec%						,	&
		string	junk$
	!
	!====================================================================================================
	!	main
	!====================================================================================================
2000	print k_program +"-"+ k_version						! display program name
	print string$( len(k_program+"-"+ k_version), ascii("=") )		! what will the optimizer do with this?
	on error goto trap                                                      ! legacy error handler support
	margin #0, 132                                                          ! this will not change the screen size
	!
	!	<<< delete all OpenVMS versions of our test file >>>
	!
	input "OK to delete 'demo data files'? (y/N) ";junk$
	junk$ = left$( edit$(junk$,32+2), 1)					! upcase, no white space
	goto skip_delete if junk$ <> "Y"					!
	when error in								!
	    while 1								! make sure we delete all versions
		kill k_seq_fs$							!
	    next								!
	use									!
	end when								!
	skip_delete:								!
	!
	!	<<< open the file >>>
	!
	input "OK to open 'demo data file'? (y/N) ";junk$			!
	junk$ = left$( edit$(junk$,32+2), 1)					! upcase, no white space
	goto sortie if junk$ <> "Y"						!
	!
3000	when error in								!
	    print "-i- opening file: "; k_seq_fs$				!
	    open k_seq_fs$  for input as #99					! "for input" means file must already exist	&
		,access		read						! we want to read + write			&
		,allow		modify						! reduce locking conflicts			&
		,organization	sequential					!						&
		,recordsize	32700						! implied EOL at 32K (great for HTML)
	    handler_error% = 0							! cool
	use									!
	    handler_error% = err						! oops
	    print "-e-error: "+str$( handler_error% )+" in phase #1"		!
	    print "-w-text : "+ert$( handler_error% )				!
	end when								!
	!
	select handler_error%							!
	    case 0								! cool
		goto read_file							!
	    case 5								! FNF
										! (fall thru to create)
	    case else								!
		goto sortie							!
	end select								!
	!
	!	<<< create file and data >>>
	!
	input "OK to create 'demo data file'? (y/N) ";junk$			!
	junk$ = left$( edit$(junk$,32+2), 1)					! upcase, no white space
	goto sortie if junk$ <> "Y"						!
	!
	!	caveat: in this statement, "recordsize" becomes the RMS parameter "MRS" (maximum record size)
	!
4000	when error in								!
	    print "-i- opening file: "; k_seq_fs$				!
	    open k_seq_fs$  for output as #99					!						&
		,organization	sequential					!						&
		,recordsize	32700						! implied EOL at 32K (great for HTML)
	    for i% = 1 to 10							!
		print #99, "this is line "+ str$(i%)				!
	    next i%								!
	    handler_error% = 0							! cool
	use									!
	    handler_error% = err						! oops
	    print "-e-error: "+str$( handler_error% )+" in phase #2"		!
	    print "-w-text : "+ert$( handler_error% )				!
	end when								!
	!
	read_file:
	input "OK to read 'demo data file'? (y/N) ";junk$			!
	junk$ = left$( edit$(junk$,32+2), 1)					! upcase, no white space
	goto sortie if junk$ <> "Y"						!
	!
	when error in								!
	    reset #99								! need this in case we just created/wrote file
	    while 1								!
		linput #99, junk$						!
		print junk$							!
	    next								!
	use									!
	    handler_error% = err						!
	    select handler_error%						!
		case 11								! EOF
		    print "-i-error: "+str$( handler_error% )+" in phase #3"	!
		    print "-i-text : "+ert$( handler_error% )			!
		case else							!
		    print "-e-error: "+str$( handler_error% )+" in phase #3"	!
		    print "-w-text : "+ert$( handler_error% )			!
	    end select								!
	end when								!
	close #99								!
	goto sortie								!
	!========================================================================================================================
	!       <<< Final Error Trap >>>
	!
	!       If we've done a good job coding, then we should never execute this code >>>
	!========================================================================================================================
32000	trap:									!
	print									!
	print "Error in final trap"						!
	print "==================="						!
	print "-i-Err : ";str$(err)						!
	print "-w-Msg : ";ert$(err)						!
	print "-w-Line: ";erl							!
	ec% = 2									! VMS-e-	ERROR
	resume sortie_err							! fix stack
	!====================================================================================================
	!
	!	<<< that's all folks >>>
	!
32700	sortie:									!
	ec% = 1									! VMS-s-	SUCCESS
	sortie_err:								!
	print "-i-Adios..."							!
	end program ec%								! signal exit status back to DCL