OpenVMS Source Code Demos
RMS_INDEXED_DEMO_FMS.BAS
1000 %title "BASIC_RMS_INDEXED_DEMO_FMS_xxx.BAS"
%sbttl "RMS (Record Management Services) Demo - FMS Version"
%ident "version 102.3"
declare string constant k_program = "BASIC_RMS_Indexed_Demo_FMS"
!==============================================================================================================
! title : BASIC-RMS-indexed-demo-fms_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
! build : 1. compile basic source
! : $bas BASIC_RMS_INDEXED_DEMO_FMS_102
! : 2. compile fms form
! : $fms/obj BASIC_RMS_INDEXED_DEMO_FMS.frm /out=BASIC_RMS_INDEXED_DEMO_FMS_frm.obj
! : 3. link pieces together
! : $link BASIC_RMS_INDEXED_DEMO_FMS_102, BASIC_RMS_INDEXED_DEMO_FMS_frm.obj
! 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
! 102 NSR 110401 1. tweaks for 2011
! NSR 110615 2. added code to replace plain i/o with FMS (forms management system) i/o
! NSR 110617 3. a few more tweaks
!==============================================================================================================
option type=explicit ! cuz tricks are for kids
set no prompt ! no ? with INPUT
!
%include "CSMIS$ROOT3:[DVLP.INC]FMS_FDVDEF.INC" ! FMS functions and constants
%include "CSMIS$ROOT3:[DVLP.INC]device_controls.inc" ! VT control codes
!
! <<< declare constants >>>
!
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 (idx_map) 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 (idx_map) string &
d21_whole_chunk = 150 , !150 &
d21_align = 0 ! to enforce map alignment
!
map (my_form) string &
f21_first_name = 20 , ! 20 &
f21_last_name = 20 , ! 40 &
f21_telephone = 10 , ! 50 &
f21_address = 20 , ! 70 &
f21_city = 20 , ! 90 &
f21_postal_code = 10 , !100 &
f21_align = 0 ! to enforce map alignment
map (my_form) string &
f21_whole_chunk = 100 , !150 &
f21_align = 0 ! to enforce map alignment
!
! <<< declare variables >>>
!
declare long handler_error% , &
rec_count% , &
string junk$ , &
prev$ , &
rfa rfa21 ! record file address (a 48-bit variable)
!
! <<< stuff for FMS >>>
!
map(wksp4) string WorkSpace4 = 12 ! work space 4
map(tca) string TCA = 12 ! terminal control area
declare long fms_init% , &
form_up% , &
term% , &
string choice$
declare string constant k_fname4$ = "BASIC_RMS_INDEXED_DEMO_FMS" ! title defined in the FORM
declare long constant k_fsize4% = 2000 !
!
!========================================================================================================================
! <<< 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 ! 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 idx_map ! &
,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 idx_map ! &
,organization indexed ! &
,connect 21 !
handler_error% = 0 ! cool
use !
handler_error% = err ! oops
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 4 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 = "Neil" !
d21_last_name = "Rieck" !
d21_telephone = "5195551212" !
d21_address = "20 Water Street N" !
d21_city = "Kitchener" !
d21_postal_code = "N2H5A5" !
print "-i- writing record: "; str$(rec_count% + 1) !
put #21 ! write to file
rec_count% = rec_count% + 1 !
!
d21_first_name = "Ken" !
d21_last_name = "Olsen" !
d21_telephone = "4165553333" !
d21_address = "129 Parker Street" !
d21_city = "Toronto" ! this gets corrected to "Maynard" 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- now will rewrite previous record to force a 'duplicate key' error"
print "-i- writing record: "; str$(rec_count% + 1) !
put #21 ! write to file (will fail)
rec_count% = rec_count% + 1 !
!
handler_error% = 0 ! cool
use !
handler_error% = err ! oops
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" !
rec_count% = 0 ! init
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
while 1 ! loop forever (until we trap out)
get #21, regardless ! read without applying a record lock
rec_count% = rec_count% + 1 !
select rec_count% !
case 1 ! method #1 (plain terminal i/o)
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 !
case 2 ! method #2 (fms mode: use fdv$put)
print !
print "switching to FMS mode" !
sleep 1 !
gosub fms_setup if fms_init% = 0 !
gosub display_fms_form4 if form_up% <> 4 !
!
call fdv$putl("will populate fields one-by-one", 23%) !
sleep 1 !
!
f21_whole_chunk = d21_whole_chunk ! copy data from disk buffer to form buffer
call fdv$put(f21_first_name ,"F$FIRST_NAME" ) ! put data by field name
call fdv$put(f21_last_name ,"F$LAST_NAME" ) !
call fdv$put(f21_telephone ,"F$TELEPHONE" ) !
call fdv$put(f21_address ,"F$ADDRESS" ) !
call fdv$put(f21_city ,"F$CITY" ) !
call fdv$put(f21_postal_code ,"F$POSTAL_CODE") !
!
call fdv$getdl( choice$, term%, 23%, "Record "+str$(rec_count%)+". Hit <enter>" )
case else ! method #3 (fms mode: use fdv$putal)
gosub fms_setup if fms_init% = 0 !
gosub display_fms_form4 if form_up% <> 4 !
!
call fdv$putl("will populate whole form using one call", 23%) !
sleep 1 !
!
f21_whole_chunk = d21_whole_chunk ! copy disk buffer to form buffer
call fdv$putal(f21_whole_chunk) ! populate the form
prev$ = f21_whole_chunk ! remember old data$
!
call fdv$putl("help: <TAB> = next, <ctrl-H> = previous, <enter> = leave form", 22%)
call fdv$putl("Record "+str$(rec_count%), 23%) !
!
call fdv$getal(f21_whole_chunk, term%) ! read the whole form
!
call fdv$putl("", 22%) !
if prev$ = f21_whole_chunk then !
call fdv$getdl(junk$, term%, 23%,"nothing changed. Hit <enter> ...")
else !
call fdv$getdl(junk$, term%, 23%,"something changed. Hit <enter> ...")
end if !
!
end select !
next !
use !
handler_error% = err !
if form_up% > 0 then ! if form #4 is up
form_up% = 0 ! then show it down
call fdv$clear ! clear the fms workspace (and screen)
print vt$normal; ! get rid of reverse video
! print fdv$clear;vt$home; x more stuff
end if !
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 ! 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 (again)
!
! <<< 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 !
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 !
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 ! cool
use !
handler_error% = err ! oops
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
!====================================================================================================
19000 fms_setup: !
call fdv$aterm( TCA by desc, 12%, 5% ) ! attach terminal
call fdv$awksp( WorkSpace4 by desc, k_fsize4% ) ! attach WorkSpace 4
fms_init% = 1 !
return !
!
19010 display_fms_form4: !
call fdv$load ( k_fname4$ ) !
call fdv$dispw !
form_up% = 4 ! show form #4 loaded and up
return !
!
! <<< 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 !
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: "; str$(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.