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 (https://neilrieck.net/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