OpenVMS Source Code Demos
rms-relative-demo.bas
1000 %title "OpenVMS-basic-rms-relative-demo_xxx.bas"
%sbttl "RMS (Record Management Services) Demo"
%ident "version 101.1"
!========================================================================================
! title : OpenVMS-basic-rms-relative-demo_xxx.bas
! author : Neil Rieck (http://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
! NSR 020829 2. added record update
! 101 NSR 050129 1. changed the phrase "Compaq" to "OpenVMS"
!========================================================================================
option type=explicit ! cuz tricks are for kids
set no prompt ! no ? with INPUT
!
declare string constant k_rel_fs$ = "OpenVMS-basic-rms-relative-demo.dat"
declare string constant k_program = "OpenVMS-BASIC-RMS-Relative-Demo"
!
! mapped variables to 'lay out' a disk record
!
map (relative_demo) string d21_first_name = 20 ,! 20 &
d21_last_name = 20 ,! 40 &
d21_telephone = 10 ,! 50 &
d21_address = 20 ,! 70 &
d21_city = 20 ,! 90 &
d21_postal = 10 ,!100 &
fill$ = 50 ,!150 room to grow &
d21_align = 0 ! to enforce map alignment
map (relative_demo) string d21_whole_chunk = 150 ,!150 &
d21_align = 0 ! to enforce map alignment
!
! <<< declare variables >>>
!
declare long record_num% ,&
handler_error% ,&
string junk$
!
!====================================================================================================
2000 print k_program ! display program name
print string$( len(k_program), ascii("=") ) ! now underline it
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 sortie if junk$ <> "Y"
when error in
while 1=1 ! make sure we delete all versions
kill k_rel_fs$ !
next !
use
end when
!
! <<< open the file >>>
!
! notes:
! 1. open k_rel_fs$ for input as file #21 - the file must already exist
! 2. open k_rel_fs$ for output as file #21 - a new file version is always created
! 3. open k_rel_fs$ as file #21 - the file is created if it doesn't exit
!
input "OK to create/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_rel_fs$
open k_rel_fs$ as file #21 ! create the file if it doesn't exist &
,access modify ! we want to read + write &
,allow modify ! allow others to read + write while we do it &
,map relative_demo ! &
,organization relative !
handler_error% = 0
use
handler_error% = err
print "-e- error: "+str$( handler_error% )+" in phase #1"
print "-i- text : "+ert$( handler_error% )
end when
goto sortie if handler_error% <> 0
!
! <<< write some records >>>
!
input "OK to write 3 demo data records? (y/N) ";junk$
junk$ = left$( edit$(junk$,32+2), 1) ! upcase, no white space
goto sortie if junk$ <> "Y"
when error in
print "-i- writing file: "; k_rel_fs$
d21_whole_chunk = "" ! start with a clean buffer
record_num% = 0
!
d21_first_name = "Joe"
d21_last_name = "Blow"
d21_telephone = "4165551111"
d21_address = "483 Bay Street"
d21_city = "Toronto"
d21_postal = "M5G2C9"
record_num% = record_num% + 1
put #21, record record_num%
!
d21_first_name = "Fat"
d21_last_name = "Albert"
d21_telephone = "4165552222"
d21_address = "220 Simcoe Street"
d21_city = "Toronto"
d21_postal = "M5T1T4"
record_num% = record_num% + 1
put #21, record record_num%
!
d21_first_name = "Ken"
d21_last_name = "Olsen"
d21_telephone = "4165553333"
d21_address = "129 Parker Street"
d21_city = "Toronto"
d21_postal = "01754"
record_num% = record_num% + 1
put #21, record record_num%
!
handler_error% = 0
use
handler_error% = err
print "-e- error: "+str$( handler_error% )+" in phase #2"
print "-i- text : "+ert$( handler_error% )
end when
!~~~ goto sortie if handler_error% <> 0
!
gosub read_sequentially ! display all records
!
! <<< read the file relatively (by record number) >>>
!
input "OK to display data records relatively? (y/N) ";junk$
junk$ = left$( edit$(junk$,32+2), 1) ! upcase, no white space
goto sortie if junk$ <> "Y"
when error in
print "-i- reading file: "; k_rel_fs$; " relatively"
handler_error% = 0
record_num% = 0
while 1=1
record_num% = record_num% + 1
get #21, record record_num%, regardless ! read without applying a record lock
print "Record# : ";str$( record_num% )
print "first name: "; d21_first_name
print "last_name : "; d21_last_name
print "telephone : "; d21_telephone
print "address : "; d21_address
print "city : "; d21_city
print "postal : "; d21_postal
print "=============================="
sleep 1
next
use
handler_error% = err
print "-e- error: "+str$( handler_error% )+" in phase #4 on record "+str$( record_num% )
print "-i- text : "+ert$( handler_error% )
end when
!~~~ goto sortie if handler_error% <> 0
!
! <<< find/delete record "Blow" >>>
!
input "OK to delete record for 'Blow'? (y/N) ";junk$
junk$ = left$( edit$(junk$,32+2), 1) ! upcase, no white space
goto sortie if junk$ <> "Y"
when error in
reset #21 ! rewind to BOF
while 1=1
get #21 ! read with lock
if d21_last_name = "Blow" then
delete #21
goto delete_done
end if
next
use
handler_error% = err
print "-e- error: "+str$( handler_error% )+" in phase #5"
print "-i- text : "+ert$( handler_error% )
end when
delete_done:
gosub read_sequentially ! display all records
!
! <<< delete record #2 >>>
!
input "OK to delete record #2 (y/N) ";junk$
junk$ = left$( edit$(junk$,32+2), 1) ! upcase, no white space
goto sortie if junk$ <> "Y"
when error in
get #21, record 2 ! read with LOCK
delete #21
use
handler_error% = err
print "-e- error: "+str$( handler_error% )+" in phase #6"
print "-i- text : "+ert$( handler_error% )
end when
gosub read_sequentially ! display all records
!
! <<< find/update record for "Ken Olsen" >>>
!
input "OK to change Ken Olsen's City? (y/N) ";junk$
junk$ = left$( edit$(junk$,32+2), 1) ! upcase, no white space
goto sortie if junk$ <> "Y"
when error in
reset #21 ! rewind to BOF
while 1=1
get #21 ! read with lock
if d21_first_name = "Ken" and &
d21_last_name = "Olsen"
then
d21_city = "Maynard"
d21_postal = ""
update #21
goto update_done
end if
next
use
handler_error% = err
print "-e- error: "+str$( handler_error% )+" in phase #7"
print "-i- text : "+ert$( handler_error% )
end when
update_done:
gosub read_sequentially ! display all records
!
goto sortie
!====================================================================================================
! Subroutines
!====================================================================================================
!
! <<< read the file sequentially >>>
!
4000 read_sequentially:
input "OK to display data records sequentially? (y/N) ";junk$
junk$ = left$( edit$(junk$,32+2), 1) ! upcase, no white space
goto rs_exit if junk$ <> "Y" !
when error in
print "-i- reading file: "; k_rel_fs$; " sequentially"
handler_error% = 0
reset #21 ! rewind to BOF
while 1=1
get #21, regardless ! read without applying a record lock
print "first name: "; d21_first_name
print "last_name : "; d21_last_name
print "telephone : "; d21_telephone
print "address : "; d21_address
print "city : "; d21_city
print "postal : "; d21_postal
print "=============================="
sleep 1
next
use
handler_error% = err
print "-e- error: "+str$( handler_error% )+" in phase #3"
print "-i- text : "+ert$( handler_error% )
end when
rs_exit:
return
!========================================================================================================================
! <<< Final Error Trap >>>
!
! If we've done a good job coding, we should never execute this code >>>
!========================================================================================================================
31000 trap:
print
print "Error in final trap"
print "Line: ";erl
print "Err : ";str$(err)
print "Msg : ";ert$(err)
resume sortie !
!====================================================================================================
!
! <<< that's all folks >>>
!
32000 sortie:
print "Adios..."
end
Back to HomeNeil Rieck
Waterloo, Ontario, Canada.