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 ( http://www3.sympatico.ca/n.rieck/ )
	! 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 OpenVMS
Back to OpenVMS Demo Index
Back to Home
Neil Rieck
Kitchener - Waterloo - Cambridge, Ontario, Canada.