$! ------------------ CUT HERE -----------------------
$ v='f$verify(f$trnlnm("SHARE_VERIFY"))'
$!
$! This archive created by VMS_SHARE Version 7.2-007  22-FEB-1990
$!   On 20-MAR-1992 17:39:53.27   By user UDAA055 
$!
$! This VMS_SHARE Written by:
$!    Andy Harper, Kings College London UK
$!
$! Acknowledgements to:
$!    James Gray       - Original VMS_SHARE
$!    Michael Bednarek - Original Concept and implementation
$!
$!+ THIS PACKAGE DISTRIBUTED IN 2 PARTS, TO KEEP EACH PART
$!  BELOW 30 BLOCKS
$!
$! TO UNPACK THIS SHARE FILE, CONCATENATE ALL PARTS IN ORDER
$! AND EXECUTE AS A COMMAND PROCEDURE  (  @name  )
$!
$! THE FOLLOWING FILE(S) WILL BE CREATED AFTER UNPACKING:
$!       1. [.PEEK]PEEK.CLD;2
$!       2. [.PEEK]PEEK.DOC;1
$!       3. [.PEEK]PEEKFILE.MAR;1
$!
$set="set"
$set symbol/scope=(nolocal,noglobal)
$f=f$parse("SHARE_TEMP","SYS$SCRATCH:.TMP_"+f$getjpi("","PID"))
$e="write sys$error  ""%UNPACK"", "
$w="write sys$output ""%UNPACK"", "
$ if f$trnlnm("SHARE_LOG") then $ w = "!"
$ ve=f$getsyi("version")
$ if ve-f$extract(0,1,ve) .ges. "4.4" then $ goto START
$ e "-E-OLDVER, Must run at least VMS 4.4"
$ v=f$verify(v)
$ exit 44
$UNPACK: SUBROUTINE ! P1=filename, P2=checksum
$ if f$search(P1) .eqs. "" then $ goto file_absent
$ e "-W-EXISTS, File ''P1' exists. Skipped."
$ delete 'f'*
$ exit
$file_absent:
$ if f$parse(P1) .nes. "" then $ goto dirok
$ dn=f$parse(P1,,,"DIRECTORY")
$ w "-I-CREDIR, Creating directory ''dn'."
$ create/dir 'dn'
$ if $status then $ goto dirok
$ e "-E-CREDIRFAIL, Unable to create ''dn'. File skipped."
$ delete 'f'*
$ exit
$dirok:
$ w "-I-PROCESS, Processing file ''P1'."
$ if .not. f$verify() then $ define/user sys$output nl:
$ EDIT/TPU/NOSEC/NODIS/COM=SYS$INPUT 'f'/OUT='P1'
PROCEDURE Unpacker ON_ERROR ENDON_ERROR;SET(FACILITY_NAME,"UNPACK");SET(
SUCCESS,OFF);SET(INFORMATIONAL,OFF);f:=GET_INFO(COMMAND_LINE,"file_name");b:=
CREATE_BUFFER(f,f);p:=SPAN(" ")@r&LINE_END;POSITION(BEGINNING_OF(b));
LOOP EXITIF SEARCH(p,FORWARD)=0;POSITION(r);ERASE(r);ENDLOOP;POSITION(
BEGINNING_OF(b));g:=0;LOOP EXITIF MARK(NONE)=END_OF(b);x:=ERASE_CHARACTER(1);
IF g=0 THEN IF x="X" THEN MOVE_VERTICAL(1);ENDIF;IF x="V" THEN APPEND_LINE;
MOVE_HORIZONTAL(-CURRENT_OFFSET);MOVE_VERTICAL(1);ENDIF;IF x="+" THEN g:=1;
ERASE_LINE;ENDIF;ELSE IF x="-" THEN IF INDEX(CURRENT_LINE,"+-+-+-+-+-+-+-+")=
1 THEN g:=0;ENDIF;ENDIF;ERASE_LINE;ENDIF;ENDLOOP;t:="0123456789ABCDEF";
POSITION(BEGINNING_OF(b));LOOP r:=SEARCH("`",FORWARD);EXITIF r=0;POSITION(r);
ERASE(r);x1:=INDEX(t,ERASE_CHARACTER(1))-1;x2:=INDEX(t,ERASE_CHARACTER(1))-1;
COPY_TEXT(ASCII(16*x1+x2));ENDLOOP;WRITE_FILE(b,GET_INFO(COMMAND_LINE,
"output_file"));ENDPROCEDURE;Unpacker;QUIT;
$ delete/nolog 'f'*
$ CHECKSUM 'P1'
$ IF CHECKSUM$CHECKSUM .eqs. P2 THEN $ EXIT
$ e "-E-CHKSMFAIL, Checksum of ''P1' failed."
$ ENDSUBROUTINE
$START:
$ create 'f'
Xdefine verb PEEK
X   image UTILDIR:PEEKFILE
X   parameter P1, label=INFILE, prompt="Peek_at_file"
X      value (required,type=$infile)
X   parameter P2, label=OUTFILE, prompt="To_file"
X      value (required,type=$outfile)
X
$ CALL UNPACK [.PEEK]PEEK.CLD;2 792088725
$ create 'f'
XPEEKFILE - Make a readable copy of a file which is otherwise inaccessible`20
X           due to being "open by another user."
X
XAuthor: Christopher F. Chiesa
X
XOVERVIEW:
X--------
X
X   This program uses the QIO-ACP interface to access an input file`20
Xindependent of RMS, and independent of concurrent read and write activity. `
V20
XI use this program to obtain "work in progress" information about`20
Xlong-running batch jobs, in-progress Kermit and XMODEM file-transfers,`20
Xactive EDT journal files, and more.
X
XUSAGE:
X-----
X
X   Build PEEKFILE by assembling and linking the supplied source file`20
XPEEKFILE.MAR.  Set your default directory to that containing PEEKFILE.MAR`20
Xand issue the following two commands:
X
X`09$ MACRO PEEKFILE
X`09$ LINK PEEKFILE
X
X   PEEKFILE is designed to be invoked by a VMS "native command verb,"`20
Xdefined by the accompanying PEEK.CLD file.  Simply issue the command
X
X`09SET  COMMAND  device:`5Bdir.subdir`5DPEEK.CLD
X
X(where "device," "dir," and "subdir" fully specify the path to your copy`20
Xof PEEK.CLD) to give your process the PEEK verb.
X
X  As shipped, PEEK.CLD assumes your copy of PEEKFILE.EXE resides in a
Xdirectory pointed to by the logical name UTILDIR.  You may either define
Xthis logical name to refer to the directory containing your copy of
XPEEKFILE.EXE, _or_ edit PEEK.CLD to change the "UTILDIR:" directory
Xspecification to the directory containing your copy of PEEKFILE.EXE.`20
X
X
XDISCLAIMERS:
X----------
X
X   Some discussion has recently arisen on Usenet following my announcement
Xof this program.  Specifically, some of the same effects as this program`20
Xachieves are claimed for BACKUP/IGNORE=INTERLOCK and even for TYPE.  I have
Xnot tried BACKUP for this application, but have tried TYPE on numerous`20
Xoccasions WITHOUT success.  This-here PEEK utility, on the other hand, has
XNEVER FAILED me, although I make no specific claims that it has any func-
Xtionality absent from BACKUP, TYPE, et al.  (Note that you need the usual
Xfile-access privileges to PEEK files other than your own.)  Use PEEKFILE
Xat your own risk; I assume no responsibility for misbehavior caused on your
Xsystem by the use of PEEKFILE or any other programs of mine.
X
X
XCREDITS/CONTACT INFO:
X--------------------
X
X   If nothing else, PEEKFILE demonstrates use of some of the QIO-ACP`20
Xinterface functions for opening, reading, creating, and writing VMS files`20
Xindependent of RMS.  The source code is liberally commented, so the average
Xprogrammer should (I hope) be able to follow it -- particularly if the`20
XI/O User's Guide, Vol I, is close at hand!
X
X   To discuss PEEKFILE, suggest changes, or submit your own upgrades, you
Xmay contact me through any of the following channels:
X
XUsenet:  e-mail to Chris_F_Chiesa@cup.portal.com`20
X         news posting to the newsgroup or mailing list where you read VMS-
X           related articles
X
XUSMail:  509 Shelford Rd. / Rochester, NY  14609
X
XBellNet: (716) 482-9573
X
X
X
$ CALL UNPACK [.PEEK]PEEK.DOC;1 739470984
$ create 'f'
X`09.library`09\SYS$LIBRARY:LIB\
X`09$FIBDEF
X`09$ATRDEF
X`09$FATDEF
X`09$DSCDEF
X`09$QIODEF
X`09string_size = 255
X;
X`09.macro`09gen_ascid _size
X`09_pc = .
X`09.ascid`09\ \
X`09.blkb`09<_size - 1>
X`09_pc2 = .
X`09. = _pc
X`09.word`09_size
X`09. = _pc2
X`09.endm
X;
X`09.psect`09data`09wrt,noexe,long
Xinfibdesc:`09.long`0946
X`09`09.address -
X`09`09`09infib
Xoutfibdesc:`09.long`0946
X`09`09.address -
X`09`09`09outfib
Xvbn:`09.blkl
X;
Xinfile_access:
X`09$FAB`09NAM=parse_access
Xparse_access:
X`09$NAM`09NOP=<NOCONCEAL>
X;
X;
X`09.align`09long
Xiosb:`09.blkq
Xblock_buffer:
X`09.blkb`09512
Xin_channel:
X`09.blkw
Xout_channel:
X`09.blkw
X;
Xin_attrib_list_ptr:
X`09.address in_attrib_list
Xin_attrib_list:
X`09.word`09ATR$S_RECATTR
X`09.word`09ATR$C_RECATTR
X`09.address in_rec_att_blk
X`09.long`090
X;
Xin_rec_att_blk:
X`09.blkb`09ATR$S_RECATTR
X;
Xout_attrib_list_ptr:
X`09.address out_attrib_list
Xout_attrib_list:
X`09.word`09ATR$S_RECATTR
X`09.word`09ATR$C_RECATTR
X`09.address out_rec_att_blk
X`09.long`090
X;
Xout_rec_att_blk:
X`09.blkb`09ATR$S_RECATTR
X;
Xinfib:`09.blkb`0946
Xoutfib:`09.blkb`0946
X;
Xinparm:
X`09.ascid`09\INFILE\
Xoutparm:
X`09.ascid`09\OUTFILE\
X;
Xinfilename:`09
X`09gen_ascid`09string_size
Xoutfilename:`09
X`09gen_ascid`09string_size
X;
Xtemp_descriptor:
X`09gen_ascid`09string_size
Xexpanded_spec:
X`09gen_ascid`09string_size
X;
X`09.psect`09code`09nowrt,exe
X`09.entry`09filepeek,`5Em<>
X;+
X; Pre-initialize input FIB
X;-
X`09movab`09infib,r2`09`09; R2 => Input FIB address
X`09bisl2`09#<FIB$M_NOLOCK>,-`09; Access file even if open by
X`09`09FIB$L_ACCTL(r2)`09`09;  another user (the whole point
X`09`09`09`09`09;  of this program!)
X;+
X; Parse filename and assign channel to disk, insert FID and DID in FIB:
X;-
X`09pushaq`09infilename`09`09; Input NAME.TYPE, ret'n by desc
X`09pushab`09infibdesc`09`09; Input FIB (modified), by desc.
X`09pushaw`09in_channel`09`09; Input channel # (returned)
X`09pushaq`09inparm`09`09`09; Input file CLI param name `09
X`09calls`09#4,peek_assign`09`09; Obtain filename, open, &
X`09`09`09`09`09;   return Channel # & FIB
X`09blbs`09r0,10$
X`09jmp`09peek_err
X10$:
X;+
X; Similarly pre-initialize output FIB
X;-
X`09movab`09outfib,r3`09`09; R3 => output FIB address
X`09bisl2`09#<FIB$M_WRITE>,-`09; Allow WRITE access to`20
X`09`09FIB$L_ACCTL(r3)`09`09;  output file
X;+
X; Assign channel etc. to output filename
X;-
X`09pushaq`09outfilename
X`09pushab`09outfibdesc
X`09pushaw`09out_channel
X`09pushaq`09outparm
X`09calls`09#4,peek_assign
X`09blbs`09r0,20$
X`09jmp`09peek_err
X20$:
X;+
X; Access the existing input file
X;-
X`09moval`09infilename,r7`09`09`09; R7 => address of filename`20
X`09`09`09`09`09`09;       descriptor
X;
X`09$QIOW_S`09chan=in_channel,-`09`09; Input channel #
X`09`09func=#<IO$_ACCESS!IO$M_ACCESS>,- ; "Access File" function
X`09`09iosb=iosb,-`09`09`09; I/O status block
X`09`09p1=infibdesc,-`09`09`09; FIB by descriptor
X`09`09p2=r7,-`09`09`09`09; Filename by descriptor
X`09`09p5=in_attrib_list_ptr`09`09; Record Attrib. Blk, by ref
X`09blbc`09r0,45$
X`09movzwl`09iosb,r0
X`09blbs`09r0,50$
X45$:
X`09jmp`09peek_err
X50$:
X;+
X; We reach this point having successfully accessed the input file, and in
X; possession of an input FIB and Record Attribute Block chock-full of`20
X; information about the input file.  We copy some vital information from`20
X; the INPUT Record Attribute Block to the OUTPUT Record Attribute Block:
X;-
X`09movab`09in_rec_att_blk,r4`09; R4 => input Record Attribute
X`09`09`09`09`09;       Block address
X`09movab`09out_rec_att_blk,r5`09; R5 => output Record Attribute
X`09`09`09`09`09;`09Block address
X;+
X; Copy input record attributes to output record attributes
X;-
X`09pushr`09#`5Em<r0,r1,r2,r3,r4,r5>
X`09movc3`09#ATR$S_RECATTR,(r4),(r5)
X`09popr`09#`5Em<r0,r1,r2,r3,r4,r5>
X;+
X; Force output EOF block to be same as highest-allocated block:
X;-
X;;`09movl`09FAT$L_HIBLK(r4),FAT$L_EFBLK(r5)`09;; NO LONGER DONE - CFC
X;+
X; Extract "Number of Virtual Blocks allocated to (input) file" value from`20
X; input FIB:
X;-
X`09movw`09FAT$W_HIBLKL(r4),vbn`09; Move words independently since
X`09movw`09FAT$W_HIBLKH(r4),vbn+2`09; they are swapped for PDP-11`20
X`09`09`09`09`09; compatibility... sigh...
X;+
X; If no VB's have been allocated to the input file, there's no point in`20
X; continuing with this program..
X;-
X`09tstl`09vbn`09`09`09; Any data to copy?
X`09bgtr`0962$`09`09`09;  YES: proceed with program
X`09jmp`09peek_err`09`09;   NO: quit
X62$:
X;+
X; The following three instructions were used when this program made an`20
X; EXACT duplicate of the target file; we're actually interested in grabbing
X; MORE data than may actually have been written (e.g. by RMS) to the input
X; file at this time, if at all possible, so we want to use the highest VBN`2
V0
X; value we can get!
X;-
X;;`09tstw`09FAT$W_FFBYTE(r4)`09; Is EOF on a block boundary?
X;;`09bneq`0964$`09`09`09;   NO: no VBN-tweaking needed
X;;`09decl`09vbn`09`09`09;  YES: LAST USED byte is in`20
X;;`09`09`09`09`09;       PREVIOUS virt. block!
X;+
X;+
X; Ensure that the output file allocation is N/N, rather than 0/N :
X;-
X`09movl`09FAT$L_HIBLK(r5),-`09; Make EOF block equal to number
X`09`09FAT$L_EFBLK(r5)`09`09; of blocks allocated...
X;+
X; If the "first free byte" offset is 0, RMS will "subtract 1" from the`20
X; "number of blocks in the file" when queried (e.g. by DIR/FULL) for "file
X; size."  To make the output file look the way we want it to, under those
X; conditions, we pre-INCREMENT the "number of blocks in file" field BEFORE
X; CREATING it...
X;-
X`09tstw`09FAT$W_FFBYTE(r5)`09; Is FF byte BEYOND data EOF?
X`09bneq`0964$`09`09`09;  NO: no RMS compensation needed
X`09incw`09FAT$W_EFBLKL(r5)`09; YES: compensate for RMS "subtract 1"
X`09bneq`0964$`09`09`09; Did low word "wrap" to 0 when INCW'd?
X`09incw`09FAT$W_EFBLKH(r5)`09;  YES: increment high word
X64$:
X`09movl`09vbn,FIB$L_EXSZ(r3)`09; Number of blocks to allocate
X`09clrl`09FIB$L_EXVBN(r3)`09`09; "Must initially be zero" per manual
X`09bisw2`09#<FIB$M_EXTEND>,-`09; Be sure to do an "extend"
X`09`09FIB$W_EXCTL(r3)`09`09;   at creation time
X;+
X; Now that the output FIB and output Record Attributes Block contain the few
V`20
X; items of information necessary for file creation, create the output file!
X;-
X`09moval`09outfilename,r7
X`09$QIOW_S`09chan=out_channel,-
X`09`09func=#<IO$_CREATE!IO$M_CREATE!IO$M_ACCESS>,-
X`09`09iosb=iosb,-
X`09`09p1=outfibdesc,-
X`09`09p2=r7,-
X`09`09p5=out_attrib_list_ptr
X`09blbc`09r0,55$
X`09movzwl`09iosb,r0
X`09blbs`09r0,60$
X55$:
X`09jmp`09peek_err
X60$:
X;+
X; At this point, we should be able to read the input file on in_channel,
X; and write the output file on out_channel.  This is the main loop!
X;
X; NOTE: this version of the program reads and writes in 1-virtual-block
X; chunks.  This could, and should, be optimized to take advantage of larger
X; I/O request sizes when possible.
X;-
X`09$QIOW_S`09chan=in_channel,-`09`09; Read a single block from`20
X`09`09func=#<IO$_READVBLK>,-`09`09; the input file...
X`09`09iosb=iosb,-
X`09`09p1=block_buffer,-
X`09`09p2=#512,-
X`09`09p3=vbn
X;
X`09blbc`09r0,65$
X`09movzwl`09iosb,r0
X`09blbs`09r0,70$
X65$:
X`09jmp`09peek_err
X70$:
X`09$QIOW_S chan=out_channel,-`09`09; ... and write it to the
X`09`09func=#<IO$_WRITEVBLK>,-`09`09; same place in the output`20
X`09`09iosb=iosb,-`09`09`09; file.
X`09`09p1=block_buffer,-
X`09`09p2=#512,-
X`09`09p3=vbn
X`09blbc`09r0,75$
X`09movzwl`09iosb,r0
X`09blbs`09r0,80$
X75$:
X`09jmp`09peek_err
X80$:
X;+
X; Move back one VB, repeat until we've done them all.
X;-
X`09decl`09vbn
X`09bleq`0990$`09`09`09; Any more to copy?  (YES: go do it!)
X`09brw`0960$
X90$:
X;+
X; Now we must DEACCESS all of this...
X;-
X;;+
X;; I have been completely unable to get IO$_DEACCESS to work under any
X;; reasonable conditions I can think of, and have commented this section
X;; out until such time as I receive better information!
X;;-
X;
X;`09$QIOW_S`09chan=out_channel,-`09`09; De-access input file
X;`09`09func=#<IO$_DEACCESS>,-`09
X;`09`09iosb=iosb,-
X;`09`09p1=outfibdesc,-
X;`09`09p5=in_attrib_list_ptr
X;`09blbc`09r0,95$
X;`09movzwl`09iosb,r0
X;`09blbs`09r0,100$
+-+-+-+-+-+-+-+-  END  OF PART 1 +-+-+-+-+-+-+-+-