OpenVMS Source Code Demos
sys_file_io_demo.bas
1000 %title "sys_file_io_demo_xxx.BAS" !
%ident "version_100.3" ! <<<---+---
declare string constant k_version = "100.3" , ! <<<---+ &
k_program = "sys_file_io_demo" !
!========================================================================================================================
! Title : sys_file_io_demo_xxx.bas
! Author : Neil S. Rieck ( https://neilrieck.net/ )
! Purpose : Do file i/o the hard way so we will have a little more control over the EOF in the last block
!
! Overview: The need for this demo program began when we were trying to do file uploads to OpenVMS from a browser via an
! interface program written in BASIC. Our technique could not replicate what binary-FTP does. For example, if you FTP any
! image file (gif, jpg, png, etc.) into OpenVMS, the resultant file will have a somewhat strange set of file attributes
! as these two example DCL command examples demonstrate:
!------------------------------------------------------------------------------------------------------------------------
! Example #1
! ==========
! $dir/full skynet-prototype-cpu.jpg
!
! Directory CSMIS$ROOT3:[DVLP._BASIC_DEMO]
!
! skynet-prototype-cpu.jpg;1 File ID: (13274,19,0)
! Size: 46/48 Owner: [SYSTEM]
! Created: 31-MAY-2010 10:50:29.90
! Revised: 31-MAY-2010 10:50:30.40 (1)
! Expires: <None specified>
! Backup: <No backup recorded>
! Effective: <None specified>
! Recording: <None specified>
! Accessed: <None specified>
! Attributes: <None specified>
! Modified: <None specified>
! Linkcount: 1
! File organization: Sequential
! Shelved state: Online
! Caching attribute: Writethrough
! File attributes: Allocation: 48, Extend: 0, Global buffer count: 0, No version limit
! Record format: Fixed length 512 byte records <<<---*** NOTE
! Record attributes: None
! RMS attributes: None
! Journaling enabled: None
! File protection: System:RWED, Owner:RWED, Group:RWED, World:RWED
! Access Cntrl List: None
! Client attributes: None
!
! Total of 1 file, 46/48 blocks.
!------------------------------------------------------------------------------------------------------------------------
! Example #2
! ==========
! $ana/rms skynet-prototype-cpu.jpg
!
! Check RMS File Integrity 3-JUN-2010 08:50:45.49 Page 1
! CSMIS$ROOT3:[DVLP._BASIC_DEMO]skynet-prototype-cpu.jpg;1
!
! FILE HEADER
!
! File Spec: CSMIS$ROOT3:[DVLP._BASIC_DEMO]skynet-prototype-cpu.jpg;1
! File ID: (13274,19,0)
! Owner UIC: [SYSTEM]
! Protection: System: RWED, Owner: RWED, Group: RWED, World: RWED
! Creation Date: 31-MAY-2010 10:50:29.90
! Revision Date: 31-MAY-2010 10:50:30.40, Number: 1
! Expiration Date: none specified
! Backup Date: none posted
! Contiguity Options: none
! Performance Options: none
! Reliability Options: none
! Journaling Enabled: none
!
! RMS FILE ATTRIBUTES
!
! File Organization: sequential
! Record Format: fixed
! Record Attributes:
! Maximum Record Size: 512
! Longest Record: 512
! Blocks Allocated: 48, Default Extend Size: 0
! End-of-File VBN: 46, Offset: %X'0005' ???????????? Huh?
! File Monitoring: disabled
! Global Buffer Count pre-V8.3: 0
! Global Buffer Count post-V8.3: 0
! Global Buffer Flags post-V8.3: none
!
! The analysis uncovered NO errors.
!------------------------------------------------------------------------------------------------------------------------
! Observations:
!
! Notice that the $DIRECTORY command returned:
! "Record format: Fixed length 512 byte records"
! ...whilst the $ANALYZE command indicates than an EOF exists at byte position 5 in block 46. How can the last block
! contain a partial record when "FIXED LENGTH 512 BYTE" was specified?
!
! If you attempt to store a file like this using only BASIC statements, you will end up with a file containing 46 "full"
! blocks (BASIC's run-time libraries enforce full with "FIXED LENGTH 512"). When you perform a $DIFF test between the two
! data files, you will notice that there are data differences in the last block. Using $DUMP will show you that the FTP'd
! file ends in a string of "00" (a.k.a. <nul>) characters whilst the BASIC-created file ends in a string of "20" (a.k.a.
! <sp>) characters.
!
! So now you modify your BASIC program so the last block ends in string of "00" (a.k.a. <nul>) characters then perform the
! $DIFF test again and the test appears to pass. ($ANALYZE still shows structural differences)
!
! Now FTP the BASIC-produced data file back to Windows. It will be a little bit longer than the original file but will
! appear to work. But is this guaranteed to work with every file including Excel spread sheets and MS power points?
! Maybe, maybe not.
!
! Possible Solutions:
! 1) Rewrite your interface program in "C" where we will have more control because we are closer to the metal. Of course
! this will only be possible if you have a "C" Compiler License -AND- your shop allows other languages. (suprisingly,
! not everyone can maintain a "C" program)
! 2) In BASIC, create a file that is opened with RECORDSIZE 512, RECORDTYPE NONE, ORGANIZATION SEQUENTIAL VARIABLE, then
! make sure all your records are 512 byte strings except the last one. Close the file then do a systyem call to change
! the RMS file attributes from variable to fixed.
! 3) In BASIC, create a file that is opened without a MAP string. the you will need to use "MOVE TO" followed by "PUT".
! This did not work but maybe I have not stumbled on the correct syntax.
! 4) In BASIC, create a file that is opened without a MAP string. the you will need to use "PRINT #" with 512 byte
! variable strings everytime except in the last print. This did seem to work but threw an error upon CLOSE
! 5) Have BASIC call VMS system library routines like SYS$OPEN and SYS$PUT to write the data using 512 byte records. On
! the last record, reduce the record size to write out a smaller amount. THIS WORKS. <<<
!
! History :
! Ver Who When What
! --- --- ------ --------------------------------------------------------------------------------------------------------
! 100 NSR 100601 1. started original program
! NSR 100602 2. more work
! NSR 100603 3. more work
!========================================================================================================================
option type=explicit ! cuz tricks are for kids
!
! import definitions from the system library
!
%include "starlet" %from %library "sys$library:basic$starlet" ! system services
%include "$ssdef" %from %library "sys$library:basic$starlet" ! ss$
%include "$rmsdef" %from %library "sys$library:basic$starlet" ! rms$
%include "$fabdef" %from %library "sys$library:basic$starlet" ! fab$
%include "$rabdef" %from %library "sys$library:basic$starlet" ! rab$
!
! program variables + constants
!
declare string constant dq = '34'C ! <double quote>
declare string constant cr_lf = cr + lf ! <cr> + <lf>
declare string constant k_test_file = "sys_file_io_demo_hack.dat" !
!
map(db512) string data_512 = 512 ! data buffer
!
declare FABDEF my_fab ! define a fab (file access block)
declare RABDEF my_rab ! define a rab (record access block)
declare long debug% , &
junk% , &
junk2% , &
new_data_file_flag% , &
weekday% , &
i% , &
j% , &
k% , &
handler_error% , &
record_num% , &
rc% , &
string junk$ , &
temp$ , &
out$ , &
word chan% , &
record_size_w% !
!
!========================================================================================================================
! main
!========================================================================================================================
main:
debug% = 3 !
print string$(len(k_program +"_"+ k_version), asc("="))
print k_program +"_"+ k_version !
print string$(len(k_program +"_"+ k_version), asc("=")) ! what will the optimizer do with this?
!
! delete test file?
!
print "OK to delete file '"+ k_test_file +"'? (y/N )"; !
input junk$ !
select left$(edit$(junk$,32+2),1) !
case "Y" !
print "-i-deleting file: "+ k_test_file !
when error in !
while 1 !
kill k_test_file !
next !
use !
end when !
new_data_file_flag% = 1 !
end select !
print "=================================================="
!
! use BASIC to create test file with data?
!
print "set up menu:" !
print "1. use BASIC to create and populate a testfile" !
print " (necessary for testing the sys$open and sys$get routines)" !
print "2. use BASIC to create an empty testfile" !
print " (necessary for testing the sys$put and sys$write routines)" !
print "3. do nothing" !
print " (everything will be done with system calls)" !
input "choice? (1-3, default=3) ";junk$ !
junk$ = left$(edit$(junk$,32+2),1) !
select junk$ !
case "1" to "2" !
when error in !
print "-i-open" !
open k_test_file for output as #99 &
,organization sequential fixed &
,recordtype none &
,map db512 !
new_data_file_flag% = 1 !
goto skip_basic_puts if junk$ <> "1" !
junk% = 0 !
while junk% < 9 !
junk% = junk% + 1 !
data_512 = "record: "+ str$(junk%) +" written with BASIC"
print "-i-put" !
put #99 !
next !
new_data_file_flag% = 0 !
!
skip_basic_puts: !
close #99 !
use !
print "-i-error: "+ str$(err) !
end when !
end select !
print "=================================================="
!
!========================================================================================================================
! open the data file (create it if it doesn't exist)
!========================================================================================================================
print "-i-entering sys$ area of the demo" !
!
! set up the FAB (file access block)
!
map(fn255) string file_name$ = 255 ! fielname buffer (room for 255 characters)
file_name$ = k_test_file !
!
record_size_w% = 512 ! or len(data_512)
!
my_fab::fab$b_bid = fab$c_bid ! block id (FAB)
my_fab::fab$b_bln = fab$c_bln ! FAB block len (default)
!~~~ my_fab::fab$b_rfm = fab$c_udf x record format: undefined record type
my_fab::fab$b_rfm = fab$c_fix ! record format: fixed
my_fab::fab$l_alq = 1 ! initial allocation quantity
my_fab::fab$l_fna = loc( file_name$) ! file name address
my_fab::fab$b_fns = len( edit$(file_name$, 2)) ! file name size
my_fab::fab$w_mrs = record_size_w% ! maximum record size
my_fab::fab$b_fac = ! file access: &
fab$m_bro or ! block or record operations &
fab$m_upd or ! can update &
fab$m_get or ! can get &
fab$m_put ! can put
!~~~ my_fab::fab$b_shr = fab$m_upi x share: user process interlock (disable RMS
!~~~ x locking)
!~~~ my_fab::fab$l_fop = fab$m_ufo x file operation: user file open (RMS is limited
!~~~ x to $create or $open)
!
! set up the RAB (file access block)
!
! references:
! 1. "Guide to OpenVMS File Applications"
! http://www.openvms.compaq.com/doc/731final/4506/4506pro_027.html
! 2. "OpenVMS Record Management Services Reference Manual"
! http://www.openvms.compaq.com/doc/731final/4523/4523pro_011.html
!
my_rab::rab$b_bid = rab$c_bid ! this block is a RAB
my_rab::rab$b_bln = rab$c_bln ! this structure is a traditional 32-bit RAB
my_rab::rab$l_fab = loc(my_fab) ! address of my FAB
my_rab::rab$b_rac = RAB$C_SEQ ! sequential
my_rab::rab$l_rop = RAB$M_WBH ! write behind
my_rab::rab$l_rbf = loc(data_512) ! record buffer address (to be written)
my_rab::rab$w_rsz = record_size_w% ! record size (to be written)
my_rab::rab$l_ubf = loc(data_512) ! user buffer addr (applies to $GET only)
my_rab::rab$w_usz = record_size_w% ! user buffer size (applies to $GET only)
!=======================================================================
! sys$open / sys$create
!=======================================================================
print "-i-calling sys$open" if debug% >= 1 !
rc% = sys$open ( my_fab ) ! open the file
if (rc% and 7%) <> 1% then ! if error...
if debug% >=1 then !
print "-e-sys$open rc: ";str$(rc%) !
print "-i-so creating data file" !
print "-i-calling sys$create" !
end if !
rc% = sys$create ( my_fab ) ! attempt a create
if (rc% and 7%) <> 1% then ! if create error
print "-e-sys$create rc: "+ str$(rc%) !
goto fini_rc ! adios...
else ! if create was successful
print "-i-sys$create rc: ";str$(rc%) if debug% >= 1 !
new_data_file_flag% = 1 ! we need to initialize the data <<<<<<<<<<
end if !
else ! else no error...
print "-i-sys$open rc: ";str$(rc%) if debug% >= 1 ! if open was successful
end if !
!
chan% = my_fab::fab$l_stv ! remember i/o channel number
!=======================================================================
! sys$connect (to RAB)
!=======================================================================
rc% = sys$connect( my_rab )
if (rc% and 7%) <> 1% then ! if error...
print "-e-sys$connect rc: ";str$(rc%) !
print "-i-rab status code : ";my_rab::RAB$L_STS !
print "-i-rab status value: ";my_rab::RAB$L_STV !
else ! else no error...
print "-i-sys$connect rc: ";str$(rc%) if debug% >= 1 ! if $connect was successful
end if !
!
if new_data_file_flag% = 1 then ! if we need to initialize the data <<<<<<<<<<
new_data_file_flag% = 0 ! clear one-time flag
input "write some data to the new file? (y/N)"; junk$ !
select left$(edit$(junk$,32+2),1) !
case "Y" !
case else !
goto skip_write !
end select !
!
junk% = 0
do_write:
junk% = junk% + 1
data_512 = "record: "+ str$(junk%) +" written with OpenVMS sys$put"
rc% = sys$put( my_rab ) !
if (rc% and 7%) <> 1% then !
print "-e-sys$put rc: ";str$(rc%) !
else !
print "-i-sys$put rc: ";str$(rc%) !
goto do_write if junk% < 3 !
end if !
!
junk% = junk% + 1 !
data_512 = "record: "+ str$(junk%) +" written with OpenVMS sys$write"
junk% = len(edit$(data_512,128)) ! how much space do we "need"
print "-i-hack: attempting to write a block shorter than "+ str$(record_size_w%)
my_rab::rab$w_rsz = junk% ! only need to tweak rab$w_rsz
!~~~ my_rab::rab$w_usz = junk% x
rc% = sys$write( my_rab ) ! sys$write pays closer attention to the RAB
if (rc% and 7%) <> 1% then !
print "-e-sys$write rc: ";str$(rc%) !
else !
print "-i-sys$write rc: ";str$(rc%) !
end if !
!
! restore initial rab value(s)
!
my_rab::rab$w_rsz = record_size_w% ! only need to restore rab$w_rsz
!~~~ my_rab::rab$w_usz = record_size_w% x
end if !
skip_write:
!=======================================================================
! sys$rewind
!=======================================================================
rc% = sys$rewind ( my_rab ) !
if (rc% and 7%) <> 1% then ! if error...
print "-e-sys$rewind rc: ";str$(rc%) !
else !
print "-i-sys$rewind rc: ";str$(rc%) if debug% >= 1 ! if $rewind was successful
end if !
!=======================================================================
! sys$get
!=======================================================================
get_more: !
rc% = sys$get ( my_rab ) !
if (rc% and 7%) <> 1% then ! if error...
print "-e-sys$get rc: ";str$(rc%) !
else !
print "-i-sys$get rc: ";str$(rc%) if debug% >= 1 ! if $get was successful
print "-i-data: "+ edit$(data_512,128) !
goto get_more !
end if !
!=======================================================================
! sys$disconnect
!=======================================================================
rc% = sys$disconnect ( my_rab )
if (rc% and 7%) <> 1% then ! if error...
print "-e-sys$disconnect rc: ";str$(rc%) !
else !
print "-i-sys$disconnect rc: ";str$(rc%) if debug% >= 1 ! if $disconnect was successful
end if !
!=======================================================================
! sys$close
!=======================================================================
rc% = sys$close ( my_fab ) !
if (rc% and 7%) <> 1% then ! if error...
print "-e-sys$close rc: ";str$(rc%) !
else !
print "-i-sys$close rc: ";str$(rc%) if debug% >= 1 ! if $close was successful
end if !
!
goto fini
!========================================================================================================================
! That's all folks...
!========================================================================================================================
fini_rc: !
goto fini_common !
!
fini:
rc% = 1 ! assume success ("-s-")
!
fini_common: !
end program rc% ! return code to caller
!------------------------------------------------------------------------------------------------------------------------
Back to HomeNeil Rieck
Waterloo, Ontario, Canada.