[comp.os.vms] Strings Utility Part 1 of 1

MNK@DRACO.HAC.COM (Michael N. Kimura) (08/09/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 MNK
$! on  6-APR-1866 20:07:23.75.
$!
$! It contains the following 1 file:
$!        STRINGS.C
$!
$!==============================================================================
$ 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 = "STRINGS.C"
$ CHECKSUM_IS = 1146370530
$ COPY SYS$INPUT VMS_SHARE_DUMMY.DUMMY
X/*----------------------------------------------------------------------
X *
X * Strings.C -- finds strings in a file (' ' <= c <= '~')
X *
X *`009Usage: strings [-hnrt] [-wn] file ...
X *`009`009-h`009no filename headers
X *`009`009-n`009newline instead of space separating strings
X *`009`009-r`009newlines are valid printing characters
X *`009`009-t`009tabs are valid printing characters
X *`009`009-wn`009set mininum word length to n (default 3)
X *`009`009file(s)`009list of filenames (one required)
X *
X *`009Date  : May 2, 1988
X *
X *`009Author: Michael N. Kimura (w/ many thanks to Chris Graves)
X *
X *`009`009Internet:`009mnk%draco@hac2arpa.hac.com
X *`009`009BITnet:`009`009mnk%draco.hac.com
X *
X *`009`009Hughes Aircraft Company (RSG)
X *`009`009MS: R2/A159
X *`009`009P.O. Box 92426
X *`009`009Los Angeles,  CA  90009
X *
X *`009`009(213) 615-9775
X *
X *----------------------------------------------------------------------
X*/
X
X#include errno
X#include descrip
X#include file
X#include rmsdef
X#include ssdef
X#include stdio
X#include stsdef
X#include unixio
X
X#define BUFSIZ`0092048`009/* Buffer size */
X#define DEFWRD`0093`009/* Default minimum word length */
X#define FNSIZ`009256`009/* Maximum filename size */
X
X#define USAGE`009"usage: strings [-hnrt] [-wn] file ...\n"
X
Xmain(argc,argv)
X
Xint`009argc;
Xchar`009*argv[];
X
X{
X`009char`009header = TRUE;`009`009/* Display file headers? */
X`009int`009minword = DEFWRD;`009/* Size of minimum word */
X`009char`009separator = ' ';`009/* Word separation character */
X`009char`009tab = ' ';`009`009/* TAB flag, default off */
X`009char`009nl = ' ';`009`009/* Newline flag, default off */
X
X`009int`009arg;`009`009`009/* Argument index */
X`009int`009fcnt = 0;`009`009/* Filespec counter */
X`009char`009fname[FNSIZ];`009`009/* Filename */
X`009int`009status = SS$_NORMAL;`009/* Final status of STRINGS */
X`009int`009succ;`009`009`009/* VMS Success Code */
X
X`009/*--------------------------------------------------------------*/
X`009/* Get switches from the command line and count the number of`009*/
X`009/* filespecs`009`009`009`009`009`009`009*/
X
X`009get_switches(argc,argv,&fcnt,&header,&minword,&separator,&tab,&nl);
X
X`009/*--------------------------------------------------------------*/
X`009/* One filespec is REQUIRED`009`009`009`009`009*/
X
X`009if (fcnt == 0) {
X`009    printf(USAGE);`009/* Display usage string */
X`009    exit(SS$_BADPARAM | STS$M_INHIB_MSG);
X`009}
X`009`009
X`009/*--------------------------------------------------------------*/
X`009/* Process each filespec`009`009`009`009`009*/
X
X`009for (arg = 1; arg <= argc; arg++) {
X
X`009    /*----------------------------------------------------------*/
X`009    /* Skip args already processed`009`009`009`009*/
X
X`009    if (argv[arg] == 0) continue;
X
X`009    /*----------------------------------------------------------*/
X`009    /* Process each file specification`009`009`009`009*/
X
X`009    while ((succ = find_file(argv[arg],fname)) == RMS$_NORMAL) {
X`009`009succ = strings(fname,header,minword,separator,tab,nl);
X`009`009if ((status == SS$_NORMAL) && (succ & STS$M_SUCCESS) == 0)
X`009`009    status = succ;
X`009    }
X
X`009    /*----------------------------------------------------------*/
X`009    /* Something went wrong in find_file.  Display an error `009*/
X`009    /* message and record the status if this is 1st error`009*/
X
X`009    if (succ != RMS$_NMF) {
X`009`009vms_error("SEARCHFAIL, error searching for ",fname,"",succ);
X`009`009if ((status == SS$_NORMAL) && (succ & STS$M_SUCCESS) == 0)
X`009`009    status = succ;
X`009    }
X`009}
X
X`009/*--------------------------------------------------------------*/
X`009/* Exit with status back to DCL`009`009`009`009`009*/
X
X`009exit(status | STS$M_INHIB_MSG);
X}
X
X/*----------------------------------------------------------------------*/
X/* Strings - Subroutine to find ASCII strings in a file`009`009`009*/
X/*----------------------------------------------------------------------*/
X
Xstrings(fname,header,minword,separator,tab,nl)
X
Xchar`009*fname;`009`009/* File Name */
Xchar`009*header;`009/* Display file headers? */
Xint`009*minword;`009/* Size of minimum word */
Xchar`009*separator;`009/* Word separation character */
Xchar`009*tab;`009`009/* TAB flag, default off */
Xchar`009*nl;`009`009/* Newline flag, default off */
X
X{
X`009int`009fd;`009`009`009/* File Descriptor */
X`009char`009word[BUFSIZ];`009`009/* String */
X
X`009register char`009c;`009`009/* Character */
X`009register int`009cc;`009`009/* Number of chars in word */
X`009register int`009cnt;`009`009/* Number of chars read */
X`009register int`009succ;`009`009/* VMS Success Code */
X
X`009/*--------------------------------------------------------------*/
X`009/* Open the file readonly`009`009`009`009`009*/
X
X`009if ( (fd = open(fname,O_RDONLY,0)) == -1) {
X`009    succ = vaxc$errno;`009`009/* Record open status */
X`009    vms_error("OPENIN, error opening ",fname," as input",succ);
X`009}
X`009else
X`009    succ = RMS$_NORMAL;
X
X`009/*--------------------------------------------------------------*/
X`009/* If the open was successful then proceed`009`009`009*/
X
X`009if (succ & STS$M_SUCCESS) {
X
X`009    /*----------------------------------------------------------*/
X`009    /* Print header if desired`009`009`009`009`009*/
X
X`009    if (header) {
X`009`009printf("\n%s\n\n",fname);
X`009    }
X
X`009    /*----------------------------------------------------------*/
X`009    /* Find strings and print them`009`009`009`009*/
X
X`009    cc = 0;
X`009    while ((cnt = read(fd,&c,1)) && (succ & STS$M_SUCCESS)) {
X
X`009`009/*------------------------------------------------------*/
X`009`009/* Check for read errors`009`009`009`009*/
X
X`009`009if (cnt == -1) {
X`009`009    succ = vaxc$errno;
X`009`009    vms_error("READERR, error reading ",fname,"",succ);
X`009`009    continue;
X`009`009}
X
X`009`009/*------------------------------------------------------*/
X`009`009/* If character is printable then add it to buffer and`009*/
X`009`009/* if the buffer is full then dump it`009`009`009*/
X
X`009`009if ( (' ' <= c && c <= '~') || c == tab || c == nl) {
X`009`009    word[cc++] = c;
X`009`009    if (cc == BUFSIZ) {
X`009`009`009printf("%.*s%c",cc,word,separator);
X`009`009`009cc = 0;
X`009`009    }
X`009`009}
X
X`009`009/*------------------------------------------------------*/
X`009`009/* Character is unprintable, dump the buffer if the`009*/
X`009`009/* buffer is over "minword" characters long `009`009*/
X
X`009`009else {
X`009`009    if (cc >= minword)
X`009`009`009printf("%.*s%c",cc,word,separator);
X`009`009    cc = 0;
X`009`009}
X`009    }
X
X`009    /*----------------------------------------------------------*/
X`009    /* If last buffer is larger then "minword" then dump it`009*/
X
X`009    if (cc >= minword)
X`009`009printf("%.*s%c",cc,word,separator);
X
X`009    /*----------------------------------------------------------*/
X`009    /* Close the file`009`009`009`009`009`009*/
X
X`009    if (close(fd) == -1) {
X`009`009succ = vaxc$errno;
X`009`009vms_error("CLOSERR, error closing ",fname,"",succ);
X`009    }
X
X`009    /*----------------------------------------------------------*/
X`009    /* If the separation character is SP then output \n`009`009*/
X
X`009    if (separator == ' ')
X`009`009printf("\n");
X
X`009}
X`009return succ;
X}
X
X/*----------------------------------------------------------------------*/
X/* Get_Switches - Subroutine to get switches from the command line`009*/
X/*----------------------------------------------------------------------*/
X
Xget_switches(argc,argv,fcnt,header,minword,separator,tab,nl)
X
Xint`009argc;`009`009/* Argument Count */
Xchar`009*argv[];`009/* Argument Vector */
Xint`009*fcnt;`009`009/* Filespec counter */
Xchar`009*header;`009/* Display file headers? */
Xint`009*minword;`009/* Size of minimum word */
Xchar`009*separator;`009/* Word separation character */
Xchar`009*tab;`009`009/* TAB flag, default off */
Xchar`009*nl;`009`009/* Newline flag, default off */
X
X{
X
X`009register int`009arg;`009/* Argument Index */
X`009register char`009*ptr;`009/* Character Pointer */
X
X`009/*--------------------------------------------------------------*/
X`009/* Process switches and count remaining arguments (files)`009*/
X
X`009for (--argc, arg = 1; arg <= argc; arg++) {
X
X`009    /*----------------------------------------------------------*/
X`009    /* Check for leading "-" (indicates a switch)`009`009*/
X
X`009    if ( *(ptr = argv[arg]) == '-') {
X
X`009`009/*------------------------------------------------------*/
X`009`009/* Convert to lowercase and process each switch`009`009*/
X
X`009`009ptr++;
X`009`009*ptr = tolower(*ptr);
X
X`009`009for (; *ptr != NULL; ptr++)
X
X`009`009    switch (*ptr) {
X
X`009`009`009case 'h':`009/* Disable headers */
X`009`009`009    *header = 0;`009`009break;
X
X`009`009`009case 'n':`009/* Separator is \n instead of ' ' */
X`009`009`009    *separator = '\n';`009break;
X
X`009`009`009case 'r':`009/* Newlines are valid printing chars */
X`009`009`009    *nl = '\n';`009`009break;
X
X`009`009`009case 't':`009/* Tabs are valid printing chars */
X`009`009`009    *tab = '\t';`009`009break;
X
X`009`009`009case 'w':`009/* Minimum word length */
X`009`009`009    sscanf(++ptr,"%d",minword);
X`009`009`009    *ptr-- = NULL;`009`009break;
X
X`009`009`009default:`009/* Invalid switch */
X`009`009`009    printf(USAGE);
X`009`009`009    exit(SS$_BADPARAM | 0x10000000);
X`009`009    }
X`009`009argv[arg] = 0;`009`009/* Mark arg as processed */
X`009    }
X`009    else
X`009`009(*fcnt)++;`009`009/* Update filespec counter */
X`009}
X}
X/*----------------------------------------------------------------------*/
X/* Find_File - Subroutine to call LIB$FIND_FILE`009`009`009`009*/
X/*----------------------------------------------------------------------*/
X
X#define MULTIPLE 2
X
Xfind_file(fspec,fname)
X
Xchar`009*fspec;
Xchar`009*fname;
X
X{
X`009static int`009context=0;
X
X`009register int`009succ;
X`009register char`009*ptr;
X
X`009struct dsc$descriptor_s fspec_d = 
X`009    {strlen(fspec), DSC$K_DTYPE_T, DSC$K_CLASS_S, fspec};
X`009struct dsc$descriptor_s fname_d = 
X`009    {FNSIZ, DSC$K_DTYPE_T, DSC$K_CLASS_S, fname};
X
X`009succ = LIB$FIND_FILE(&fspec_d,&fname_d,&context,0,0,0,&MULTIPLE);
X
X`009for(ptr=fname; *ptr != ' '; ptr++)
X`009    ;
X`009*ptr = NULL;
X
X`009return succ;
X}
X/*----------------------------------------------------------------------*/
X/* VMS_Error - Prints text plus VMS error message`009`009`009*/
X/*----------------------------------------------------------------------*/
X
Xvms_error(prefix,fname,suffix,msg_id)
X
Xchar`009*prefix;
Xchar`009*fname;
Xchar`009*suffix;
Xint`009msg_id;
X
X{
X`009char msgbuf[FNSIZ]; 
X`009$DESCRIPTOR(msgdsc,msgbuf);
X
X`009int`009succ;
X`009short`009msglen;
X
X`009succ = LIB$SYS_GETMSG(&msg_id,&msglen,&msgdsc);
X`009if (!(succ & STS$M_SUCCESS)) exit(succ);
X
X`009printf("%%STRINGS-W-%s%s%s\n%.*s\n",prefix,fname,suffix,msglen,msgbuf);
X}
$ GOSUB UNPACK_FILE
$ EXIT