Directory
Encyclopedia

NodeWorks
                              ENCYCLOPEDIA

Link Checker
Home
Encyclopedia : H : HP : HPB :

HP BASIC for OpenVMS

  

HP BASIC for OpenVMS

HP BASIC for OpenVMS is a commercial strength BASIC with many Fortran-like extensions. One of its biggest strengths is built-in support for OpenVMS's Record Management Services allowing direct manipluation of sequential, relative, and indexed (up to 255 keys) files. Like most other modern BASICs, line numbers are optional unless the "ERL" function is present. Another practical feature is the ability to write error handlers near protected statements over and above the less elegant "ON ERROR" statement. (see the WHEN ERROR blocks in the example program below)

Versions, names

HP BASIC has gone through many name changes, from being ported to several new platforms and due to the merger-mania of 1997–2002:

  • Using their BASIC-PLUS-2 product for the 16-bit PDP-11 minicomputer as a starting point, "VAX BASIC" was developed by Digital Equipment Corporation (DEC) for their 32-bit VAX platform running the VMS operating system.

  • When DEC invented their 64-bit Alpha microprocessor, VMS was ported to it and renamed OpenVMS. VAX BASIC was ported to Alpha and named DEC BASIC. The BASIC interpreter was permanently dropped in the 64-bit product line, which means that DEC BASIC programs could be run on the Alpha via the compile/link method only.

  • When DEC was purchased by Compaq in 1997/98, the products were renamed "Compaq BASIC for OpenVMS VAX" and "Compaq BASIC for OpenVMS Alpha".

  • When Compaq merged with Hewlett-Packard (HP) in 2001/02, the products were renamed "HP BASIC for OpenVMS VAX" and "HP BASIC for OpenVMS Alpha". Since the Compaq division of HP has decided to build new server platforms based upon Intel's 64-bit Itanium chip, we can only assume that we'll eventually see an "HP BASIC for OpenVMS Itanium".

    Sample code

1000 %title "OpenVMS-BASIC-RMS-indexed-demo_xxx.bas" %sbttl "RMS (Record Management Services) Demo" %ident "version 101.2" !
http://www3.sympatico.ca/n.rieck/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 !
">

! title : OpenVMS-BASIC-RMS-indexed-demo_xxx.bas ! author : Neil Rieck (http://www3.sympatico.ca/n.rieck/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 24-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 ! !
 "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 "
>> ! 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 !">
" 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 !

! ! <<< 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 "
>> ! 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 !">
" 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 !

 "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 "">

! ! <<< 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 see 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

External links

  • Official documentation at HP
  • http://www3.sympatico.ca/n.rieck/links/cool_openvms.html#my_demos Free source code for programmers

    • NodeWorks boosts web surfing!
    Page Returned in 1.279 seconds - HTML Compressed 82.7%

    This article is from Wikipedia. All text is available
    under the terms of the GNU Free Documentation License.
     GNU Free Documentation License
    © 2008 Chamas Enterprises Inc.