"James_A._Gray.OsbuSouth"@XEROX.COM (05/27/88)
...................... Cut between dotted lines and save. .....................
$!.............................................................................
$! VAX/VMS archive file created by VMS_SHARE V06.00 26-May-1988.
$!
$! VMS_SHARE was written by James Gray (Gray:OSBUSouth@Xerox.COM) from
$! VMS_SHAR by Michael Bednarek (U3369429@ucsvc.dn.mu.oz.au).
$!
$! To unpack, simply save, concatinate all parts into one file and
$! execute (@) that file.
$!
$! This archive was created by user GRAY
$! on 6-APR-1866 20:07:23.76.
$!
$! ATTENTION: To keep each article below 31 blocks (15872 bytes), this
$! program has been transmitted in 3 parts. You should
$! concatenate ALL parts to ONE file and execute (@) that file.
$!
$! It contains the following 1 file:
$! VMS_SHARE.COM
$!
$!==============================================================================
$ SET SYMBOL/SCOPE=( NOLOCAL, NOGLOBAL )
$ VERSION = F$GETSYI( "VERSION" )
$ IF VERSION .GES "V4.4" THEN GOTO VERSION_OK
$ WRITE SYS$OUTPUT "You are running VMS ''VERSION'; ", -
"VMS_SHARE V06.00 26-May-1988 requires VMS V4.4 or higher."
$ EXIT 44
$VERSION_OK:
$ GOTO START
$
$UNPACK_FILE:
$ WRITE SYS$OUTPUT "Creating ''FILE_IS'"
$ DEFINE/USER_MODE SYS$OUTPUT NL:
$ EDIT/TPU/COMMAND=SYS$INPUT/NODISPLAY/OUTPUT='FILE_IS'/NOSECTION -
VMS_SHARE_DUMMY.DUMMY
b_part := CREATE_BUFFER( "{Part}", GET_INFO( COMMAND_LINE, "file_name" ) )
; s_file_spec := GET_INFO( COMMAND_LINE, "output_file" ); SET( OUTPUT_FILE
, b_part, s_file_spec ); b_errors := CREATE_BUFFER( "{Errors}" ); i_errors
:= 0; pat_beg_1 := ANCHOR & "-+-+-+ Beginning"; pat_beg_2 := LINE_BEGIN
& "+-+-+-+ Beginning"; pat_end := ANCHOR & "+-+-+-+-+ End"; POSITION
( BEGINNING_OF( b_part ) ); i_append_line := 0; LOOP EXITIF MARK( NONE
) = END_OF( b_part ); s_x := ERASE_CHARACTER( 1 ); IF s_x = "+" THEN r_skip
:= SEARCH( pat_beg_1, FORWARD, EXACT ); IF r_skip <> 0 THEN s_x := ""
; MOVE_HORIZONTAL( -CURRENT_OFFSET ); ERASE_LINE; ENDIF; ENDIF
; IF s_x = "-" THEN r_skip := SEARCH( pat_end, FORWARD, EXACT ); IF r_skip <
> 0 THEN s_x := ""; MOVE_HORIZONTAL( -CURRENT_OFFSET ); m_skip := MARK( NONE )
; r_skip := SEARCH( pat_beg_2, FORWARD, EXACT ); IF r_skip <> 0 THEN POSITION
( END_OF( r_skip ) ); MOVE_HORIZONTAL( -CURRENT_OFFSET ); MOVE_VERTICAL( 1 )
; MOVE_HORIZONTAL( -1 ); ELSE POSITION( END_OF( b_part ) ); ENDIF; ERASE
( CREATE_RANGE( m_skip, MARK( NONE ), NONE ) ); ENDIF; ENDIF
; IF s_x = "V" THEN s_x := ""; IF i_append_line <> 0 THEN APPEND_LINE
; MOVE_HORIZONTAL( -CURRENT_OFFSET ); ENDIF; i_append_line := 1; MOVE_VERTICAL
( 1 ); ENDIF; IF s_x = "X" THEN s_x := ""; IF i_append_line <
> 0 THEN APPEND_LINE; MOVE_HORIZONTAL( -CURRENT_OFFSET ); ENDIF
; i_append_line := 0; MOVE_VERTICAL( 1 ); ENDIF; IF s_x <> "" THEN i_errors
:= i_errors + 1; s_text := CURRENT_LINE; POSITION( b_errors ); COPY_TEXT
( "The following line could not be unpacked properly:" ); SPLIT_LINE
; COPY_TEXT( s_x ); COPY_TEXT( s_text ); POSITION( b_part ); MOVE_VERTICAL( 1
); ENDIF; ENDLOOP; POSITION( BEGINNING_OF( b_part ) ); LOOP r_x := SEARCH( "`"
, FORWARD, EXACT ); EXITIF r_x = 0; POSITION( r_x ); ERASE_CHARACTER( 1 )
; IF CURRENT_CHARACTER = "`" THEN MOVE_HORIZONTAL( 1 ); ELSE COPY_TEXT( ASCII
( INT( ERASE_CHARACTER( 3 ) ) ) ); ENDIF; ENDLOOP; IF i_errors = 0 THEN SET
( NO_WRITE, b_errors, ON ); ELSE POSITION( BEGINNING_OF( b_errors ) )
; COPY_TEXT( FAO( "The following !UL errors were detected while unpacking !AS"
, i_errors, s_file_spec ) ); SPLIT_LINE; SET( OUTPUT_FILE, b_errors
, "SYS$COMMAND" ); ENDIF; EXIT;
$ DELETE VMS_SHARE_DUMMY.DUMMY;*
$ CHECKSUM 'FILE_IS
$ WRITE SYS$OUTPUT " CHECKSUM ", -
F$ELEMENT( CHECKSUM_IS .EQ. CHECKSUM$CHECKSUM, ",", "failed!,passed." )
$ RETURN
$
$START:
$ FILE_IS = "VMS_SHARE.COM"
$ CHECKSUM_IS = 437494790
$ COPY SYS$INPUT VMS_SHARE_DUMMY.DUMMY
X$ VERIFY = 'F$VERIFY( F$TRNLNM( "COMMAND_DEBUG" ) )
X$ FACILITY_NAME = "VMS_SHARE"
X$ FACILITY_VERSION = "V06.00 26-May-1988"
X$!
X$ SS$_ABORT=44
X$ SET = "SET"
X$ SET SYMBOL/SCOPE=( NOLOCAL, NOGLOBAL )
X$ ON CONTROL_Y THEN EXIT SS$_ABORT
X$ ON ERROR THEN CONTINUE
X$!++
X$! VMS_SHARE was written by James Gray.
X$!
X$! James Gray`009`009`009`009Gray:OSBUSouth@Xerox.COM
X$! Independent Consultant
X$! 875 Victor Avenue, #102
X$! Inglewood, CA 90302
X$! Phone: (213) 412-5086
X$!
X$! Substantial credit is given to Michael Bednarek who wrote the original
X$! VMS_SHAR.
X$!
X$! Michael Bednarek u3369429@{murdu.oz.au | ucsvc.dn.mu.oz.au}
X$! Institute of Applied Economic -- or --
X$! and Social Research (IAESR) ...{UUNET.UU.NET | seismo.CSS.GOV}!munnari!
X$! Melbourne University {murdu.oz | ucsvc.dn.mu.oz}!u3369429
X$! Parkville 3052, Phone : +61 3 344 5744
X$! AUSTRALIA
X$!
X$! The following copyright notice is being left intact since it is unclear
X$! whether this extensive rewrite constitutes a new work or is simply a
X$! derivation of the original. Just in case this constitutes a new work,
X$! a second copyright notice is included below; in case of conflict on
X$! copyrights, the copyright is granted to Michael Bednarek.
X$!
X$! Copyright (c) 1987, by Michael Bednarek
X$! The distribution of this file is unrestricted as long as this notice
X$! remains intact.
X$! Credits: SLOANE@UKANVAX@BITNET (Bob Sloane) for the idea of
X$! quoting control characters.
X$!
X$! Copyright `169 1988, by James Gray
X$! The distribution of this file is unrestricted as long as these notices
X$! remain intact.
X$!
X$! Usage: @VMS_SHARE file[,file...] sharfile
X$!`009where:
X$!`009file[,file...]`009are file names, separated by commas, possibly including
X$!`009`009`009wild-card characters, of those files that are to be
X$!`009`009`009packaged.
X$!`009sharefile`009is the resulting self-unpacking archive file.
X$!
X$! The resulting sharefile will be written in as many parts as is necessary
V$! to keep the size of any one part from being greater than SHARE_MAX_PART_SIZE
X.
X$! By default SHARE_MAX_PART_SIZE is 31 blocks. The user may define a logical
X$! name of the same name to override the default. The minimum
X$! SHARE_MAX_PART_SIZE is 8 blocks.
X$!
X$! The resulting sharefile(s) will have a file type of .n_OF_m if no file type
X$! was specified or will have _n_OF_m appended to the file type; this is true
X$! even if the sharefile fits in one part.
X$!
X$! All parts of the sharefile will be within a few characters of the maximum
X$! part size. Input files may (and probably will) be split between parts.
X$! To unpack files, simply cut the text preceeding the second dotted line,
X$! copy all files into a single file and then execute (@) that file. Checksums
X$! are based on the input files and not on the parts. It is unnecessary to
X$! remove possible garbage characters at the end of each part.
X$!
X$! Input files can be of any length and can span one or more sharefile parts.
X$! (NOTE: This is the original reason for writing this new version.)
X$!
X$! The TPU unpacking code, while left intact in this file for readability, is
X$! packed into 80 (or less) character lines in the sharefile to minimize the
X$! size of the sharefile.
X$!
X$! As with the original VMS_SHAR, this procedure will quote all characters
X$! not in the ASCII range blank (0x20 or 32) to ~ (0x7E or 126).
X$!
X$! Required: VAX/VMS version 4.4 or higher
X$!--
X$!+
X$! Get the user's USERNAME and the parameters if not already specified.
X$!-
X$ USER = F$EDIT( F$GETJPI( "", "USERNAME" ), "COLLAPSE" )
X$ IF F$TYPE( REAL_NAME ) .NES. "" THEN -
X`009USER = USER + " (" + REAL_NAME + ")"
X$ SAY = "WRITE SYS$OUTPUT"
X$ SAY FACILITY_NAME, " ", FACILITY_VERSION
X$ SAY ""
X$ IF P1 .EQS. "" THEN INQUIRE P1 "_File(s) to package"
X$ IF P1 .EQS. "" THEN EXIT SS$_ABORT
X$ IF P2 .EQS. "" THEN INQUIRE P2 "_SHARE file"
X$ IF P2 .EQS. "" THEN EXIT SS$_ABORT
X$ FILE_LIST = P1
X$ SHARE_FILE = F$PARSE( P2 ) - ";"
X$!+
X$! Determine the maximum part size to use.
X$!-
V$ SHARE_MAX_PART_SIZE = 31`009`009`009`009! 31 blocks will keep us below 16000
Xbytes.
V$ X = F$INTEGER( F$TRNLNM( "SHARE_MAX_PART_SIZE") )`009! Allow the user to over
Xride
V$ IF X .GT. 8 THEN SHARE_MAX_PART_SIZE = X`009`009! the maximum size of each p
Xart.
X$ SAY "SHARE_MAX_PART_SIZE is defined as ", SHARE_MAX_PART_SIZE, " blocks (", -
X`009SHARE_MAX_PART_SIZE * 512, " bytes)."
X$!+
V$! Scan the list of supplied files to pack making sure that each one can be fou
Xnd.
X$!-
X$ SAY ""
X$ BEL[0,7] = 7
X$ INDEX = -1
X$ FILE_COUNT = 1
X$NEXT_ELEMENT:
X$ FILE_COUNT = FILE_COUNT - 1
X$ INDEX = INDEX + 1
X$ ELEMENT = F$ELEMENT( INDEX, ",", FILE_LIST )
X$ IF ELEMENT .EQS. "," THEN GOTO ELEMENTS_DONE
X$ PREVIOUS_FILE = "no file"
X$NEXT_FILE:
X$ FILE_COUNT = FILE_COUNT + 1
X$ FILE'FILE_COUNT = F$SEARCH( ELEMENT )
X$ IF FILE'FILE_COUNT .EQS. PREVIOUS_FILE THEN GOTO NEXT_ELEMENT
X$ IF FILE'FILE_COUNT .NES. "" THEN GOTO LOOK
X$ IF PREVIOUS_FILE .EQS. "no file" THEN -
X`009SAY "%VMS_SHARE-I-FNF, file not found: ", ELEMENT
X$ GOTO NEXT_ELEMENT
X$LOOK:
X$ PREVIOUS_FILE = FILE'FILE_COUNT
X$ SAY "Looking at ", File'FILE_COUNT
V$ IF F$ELEMENT( 0, ";", FILE'FILE_COUNT ) .NES. SHARE_FILE THEN GOTO NOT_SHARE_
XFILE
X$ SAY "You can't have your SHARE file among the input files!"
X$ EXIT SS$_ABORT
X$NOT_SHARE_FILE:
X$ GOTO NEXT_FILE
X$ELEMENTS_DONE:
X$!+
X$! Check that there is at least one input file.
X$!-
X$ IF FILE_COUNT .GT. 0 THEN GOTO SOME_FILES
X$ SAY "%VMS_SHARE-W-SEARCHFAIL, error searching for ", P1
X$ SAY "-VMS_SHARE-E-FNF, file not found. No file to package. Nothing done."
X$ EXIT SS$_ABORT
X$SOME_FILES:
X$!+
X$! Write the file that will be used as input to TPU.
X$!-
X$ OPEN/WRITE VMS_SHARE_DUMMY VMS_SHARE_DUMMY.DUMMY
V$ WRITE VMS_SHARE_DUMMY """''USER'"" ""''SHARE_MAX_PART_SIZE'"" ""''FILE_COUNT'
X"" ""''SHARE_FILE'"""
X$ INDEX = 0
X$NEXT_NAME:
X$ INDEX = INDEX + 1
X$ NAME = F$PARSE( FILE'INDEX )
X$ SAY "Checksumming ", File'INDEX
X$ CHECKSUM 'NAME
X$ WRITE VMS_SHARE_DUMMY """''NAME'"" ""''CHECKSUM$CHECKSUM'"""
X$ IF INDEX .LT. FILE_COUNT THEN GOTO NEXT_NAME
X$ CLOSE VMS_SHARE_DUMMY
X$ SAY ""
X$ SAY "Packing files into SHARE file(s) ''SHARE_FILE'"
X$ SAY ""
X$ IF .NOT. F$VERIFY() THEN DEFINE/USER_MODE SYS$OUTPUT NL:
X$ EDIT/TPU/COMMAND=SYS$INPUT/NODISPLAY/NOSECTION VMS_SHARE_DUMMY.DUMMY
XPROCEDURE __copy_text( s_string )
X
X COPY_TEXT( s_string);
X SPLIT_LINE;
X
XENDPROCEDURE;
X
XPROCEDURE __find_buffer (s_buffer_name)
X
X !+
V ! Returns the buffer pointer of an existing buffer or if the buffer does not
Xexist then returns 0.
X !-
X
X LOCAL
X b_buffer,`009`009`009`009! Buffer pointer.
X b_next_buffer,`009`009`009! Next buffer from the list of known buffers.
X s_name;`009`009`009`009! Uppercase form of the supplied buffer name.
X
X ! Upcase the buffer name.
X s_name := s_buffer_name;
X CHANGE_CASE( s_name, UPPER );
X
X ! Initialize loop context to first of the known buffers.
X b_next_buffer := GET_INFO( BUFFERS, 'first' );
X
X ! Loop through all of the known buffers looking for a match.
X LOOP
X
X ! If no more known buffers then done.
X EXITIF b_next_buffer = 0;
X
X ! If this buffer is the one asked for, then done.
X EXITIF s_name = GET_INFO( b_next_buffer, 'name' );
X
X ! Step to the next buffer in the known list of buffers.
X b_next_buffer := GET_INFO( BUFFERS, 'next' );
X ENDLOOP;
X
X ! Return the buffer pointer found or 0.
X RETURN( b_next_buffer );
XENDPROCEDURE
X
XPROCEDURE __find_part_end
X
X MOVE_HORIZONTAL( -CURRENT_OFFSET );
V i_length := LENGTH( s_part_goto ) + LENGTH( s_part_end ) + LENGTH( s_part_beg
Xin ) + LENGTH( s_part_label );
X LOOP
V EXITIF ( MARK( NONE ) = END_OF( b_packed ) ) OR ( i_length >= i_max_part_by
Xtes );
X i_line_length := LENGTH( CURRENT_LINE ) + 2;
X IF ( i_line_length - ( ( i_line_length / 2 ) * 2 ) ) <> 0
X THEN
X i_line_length := i_line_length + 1;
X ENDIF;
X i_length := i_length + i_line_length;
X MOVE_VERTICAL( 1 );
X ENDLOOP;
X IF i_length >= i_max_part_bytes
X THEN
X MOVE_VERTICAL( -1 );
X ENDIF;
X
XENDPROCEDURE;
X
XPROCEDURE __get_quoted_string
X
X POSITION( END_OF( SEARCH( s_quote, FORWARD, EXACT ) ) );
X MOVE_HORIZONTAL( 1 );
X i_offset := CURRENT_OFFSET;
X POSITION( END_OF( SEARCH( s_quote, FORWARD, EXACT ) ) );
X s_string := ERASE_CHARACTER( -( CURRENT_OFFSET - i_offset ) );
X COPY_TEXT( s_string );
X MOVE_HORIZONTAL( 1 );
X RETURN( s_string );
X
XENDPROCEDURE;
X
XPROCEDURE __pack_text( s_string )
X
X MOVE_HORIZONTAL( -1 );
X m_last := MARK( NONE );
X MOVE_HORIZONTAL( 1 );
X COPY_TEXT( s_string);
X COPY_TEXT( s_blank );
X POSITION( m_last );
X MOVE_HORIZONTAL( 1 );
X LOOP
X r_string := SEARCH( pat_blanks, FORWARD, EXACT );
X EXITIF r_string = 0;
X ERASE( r_string );
X POSITION( END_OF( r_string ) );
X COPY_TEXT( s_blank );
X MOVE_HORIZONTAL( -2 );
X ENDLOOP;
X POSITION( m_last );
X MOVE_HORIZONTAL( 1 );
X LOOP
X EXITIF LENGTH( CURRENT_LINE ) <= i_max_line;
X MOVE_HORIZONTAL( -CURRENT_OFFSET + i_max_line );
X r_string := SEARCH( pat_separator, REVERSE, EXACT );
X IF r_string <> 0
X THEN
X POSITION( END_OF( r_string ) );
X SPLIT_LINE;
X MOVE_VERTICAL( 1 );
X MOVE_HORIZONTAL( -1 );
X ENDIF;
X ENDLOOP;
X POSITION( END_OF( CURRENT_BUFFER ) );
X MOVE_HORIZONTAL( -1 );
X
XENDPROCEDURE;
X
Xi_max_line := 79;`009`009`009`009! Maximum length of output line.
Xpat_blanks := " ";`009`009`009`009! Pattern used to collapse blanks.
Xpat_separator := ANY( "!&(),:;>" );`009`009! Pattern used to pack TPU commands.
Xs_blank := " ";`009`009`009`009`009! ASCII blank character.
Xs_facility_name := "VMS_SHARE";`009`009`009! Facility name.
Xs_facility_version := "V06.00 26-May-1988";`009! Facility version number.
Xs_long_line := "V";`009`009`009`009! Long line prefix character.
Xs_quote := '"';`009`009`009`009`009! An ASCII quote character.
Xs_quoting_char := "``";`009`009`009`009! Quoting character.
Xs_short_line := "X";`009`009`009`009! Short line prefix character.
X!+
V! NOTE: The format of the following four strings is such that this routine will
X always work for up to 999 parts.
X!-
Xs_part_begin := "+-+-+-+ Beginning of part !UL +-+-+-+";
Xs_part_end := "-+-+-+-+-+ End of part !UL +-+-+-+-+-";
Xs_part_goto := "$ GOTO PART!UL";
Xs_part_label := "$PART!UL:";
X
X!+
V! Generate a pattern that contains all of the ASCII characters except the print
Xable characters in the range 32 to 126.
V! These will be used to quote characters in this range. In addition, create a
Xbuffer that contains all of the ASCII
X! characters; this will be used to map characters to their decimal equivalents.
X!-
X
Xi_ascii := 0;`009`009`009`009`009! Initialize variable for ASCII decimals.
Vs_control := "";`009`009`009`009! String which will contain all control charact
Xers.
Vs_ascii := "";`009`009`009`009`009! String which will contain all ASCII charact
Xers.
XLOOP
V s_ascii := s_ascii + ASCII( i_ascii );`009! Construct the ASCII character map
Xping string.
X EXITIF i_ascii = 255;`009`009`009`009! Highest ASCII decimal.
X IF ( i_ascii < 32 ) OR ( i_ascii > 126 )
-+-+-+-+-+ End of part 1 +-+-+-+-+-