OpenVMS Source Code Demos
rms-indexed-demo.bas
1000 %title "OpenVMS-BASIC-RMS-indexed-demo_xxx.bas"
%sbttl "RMS (Record Management Services) Demo"
%ident "version 101.2"
!==============================================================================================================
! title : OpenVMS-BASIC-RMS-indexed-demo_xxx.bas
! author : Neil Rieck (https://neilrieck.net/links/cool_openvms.html)
! purpose: demos the use of RMS-based indexed 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. a. in a RDBS, the primary key must be unique, isn't indexed by default, can't be changed
! : b. what OpenVMS BASIC calls a primary key doesn't need to be unique, is indexed, can't be changed
! : c. in RDBS terms, the primary key is really the RFA (record file address) which can be thought
! of as an internal RMS sequence counter
! : 3. edit environment: VT-220, 132 column, 8 column tab stops at 1,9,17,25,....
! : 4. all remarks begin in column 81
! history:
! ver who when what
! --- --- ------ ----------------------------------------------------------------------------------------------
! 100 NSR 020829 1. original program
! 101 NSR 050123 1. cleanup for public view
! NSR 050124 2. added more documentation
!==============================================================================================================
option type=explicit ! cuz tricks are for kids
set no prompt ! no ? with INPUT
!
! <<< declare constants >>>
!
declare string constant k_program = "OpenVMS-BASIC-RMS-Indexed-Demo"
declare string constant k_idx_fs$ = "OpenVMS-BASIC-RMS-Indexed-Demo.dat"
!
! <<< mapped variables to 'lay out' a disk record >>>
!
! note: when the same map names is used, the second map overlays the first
!
map (indexed_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_code = 10 , !100 &
fill$ = 50 , !150 room to grow &
d21_align = 0 ! to enforce map alignment
map (indexed_demo) string &
d21_whole_chunk = 150 , !150 &
d21_align = 0 ! to enforce map alignment
!
! <<< declare variables >>>
!
declare long handler_error% , &
rec_count% , &
string junk$ , &
rfa rfa21 ! record file address (a 48-bit variable)
!
!========================================================================================================================
! <<< main >>>
!========================================================================================================================
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 get all versions
kill k_idx_fs$
next
use !
end when
!
! <<< open the file >>>
!
! "BASIC Open" notes:
! 1. open k_idx_fs$ for input as file #21 - the file must already exist
! 2. open k_idx_fs$ for output as file #21 - a new file version is always created
! 3. open k_idx_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_idx_fs$
open k_idx_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 indexed_demo ! &
,organization indexed ! &
,primary (d21_last_name, d21_first_name, d21_city) ! key #0 &
,alternate d21_last_name duplicates changes ! key #1 &
,alternate d21_telephone duplicates changes ! key #2 &
,alternate d21_telephone duplicates changes descending ! key #3
!
! note: the connected channel is opened last but must be closed first
!
print "-i- opening file: "; k_idx_fs$; " (connect)"
open k_idx_fs$ as file #22 ! &
,access modify ! we want to read + write &
,allow modify ! allow others to read + write while we do it &
,map indexed_demo ! &
,organization indexed ! &
,connect 21 !
handler_error% = 0 ! show that all is well
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 ! exit on ant errors
!
! <<< write some records >>>
!
4000 rec_count% = 0
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_idx_fs$
d21_whole_chunk = "" ! start with a clean buffer
!
d21_first_name = "Ken"
d21_last_name = "Olsen"
d21_telephone = "4165553333"
d21_address = "129 Parker Street"
d21_city = "Toronto" ! this gets corrected below
d21_postal_code = "01754"
print "-i- writing record: "; str$(rec_count% + 1) !
put #21 ! write to file
rec_count% = rec_count% + 1 !
!
d21_first_name = "Dave"
d21_last_name = "Cutler"
d21_telephone = "4165552222"
d21_address = "220 Simcoe Street"
d21_city = "Toronto"
d21_postal_code = "M5T1T4"
print "-i- writing record: "; str$(rec_count% + 1)
put #21 ! write to file
rec_count% = rec_count% + 1
!
d21_first_name = "Gordon"
d21_last_name = "Bell"
d21_telephone = "4165551111"
d21_address = "483 Bay Street"
d21_city = "Toronto"
d21_postal_code = "M5G2C9"
print "-i- writing record: "; str$(rec_count% + 1)
put #21 ! write to file
rec_count% = rec_count% + 1
!
print "-i- will rewrite previous record to force a duplicate key error (134)"
print "-i- writing record: "; str$(rec_count% + 1) !
put #21 ! write to file
rec_count% = rec_count% + 1 !
!
handler_error% = 0
use
handler_error% = err
print "-e- error: "+ str$( handler_error% )+" in phase #2"
print "-i- text : "+ ert$( handler_error% )
print "-i- recs : "+ str$( rec_count% )
end when
gosub read_sequentially ! display all records
!
! <<< read the file sequentially by index-key #1 >>>
!
5000 input "OK to display data records in reverse telephone order? (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_idx_fs$; " by index-key-3"
reset #21, key#3
! find #21, key#3 gt " ", regardless x same as previous line
handler_error% = 0
while 1=1 ! loop forever (until we trap out)
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 code : "; d21_postal_code
print "=============================="
sleep 1
next
use
handler_error% = err
print "-e- error: "+str$( handler_error% )+" in phase #4"
print "-i- text : "+ert$( handler_error% )
end when
!
! <<< find/delete record "Cutler" >>>
!
6000 input "OK to delete record for 'Dave Cutler'? (y/N) ";junk$
junk$ = left$( edit$(junk$,32+2), 1) ! upcase, no white space
goto sortie if junk$ <> "Y"
when error in
find #21, key#1 nxeq "C " ! find (with lock)
while 1=1 ! loop forever (until we trap out)
get #21 ! read (with lock)
if d21_last_name = "Cutler" and &
d21_first_name = "Dave"
then ! if Dave Cutler
delete #21 !
print "-i- record deleted, looking for more people named 'Dave Cutler'"
else !
cause error 11 if left$( d21_last_name,1) <> "C" ! exit if we've gone too far
iterate !
end if
next
use
handler_error% = err
print "-e- error: "+str$( handler_error% )+" in phase #5"
print "-i- text : "+ert$( handler_error% )
end when
!
gosub read_sequentially ! display all records
!
! <<< delete record #2 >>>
!
7000 input "OK to delete 'Gordon Bell' using the RFA method? (y/N) ";junk$
junk$ = left$( edit$(junk$,32+2), 1) ! upcase, no white space
goto sortie if junk$ <> "Y"
when error in
find #21, key#1 ge "Bell", regardless ! Find (without lock) (ge = nxeq)
while 1=1 !
get #21, regardless ! read (without lock)
cause error 11 if pos(d21_last_name,"Bell",1)=0 ! exit if we've gone too far
if d21_last_name = "Bell" and &
d21_first_name = "Gordon"
then ! if Gordon Bell
rfa21 = getrfa(21) ! get the record file address
get #22, rfa rfa21 ! position connected channel with LOCK
delete #22 ! now delete
print "-i- record deleted, looking for more people named 'Gordon Bell'"
else
iterate ! do another GET on orginal channel
end if
next
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 "Olsen" >>>
!
8000 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"
find_update_reentry_point:
when error in
find #21, key#1 ge "Olsen", regardless ! set key
while 1=1
get #21, regardless ! read without lock
cause error 11 if pos(d21_last_name,"Olsen",1)=0 ! exit if we've gone too far
if d21_first_name = "Ken" and &
d21_last_name = "Olsen" and &
d21_city = "Toronto"
then
rfa21 = getrfa(21)
get #22, rfa rfa21
d21_city = "Maynard"
d21_postal_code = ""
update #22
print "-i- record update, looking for more people named 'Ken Olsen'"
end if
next
use
handler_error% = err
print "-e- error: "+str$( handler_error% )+" in phase #7a"
print "-i- text : "+ert$( handler_error% )
end when
!
select handler_error%
case 130 ! key not changeable (for primary keys only)
when error in
print "-i- attempting FIND-RFA"
find #22, rfa rfa21 ! position with LOCK (but don't change data)
print "-i- attempting DELETE"
delete #22 ! delete
print "-i- attempting PUT"
put #22 ! write buffered data
handler_error% = 0
use
handler_error% = err
print "-e- error: "+str$( handler_error% )+" in phase #7b"
print "-i- text : "+ert$( handler_error% )
end when
goto find_update_reentry_point if handler_error% = 0 ! look for more if successful
case 11 ! end-of-file
case 155 ! record-not-found
case 131 ! no current key (no lock)
end select
!
gosub read_sequentially ! display all records
!
print string$( 60, ascii("-") ) ! draw a line
print "That's all for now"
sleep 1
goto sortie
!====================================================================================================
! Subroutines
!====================================================================================================
!
! <<< read the file sequentially >>>
!
20000 read_sequentially:
input "OK to display data records sequentially? (y/N) ";junk$
junk$ = left$( edit$(junk$,32+2), 1) ! upcase, no white space
goto read_sequentially_exit if junk$ <> "Y"
when error in
print "-i- reading file: "; k_idx_fs$; " sequentially"
handler_error% = 0
reset #21 ! rewind to BOF
! reset #21, key#0 x same as "reset #21"
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 code : "; d21_postal_code
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
read_sequentially_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:
close 22 ! always close the connected channel first
close 21 !
print "Adios..."
end
Back to HomeNeil Rieck
Waterloo, Ontario, Canada.