From:	SMTP%"DSJ@WKUVX1.WKU.EDU"  9-APR-1994 15:23:54.67
To:	EVERHART
CC:	
Subj:	APRIL94.RECLOK

Message-Id: <9404091922.AA24068@uu7.psi.com>
X-Fileserver: Digital Systems Journal File Server <DSJ@WKUVX1.WKU.EDU>
Date: Sat, 09 Apr 1994 14:22:50 CDT
Sender: DSJ-Mgr@WKUVX1.WKU.EDU
Errors-To: DSJ-Mgr@WKUVX1.WKU.EDU
Warnings-To: <>
From: DSJ-Mgr@WKUVX1.WKU.EDU
Reply-To: DSJ@WKUVX1.WKU.EDU
Subject: APRIL94.RECLOK
To: EVERHART@arisia.gce.com

$! ------------------ CUT HERE -----------------------
$ v='f$verify(f$trnlnm("SHARE_UNPACK_VERIFY"))'
$!
$! This archive created:
$!  Name : RECLOK
$!  By   : @WKUVX1.BITNET <goathunter@WKUVX1.WKU.EDU>
$!  Date :  8-APR-1994 05:05:11.08
$!  Using: VMS_SHARE 8.4, (C) 1993 Andy Harper, Kings College London UK
$!
$! Credit is due to these people for their original ideas:
$!    James Gray, Michael Bednarek 
$!
$! 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. RECLOK.DSJ;2
$!
$ set="set"
$ set symbol/scope=(nolocal,noglobal)
$ f=f$parse("SHARE_UNPACK_TEMP","SYS$SCRATCH:."+f$getjpi("","PID"))
$ e="write sys$error  ""%UNPACK"", "
$ w="write sys$output ""%UNPACK"", "
$ if .not. f$trnlnm("SHARE_UNPACK_LOG") then $ w = "!"
$ if f$getsyi("CPU") .gt. 127 then $ goto start
$ 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, P3=attributes,P4=size
$ 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:
$ x=f$search(P1)
$ if x .eqs. "" then $ goto file_absent
$ e "-W-EXISTS, File ''P1' exists. Skipped"
$ delete 'f'*
$ exit
$file_absent:
$ w "-I-UNPACK, Unpacking ", P5, " of ", P6, " - ", P1, " - ", P4, " Blocks"
$ n=P1
$ if P3 .nes. "" then $ n=f
$ if .not. f$verify() then $ define/user sys$output nl:
$ EDIT/TPU/NOSEC/NODIS/COM=SYS$INPUT/NOJOURNAL 'f'/OUT='n'
PROCEDURE GetHex(s,p)LOCAL x1,x2;x1:=INDEX(t,SUBSTR(s,p,1))-1;x2:=INDEX(t,
SUBSTR(s,p+1,1))-1;RETURN 16*x1+x2;ENDPROCEDURE;PROCEDURE SkipPartsep LOCAL m;
LOOP m:=MARK(NONE);EXITIF m=END_OF(b);DELETE(m);EXITIF INDEX(ERASE_LINE,
"-+-+-+-+-+-+-+-+")=1;ENDLOOP;ENDPROCEDURE;PROCEDURE ProcessLine LOCAL c,s,l,b,
n,p;c := ERASE_CHARACTER(1);s := ERASE_LINE;IF c = "X" THEN SPLIT_LINE; ENDIF;
MOVE_HORIZONTAL(-1);l := LENGTH(s);p := 1;LOOP EXITIF p > l;c := SUBSTR(s,p,1);
p := p+1;CASE c FROM ' ' TO '`' ['`']: COPY_TEXT(ASCII(GetHex(s,p))); p:=p+2;[
' ']: p:=p+1;[INRANGE,OUTRANGE]: COPY_TEXT(c);ENDCASE;ENDLOOP;ENDPROCEDURE;
PROCEDURE Decode LOCAL m;POSITION(BEGINNING_OF(b));LOOP m:=MARK(NONE);EXITIF m=
END_OF(b);DELETE(m);IF INDEX(CURRENT_LINE,"+-+-+-+-+-+-+-+-")=
1 THEN SkipPartSep;ELSE ProcessLine;MOVE_HORIZONTAL(1);ENDIF;ENDLOOP;
ENDPROCEDURE;SET(FACILITY_NAME,"UNPACK");SET(SUCCESS,OFF);SET(INFORMATIONAL,
OFF);t:="0123456789ABCDEF";f:=GET_INFO(COMMAND_LINE,"file_name");b:=
CREATE_BUFFER(f,f);Decode;WRITE_FILE(b,GET_INFO(COMMAND_LINE,"output_file"));
QUIT;
$ if p3 .eqs. "" then $ goto dl
$ open/write fdl &f
$ write fdl "RECORD"
$ write fdl P3
$ close fdl
$ w "-I-CONVRFM, Converting record format to ", P3
$ convert/fdl=&f &f-1 &P1
$dl: delete 'f'*
$ checksum 'P1'
$ if checksum$checksum .nes. P2 then $ -
  e "-E-CHKSMFAIL, Checksum of ''P1' failed."
$ exit
$ endsubroutine
$start:
$!
$ create 'f'
Xfind_record_locker.com
X
X$!`20find`20out`20who`20has`20a`20particular`20record`20locked`20in`20any`20fi
Vle
X$!`20cha`2018-oct-93
X$!
X$`20inq`20x_filename`20"ENTER`20THE`20FILE`20TO`20OPEN`20"
X$`20INQ`20x_keystr`20"ENTER`20THE`20KEY`20OF`20THE`20LOCKED`20RECORD"
X$`20!
X$`20!`20cha`20`20get`20file`20id`20and`20pass`20to`20program`20to`20id`20the
V`20file`20we`20want
X$`20!`20`20`20`20`20`20to`20find`20the`20locked`20record`20in
X$`20`20f_fid`20=`20f$file_att(X_FILENAME,"FID")
X$`20`20f_fid`20=`20f_fid`20-`20"("`20-`20")"`09`09!`20remove`20parens
X$`20`20FID1`20=`20F$ELEMENT(0,",",F_FID)
X$`20`20FID2`20=`20F$ELEMENT(1,",",F_FID)
X$`20`20FID3`20=`20F$ELEMENT(2,",",F_FID)
X$`20`20FLZ`20:=`20$SYS$LOGIN:FIND_REC_LOCKER.EXE
X$`20`20FLZ`20'x_filename'/'x_keystr'/'fid1'/'fid2'/'fid3'
X$`20!
X$`20`20EXIT
X
X
X`0C
X
Xfind_rec_locker.bas
X
X%TITLE`20"FIND`20RECORD`20LOCKER"
X%IDENT`20"V1.001"
XPROGRAM`20FIND_REC_LOCKER`09`20`20`20`20!`20find`20the`20person`20locking`20a
V`20record`20in`20a`20file
X
X`20`20`20`20!PROGRAM`20ABSTRACT:
X`20`20`20`20!
X`20`20`20`20!`09This`20program`20will`20open`20any`20file,`20find`20the`20spec
Vified`20locked`20record,
X`20`20`20`20!`09and`20show`20who`20has`20the`20record`20locked.
X`20`20`20`20!
X`20`20`20`20!+
X`20`20`20`20!`20FACILITY:
X`20`20`20`20!`20
X`20`20`20`20!`09NONE
X`20`20`20`20!`20
X`20`20`20`20!`20PROGRAM`20DESCRIPTION:
X`20`20`20`20!`20
X`20`20`20`20!`09Accept`20a`20foriegn`20command,`20which`20is`20the`20name`20of
V`20the`20file`20to`20open,`20the
X`20`20`20`20!`20`20`20primary`20key`20of`20the`20locked`20record,`20and`20the
V`203`20words`20of`20the`20file`20id.
X`20`20`20`20!
X`20`20`20`20!`09Open`20the`20file,`20get`20the`20specified`20record,`20making
V`20sure`20that`20it`20is`20still
X`20`20`20`20!`09locked.
X`20`20`20`20!
X`20`20`20`20!`20`20`20Get`20the`20rfa`20of`20the`20record,`20which`20is`20used
V`20to`20build`20the`20resource`20name`20of
X`20`20`20`20!`09the`20record`20lock.
X`20`20`20`20!
X`20`20`20`20!`09loop`20through`20all`20locks,`20looking`20for`20any`20and`20al
Vl`20file`20locks`20on`20the
X`20`20`20`20!`09specified`20file,`20and`20saving`20the`20lock`20ids.
X`20`20`20`20!
X`20`20`20`20!`09loop`20through`20all`20the`20locks`20again,`20looking`20for`20
Vany`20locks`20which`20have`20the
X`20`20`20`20!`09above`20file`20locks`20as`20their`20parent`20id.`20`20Check`20
Vthe`20resource`20name`20of`20these
X`20`20`20`20!`09locks`20against`20the`20record`20rfa`20to`20find`20the`20lock
V`20we`20are`20looking`20for
X`20`20`20`20!
X`20`20`20`20!`09Using`20the`20pid`20from`20the`20lock,`20get`20the`20user`20in
Vfo`20we`20want`20to`20display`20to
X`20`20`20`20!`09tell`20us`20who`20has`20that`20record`20locked.
X`20`20`20`20!`20
X`20`20`20`20!`20AUTHORS:
X`20`20`20`20!`20
X`20`20`20`20!`09Chuck`20Abraham`09(INTRACORP,`20Berwyn,`20PA)
X`20`20`20`20!`20
X`20`20`20`20!`20CREATION`20DATE:`2018-Oct-1993
X`20`20`20`20!`20
X`20`20`20`20!`20MODIFICATION`20HISTORY:
X`20`20`20`20!`09`20`20`20`20Who`09`20`20`20`20Vers`20`20`20`20`20`20Date`09Des
Vcription
X`20`20`20`20!`09`20`20`20`20---`09`20`20`20`20------`20`20---------`09--------
V-----------------------------
X`20`20`20`20!???
X`20`20`20`20!???`20`20`20`20CHA`20`20`20`20`20V1.001`20`20`2010-18-93`09Origin
Val`20version
X`20`20`20`20!???
X`20`20`20`20!`20
X
X`20`20`20`20option`20type=explicit
X
X`20`20`20`20%include`20"$LKIDEF"`20%FROM`20%LIBRARY`20"SYS$LIBRARY:BASIC$STARL
VET.TLB"
X
XRECORD`20item_rec
X`20`20`20`20WORD`20item_len
X`20`20`20`20WORD`20item_code
X`20`20`20`20LONG`20item_addr
X`20`20`20`20LONG`20item_rtn_len_addr
XEND`20RECORD
X
X!`20Declare`20Local`20Variables
X!
XDECLARE`09`09`09`09`09`09`09`09`09`26
X`20`20`20`20STRING`09`09`09`09`09`09`09`09`26
X`09x_infile,`09`09`09`09`09`09`09`26
X`09x_resname,`09`09`09`09`09`09`09`26
X`09x_key_string,`09`09`09`09`09`09`09`26
X`09x_dummy,`09`09`09`09`09`09`09`26
X`09x_imagename,`09`09`09`09`09`09`09`26
X`09x_username,`09`09`09`09`09`09`09`26
X`09x_procname,`09`09`09`09`09`09`09`26
X`09x_for_cmd(1`20to`205),`09`09`09`09`09`09`26
X`20`20`20`20BYTE`09`09`09`09`09`09`09`09`26
X`09b_continue,`09`09`09`09`09`09`09`26
X`20`20`20`20WORD`09`09`09`09`09`09`09`09`26
X`09w_fileid(0`20to`202),`09`09`09`09`09`09`26
X`09w_file_id(0`20to`202),`09`09`09`09`09`09`26
X`09w_rfa_word(0`20to`202),`09`09`09`09`09`09`26
X`20`20`20`20LONG`09`09`09`09`09`09`09`09`26
X`09l_rec_locked,`09`09`09`09`09`09`09`26
X`09l_loop,`09`09`09`09`09`09`09`09`26
X`09l_loop1,`09`09`09`09`09`09`09`26
X`09l_num_parents,`09`09`09`09`09`09`09`26
X`09l_reslen,`09`09`09`09`09`09`09`26
X`09l_resaddr,`09`09`09`09`09`09`09`26
X`09l_return_status,`09`09`09`09`09`09`26
X`09l_return_stat,`09`09`09`09`09`09`09`26
X`09l_lockid,`09`09`09`09`09`09`09`26
X`09l_refcnt,`09`09`09`09`09`09`09`26
X`09l_parent_id(0`20to`2050),`09`09`09`09`09`09`26
X`09l_parent,`09`09`09`09`09`09`09`26
X`09l_pid,`09`09`09`09`09`09`09`09`26
X`09l_temp,`09`09`09`09`09`09`09`09`26
X`09l_parts,`09`09`09`09`09`09`09`26
X`09l_lkid
X
XDECLARE`20item_rec`20itmlst(6%)
X
Xmap`20(call_list)`20long`09call_param(0`20to`202)
X
Xmap`20(rfa_map)`09rfa`09rec_rfa
Xmap`20(rfa_map)`09word`09rfa_word(0`20to`202)
Xmap`20(rfa_map)`09string`09rfa_string`20=`206%
X
XMAP`20(TEMP)`09STRING`09WORD_STR`20=`202%
XMAP`20(TEMP)`09WORD`09w_resval
X
XEXTERNAL`20INTEGER`20FUNCTION`20LIB$GETJPI
XEXTERNAL`20INTEGER`20FUNCTION`20LIB$GET_FOREIGN
XEXTERNAL`20INTEGER`20FUNCTION`20SYS$CMKRNL
XEXTERNAL`20INTEGER`20CONSTANT`20GET_LOCK_INFO
XEXTERNAL`20INTEGER`20FUNCTION`20LIB$GET_VM
XEXTERNAL`20INTEGER`20FUNCTION`20LIB$SCOPY_R_DX
XEXTERNAL`20STRING`20`20FUNCTION`20HEX$
XEXTERNAL`20LONG`20`20`20`20FUNCTION`20PIECE
X
XEXTERNAL`20LONG`20CONSTANT`20SS$_NORMAL
X
Xexternal`20long`20constant`09`09`09jpi$_imagname`09`09`09`26
X`09`09`09,`09`09jpi$_username`09`09`09`26
X`09`09`09,`09`09jpi$_prcnam`09`09`09`26
X
X%SBTTL`20'Main`20Module'
X
X`20`20`20`20!`20foreign`20command`20will`20be`20in`20the`20format`20filename/k
Vey/fid1/fid2/fid3
X
X`20`20`20`20l_return_status`20=`20lib$get_foreign(x_dummy)
X`20`20`20`20if`20(l_return_status`20and`201%)`20<>`201%`20then
X`09print`20"error`20in`20lib$get_foreign`20=`20";l_return_status
X`09print`20"Please`20pass`20parameters`20or`20use`20front`20end`20command`20fi
Vle"
X`09exit`20program
X`20`20`20`20end`20if
X
X`20`20`20`20l_return_status`20=`20piece(x_dummy,x_for_cmd(),"/",l_parts)
X`20`20`20`20if`20l_parts`20<>`205%`09then`09`09!`20expecting`205`20parts
X`09print`20"Not`20enough`20info`20passed`20to`20program"
X`09print`20"Please`20use`20the`20front`20end`20command`20file`20for`20this`20p
Vrogram"
X`09exit`20program
X`20`20`20`20end`20if
X
X`20`20`20`20x_infile`09`20`20`20`20=`20x_for_cmd(1%)`09`09`20`20`20`20!`20file
Vname
X`20`20`20`20x_key_string`20`20`20`20=`20x_for_cmd(2%)`09`09`20`20`20`20!`20pri
Vmary`20key
X`20`20`20`20w_fileid(0%)`20`20`20`20=`20integer(x_for_cmd(3%),WORD)`20`20`20!
V`20first`20word`20of`20file`20id
X`20`20`20`20w_fileid(1%)`20`20`20`20=`20integer(x_for_cmd(4%),WORD)`20`20`20!
V`20second`20word`20of`20file`20id
X`20`20`20`20w_fileid(2%)`20`20`20`20=`20integer(x_for_cmd(5%),WORD)`20`20`20!
V`20third`20word`20of`20file`20id
X
X`20`20`20`20gosub`20open_file`09`09`09`09`20`20`20`20!`20open`20the`20file
X
X`20`20`20`20l_rec_locked`20=`200%
X`20`20`20`20when`20error`20in
X`09get`20#1,`20key`20#0%`20eq`20x_key_string`09`09`20`20`20`20!`20see`20if`20t
Vhe`20record`20is
X`20`20`20`20use`09`09`09`09`09`09`20`20`20`20!`20really`20locked
X`09select`20err
X`09`20`20`20`20case`20154%
X`09`09l_rec_locked`20=`20-1%`09`09`20`20`20`20!`20okay,`20continue
X`09`09continue
X`09`20`20`20`20case`20else
X`09`09print`20err,ert$(err)`09`09`20`20`20`20!`20some`20other`20error,`20get
V`20out
X`09`09exit`20handler
X`09end`20select
X`20`20`20`20end`20when
X
X`20`20`20`20if`20l_rec_locked`20then`09`09`09`20`20`20`20!`20get`20locked`20re
Vcord
X`09when`20error`20in`09`09`09`09`20`20`20`20!`20so`20we`20can`20get`20rfa
X`09`20`20`20`20get`20#1%,`20key`20#0%`20eq`20x_key_string,regardless
X`09use
X`09`20`20`20`20print`20err,ert$(err)
X`09`20`20`20`20exit`20handler
X`09end`20when
X`20`20`20`20else
X`09print`20"record`20is`20not`20locked"`09`09`20`20`20`20!`20no`20lock`20to`20
Vfind,`20get`20out
X`09exit`20program
X`20`20`20`20end`20if
X
X`20`20`20`20rec_rfa`20=`20GETRFA`20(1%)`09`09`09`20`20`20`20!`20get`20the`20rf
Va,`20so`20we`20can
X`09`09`09`09`09`09`20`20`20`20!`20find`20the`20lock
X`20`20`20`20print`20"record`20rfa`20=`20";rfa_string`09`09`20`20`20`20!`20disp
Vlay`20rfa`20for`20info
X
X`20`20`20`20PRINT`20RFA_WORD(l_loop);"`20`20";`20FOR`20l_loop`20=`200%`20TO`20
V2%
X`20`20`20`20print
X
X`20`20`20`20w_rfa_word(l_loop)`20=`20rfa_word(l_loop)`20for`20l_loop`20=`200%
V`20to`202%
X`09`09`09`09`09`09`20`20`20`20!`20save`20rfa`20for`20comparison
X`20`20`20`20close`20#1%`09`09`09`09`09`20`20`20`20!`20close`20file
X
X`20`20`20`20gosub`20loop_thru_locks`09`09`09`20`20`20`20!`20find`20file`20lock
Vs`20for`20this
X`09`09`09`09`09`09`20`20`20`20!`20file
X`20`20`20`20exit`20program
X
Xloop_thru_locks:
X`09!`20find`20all`20the`20file`20locks`20for`20this`20file.`20`20These`20can
V`20be`20identified`20by
X`09!`20the`20resource`20name`20of`20the`20lock,`20which`20contains`20the`20fil
Ve`20id`20for`20the`20file
X
X`20`20`20`20l_lkid`20=`20-1%`09`09`09`09`20`20`20`20!`20wildcard`20lock`20get
V
X
X`20`20`20`20l_return_status`20=`20lib$get_vm`20(31%,`20l_resaddr)`20`20`20!`20
Varea`20for`20resource`20name
X`20`20`20`20l_reslen`20=`200%`09`09`09`09`20`20`20`20!`20length`20=`200
X
X`09`09`09`09`09`09`20`20`20`20!`20build`20item`20list`20for`20getlki
X
X`20`20`20`20itmlst(0%)::item_len`20=`2031`09`09`09`20`20`20`20!`20we`20want`20
Vto`20get
X`20`20`20`20itmlst(0%)::item_code`20=`20LKI$_RESNAM`09`09`20`20`20`20!`20the
V`20resource`20name
X`20`20`20`20itmlst(0%)::item_addr`20=`20l_resaddr
X`20`20`20`20itmlst(0%)::item_rtn_len_addr`20=`20LOC(L_RESLEN)
X
X`20`20`20`20itmlst(1%)::item_len`20=`204%
X`20`20`20`20itmlst(1%)::item_code`20=`20LKI$_LOCKID`09`09`20`20`20`20!`20the
V`20lock`20id
X`20`20`20`20itmlst(1%)::item_addr`20=`20LOC(l_lockid)
X`20`20`20`20itmlst(1%)::item_rtn_len_addr`20=`20loc(l_temp)
X
X`20`20`20`20itmlst(2%)::item_len`20=`204%`09`09`09`20`20`20`20!`20the`20number
V`20of`20sublocks
X`20`20`20`20itmlst(2%)::item_code`20=`20LKI$_LCKREFCNT
X`20`20`20`20itmlst(2%)::item_addr`20=`20LOC(l_refcnt)
X`20`20`20`20itmlst(2%)::item_rtn_len_addr`20=`20loc(l_temp)
X
X`20`20`20`20itmlst(3%)::item_len`20=`200%
X`20`20`20`20itmlst(3%)::item_code`20=`200%
X`20`20`20`20itmlst(3%)::item_addr`20=`200%
X`20`20`20`20itmlst(3%)::item_rtn_len_addr`20=`200%
X
X`09`09`09`09`09`09`20`20`20`20!`20build`20argument`20list`20for
X`09`09`09`09`09`09`20`20`20`20!`20cmkrnl
X`20`20`20`20call_param(0%)`20=`202%
X`20`20`20`20call_param(1%)`20=`20loc(l_lkid)
X`20`20`20`20call_param(2%)`20=`20loc(itmlst(0%))
X
X`20`20`20`20l_parent_id(l_loop)`20=`200%`20for`20l_loop`20=`200%`20to`2050%`20
V!`20clear`20the`20parent`20id`20array
X
X`20`20`20`20l_num_parents`20=`200%`09`09`09`09`20`20`20`20!`20no`20parents`20f
Vound`20yet
X`20`20`20`20l_return_status`20=`20ss$_normal
X`20`20`20`20while`20((l_Return_status`20and`20ss$_normal)`20=`20ss$_normal)
X`09l_return_status`20=`20sys$cmkrnl(get_lock_info`20by`20VALUE`09`09`26
X`09`09`09`09`20`20`20`20,call_param(0%)`20by`20REF)
X`09`09`09`09`09`09`20`20`20`20!`20pass`20address`20of`20routine
X`09`09`09`09`09`09`20`20`20`20!`20and`20of`20argument`20list
X
X`09iterate`20if`20((l_return_status`20and`20ss$_normal)`20<>`20ss$_normal)
X
X`09iterate`20if`20l_num_parents`20>`2050%`09`09`20`20`20`20!`20avoid`20suboutr
Van`20err
X
X`09call`20lib$scopy_r_dx`20(`09`09`09`20`20`20`20!`20move`20resource`20name`20
Vfrom`20`26
X`09`09`09`09L_RESLEN`20BY`20REF,`20`20`20`20!`20item`20list`20to`20x_resname
V`20`20`26
X`09`09`09`09(itmlst(0%)::item_addr)`20BY`20VALUE,`20`26
X`09`09`09`09x_resname`20BY`20DESC)
X
X`09ITERATE`20IF`20LEFT(EDIT$(X_RESNAME,-1%),4%)`20<>`20"RMS$"
X`09`09`09`09`09`09`20`20`20`20!`20only`20want`20rms`20locks
X
X`09for`20l_loop`20=`205%`20to`209%`20step`202%`09`09`20`20`20`20!`20pull`20out
V`20file`20id`20from
X`09`20`20`20`20word_str`20=`20seg$(x_resname,l_loop,l_loop+1)`09!`20resource
V`20name
X`09`20`20`20`20w_file_id((l_loop-5%)/2%)`20=`20w_resval
X`09next`20l_loop
X`09`09`09`09`09`09`20`20`20`20!`20see`20if`20its`20the`20file
X`09`09`09`09`09`09`20`20`20`20!`20we`20want
X`09if`20w_file_id(0%)`20<>`20w_fileid(0%)`20OR`09`09`09`09`26
X`09`20`20`20`20w_file_id(1%)`20<>`20w_fileid(1%)`20OR`09`09`09`09`26
X`09`20`20`20`20w_file_id(2%)`20<>`20w_fileid(2%)`20then
X`09`20`20`20`20iterate
X`09end`20if
X
X`09l_parent_id(l_num_parents)`20=`20l_lockid`09!`20store`20id`20of`20parent`20
Vwe`20want
X`09l_num_parents`20=`20l_num_parents`20+`201%`09!`20increment`20number`20of`20
Vparents
X`20`20`20`20next
X
X`09`09`09`09`09`09!`20okay,`20we`20got`20all`20the`20parents,
X`20`20`20`20gosub`20get_sub_locks`09`09`09`09!`20now`20get`20the`20record`20lo
Vcks
X`09`09`09`09`09`09!`20associated`20with`20them
X`20`20`20`20return
X
Xget_sub_locks:
X
X`20`20`20`20l_lkid`20=`20-1%`09`09`09`09!`20go`20thru`20all`20the`20locks`20ag
Vain
X
X`20`20`20`20l_reslen`20=`200%
X
X`20`20`20`20itmlst(0%)::item_len`20=`2031`09`09`09!`20get`20the`20resource`20n
Vame
X`20`20`20`20itmlst(0%)::item_code`20=`20LKI$_RESNAM
X`20`20`20`20itmlst(0%)::item_addr`20=`20l_resaddr
X`20`20`20`20itmlst(0%)::item_rtn_len_addr`20=`20LOC(L_RESLEN)
X
X`20`20`20`20itmlst(1%)::item_len`20=`204%`09`09`09!`20get`20the`20lockid
X`20`20`20`20itmlst(1%)::item_code`20=`20LKI$_LOCKID
X`20`20`20`20itmlst(1%)::item_addr`20=`20LOC(l_lockid)
X`20`20`20`20itmlst(1%)::item_rtn_len_addr`20=`20loc(l_temp)
X
X`20`20`20`20itmlst(2%)::item_len`20=`204%`09`09`09!`20get`20the`20parent`20id
V
X`20`20`20`20itmlst(2%)::item_code`20=`20LKI$_PARENT
X`20`20`20`20itmlst(2%)::item_addr`20=`20LOC(l_parent)
X`20`20`20`20itmlst(2%)::item_rtn_len_addr`20=`20loc(l_temp)
X
X`20`20`20`20itmlst(3%)::item_len`20=`204%`09`09`09!`20get`20the`20user`20pid
X`20`20`20`20itmlst(3%)::item_code`20=`20LKI$_PID
X`20`20`20`20itmlst(3%)::item_addr`20=`20LOC(l_pid)
X`20`20`20`20itmlst(3%)::item_rtn_len_addr`20=`20loc(l_temp)
X
X`20`20`20`20itmlst(4%)::item_len`20=`200%
X`20`20`20`20itmlst(4%)::item_code`20=`200%
X`20`20`20`20itmlst(4%)::item_addr`20=`200%
X`20`20`20`20itmlst(4%)::item_rtn_len_addr`20=`200%
X
X`09`09`09`09`09`09!`20build`20argument`20list`20for`20cmkrnl
X
X`20`20`20`20call_param(0%)`20=`202%
X`20`20`20`20call_param(1%)`20=`20loc(l_lkid)
X`20`20`20`20call_param(2%)`20=`20loc(itmlst(0%))
X
X`20`20`20`20l_return_status`20=`20ss$_normal
X`20`20`20`20while`20((l_Return_status`20and`20ss$_normal)`20=`20ss$_normal)
X`09l_return_status`20=`20sys$cmkrnl(get_lock_info`20by`20VALUE`09`09`26
X`09`09`09`09`20`20`20`20,call_param(0%)`20by`20REF)
X`09`09`09`09`09`09!`20pass`20address`20of`20routine
X`09`09`09`09`09`09!`20and`20of`20argument`20list
X
X`09iterate`20if`20((l_return_status`20and`20ss$_normal)`20<>`20ss$_normal)
X
X`09`09`09`09`09`09!`20see`20if`20the`20parent`20of`20this
X`09b_continue`20=`200%`09`09`09`09!`20record`20lock`20is`20one`20of`20the
X`09for`20l_loop1`20=`200%`20to`20(l_num_parents`20-`201%)!`20file`20locks`20fo
Vr`20our`20file
X`09`20`20`20`20if`20l_parent_id(l_loop1)`20=`20l_parent`20then
X`09`09b_continue`20=`20-1%
X`09`20`20`20`20end`20if
X`09next`20l_loop1
X
X`09iterate`20if`20b_continue`20<>`20-1%`09`09!`20not`20in`20parent`20array
X
X`09`09`09`09`09`09!`20copy`20resname`20to`20descriptor
X`09call`20lib$scopy_r_dx`20(`09`09`09`09`09`20`20`20`20`26
X`09`09`09`09L_RESLEN`20BY`20REF,`09`09`20`20`20`20`26
X`09`09`09`09(itmlst(0%)::item_addr)`20BY`20VALUE,`20`20`20`26
X`09`09`09`09x_resname`20BY`20DESC)
X
X`09rfa_string`20=`20left(x_resname,6%)`09`09!`20check`20res`20name`20against
V`20rec
X`09`09`09`09`09`09!`20rfa`20to`20see`20if`20this`20is`20the
X`09`09`09`09`09`09!`20record`20we're`20looking`20for
X`09iterate`20if`20w_rfa_word(0%)`20<>`20rfa_word(2%)`20or`09`09`20`20`20`20`26
V
X`09`20`20`20`20w_rfa_word(2%)`20<>`20rfa_word(0%)
X
X`09`09`09`09`09`09!`20print`20the`20matching`20rfa's
X`09`09`09`09`09`09!`20for`20verification
X
X`09PRINT`20W_RFA_WORD(l_loop);"`20`20";`20FOR`20l_loop`20=`200%`20TO`202%
X`09print
X`09PRINT`20RFA_WORD(l_loop);"`20`20";`20FOR`20l_loop`20=`202%`20to`200%`20step
V`20-1%
X`09print
X
X`09`09`09`09`09`09!`20get`20the`20user`20info
X`09l_return_stat`20=`20lib$getjpi(jpi$_imagname,l_pid,,,x_imagename)
X`09l_return_stat`20=`20lib$getjpi(jpi$_username,l_pid,,,x_username)
X`09l_return_stat`20=`20lib$getjpi(jpi$_prcnam,l_pid,,,x_procname)
X
X`09`09`09`09`09`09!`20print`20the`20user`20info
X`09print
X`09print`20"-----------------------"
X`09print`20"owner`20pid`20`20`20`20:`20";hex$(l_pid,8)
X`09print`20"lockid`20`20`20`20`20`20`20:`20";l_lockid
X`09print`20"user`20`20`20`20`20`20`20`20`20:`20";x_username
X`09print`20"image`20`20`20`20`20`20`20`20:`20";x_imagename
X`09print`20"process`20name`20:`20";x_procname
X`09print`20"-----------------------"
X
X`09l_return_status`20=`202312`09`09`09!`20found`20it,`20all`20done
X`20`20`20`20next
X
X`20`20`20`20return
X
XOPEN_FILE:
X
X`09`09`09`09`09!`20open`20the`20specified`20file`20on`20channel`201
X
X`20`20`20`20open`20x_infile`20for`20input`20as`20file`20#1%,`09`09`09`26
X`09`20`20`20`20undefined,`09`09`09`09`09`09`26
X`09`20`20`20`20recordtype`20any,`09`09`09`09`09`26
X`09`20`20`20`20access`20modify,`09`09`09`09`09`26
X`09`20`20`20`20allow`20modify
X
X`20`20`20`20RETURN
X
XEND`20PROGRAM
X
X`0C
X
Xfind_rec_locker.ctl
X
X$`20WRITE`20SYS$OUTPUT`20"FIND_REC_LOCKER.CTL`20compile`20and`20link"
X$`20SET`20VERIFY
X$!
X$!`20`20`20COMPILE`20AND`20LINK`20COMMAND`20PROCEDURE
X$!`20`20`20
X$`20BASIC/WARN=NOINFO`20FIND_REC_LOCKER.BAS
X$`20BASIC/WARN=NOINFO`20GET_LOCK_INFO.BAS
X$`20BASIC/WARN=NOINFO`20PIECE2.BAS
X$`20BASIC/WARN=NOINFO`20HEX$.BAS
X$!
X$!
X$`20LNK:
X$!
X$`20link/NOTRACE`20FIND_REC_LOCKER,GET_LOCK_INFO,PIECE2,HEX$
X$!
X$!???
X$!
X$`20SET`20NOVERIFY
X$`20WRITE`20SYS$OUTPUT`20"End`20of`20Job`20FIND_REC_LOCKER.CTL"
X
X`0C
X
Xget_lock_info.bas
X
X%TITLE`20"Get`20lock`20info"
X%IDENT`20"V1.001"
X
XFUNCTION`20LONG`20GET_LOCK_INFO`20(LONG`20l_lkid_addr,`20ITMLST_ADDR)
X
X!+
X!`20FUNCTIONAL`20DESCRIPTION:
X!`20
X!`20`20`20This`20function`20is`20called`20via`20SYS$CMKRNL`20to`20get`20RMS`20
Vlock`20info
X!`20
X!`20FORMAL`20PARAMETERS:
X!`20
X!`20`20`20l_lkid_addr`09`09`20address`20of`20the`20lock`20id`20we`20are`20look
Ving`20for`20(-1)
X!
X!`20`20`20ITMLST_ADDR`09`09`20address`20of`20the`20item`20list`20to`20pass`20t
Vo`20SYS$GETLKI
X!`20
X!`20IMPLICIT`20INPUT`20PARAMETERS:
X!`20
X!`20`20`20NONE
X!`20
X!`20IMPLICIT`20OUTPUT`20PARAMETERS:
X!`20
X!`20`20`20NONE
X!`20
X!`20RETURN`20VALUE:
X!`20
X!`20`20`20Returns`20status`20from`20SYS$GETLKI
X!`20
X!`20SIDE`20EFFECTS:
X!`20
X!`20`20`20NONE
X!
X!`20AUTHOR:
X!
X!`09Chuck`20Abraham`09(INTRACORP,`20Berwyn,`20PA)
X!
X!`20DATE:
X!
X!`0918-Oct-1993
X!
X!`20MODIFICATION`20HISTORY:
X!`09Who`09Vers`20`20`20`20`20`20Date`09`09Description
X!`09---`09------`09`20---------`09-------------------------------------
X!???
X!???`20`20`20`20CHA`20`20`20`20`20V1.001`20`20`2010-18-93`09Original`20version
V
X!???
X!`20
X!-
X
X`20`20`20`20EXTERNAL`20INTEGER`20FUNCTION`20SYS$GETLKIW
X
X`20`20`20`20l_return_status`20=`20sys$getlkiw`20(,`20`26
X`20`20`20`20`09`20`20l_lkid_addr`20BY`20REF,`20`26
X`20`20`20`20`09`20`20LOC(ITMLST_ADDR)`20BY`20VALUE,,,,)
X
X`20`20`20`20GET_LOCK_INFO`20=`20l_return_status
X
XEND`20FUNCTION
X
X`0C
X
Xhex$.bas
X
X%title`20"HEX$"
X%sbttl`20"Return`20hexadecimal`20image`20of`20integer"
X%ident`20"V1.001"
Xfunction`20string`20hex$`20by`20ref`20(integer`20the_integer,`20number_of_digi
Vts)
X
X!+
X!`20functional`20description:
X!`20
X!`20`20`20Return`20a`20string`20representing`20the_integer`20in`20base`2016`20
Vnotation.
X!`20
X!`20formal`20parameters:
X!`20
X!`20`20`20the_integer:
X!`09Longword`20integer`20to`20be`20represented.
X!
X!`20`20`20number_of_digits:
X!`09Minimum`20number`20of`20hexadecimal`20digits`20to`20use`20in`20representat
Vion.`20If
X!`09number_of_digits`20is`20less`20than`201,`20the`20minimum`20length`20of`20t
Vhe`20returned
X!`09string`20will`20be`20one.`20`20The`20maximum`20length`20of`20the`20returne
Vd`20string`20is
X!`09eight.
X!`20
X!`20implicit`20input`20parameters:
X!`20
X!`20`20`20none
X!`20
X!`20implicit`20output`20parameters:
X!`20
X!`20`20`20none
X!`20
X!`20return`20value:
X!`20
X!`20`20`20Hexadecimal`20string`20of`20one`20to`20eight`20digits.
X!`20
X!`20side`20effects:
X!`20
X!`20`20`20none
X!
X!`20creation`20date:`2016-Jul-1993
X!`20
X!`20authors:`20`20Chuck`20Ramsey`20(Walklett`20Burns`20Ltd.,`20Great`20Valley,
V`20PA)
X!
X!`20modification`20history:
X!
X!`20Date`09`09Vers`09Who`20Comment
X!`20-----------`09------`09---`20---------------------------------------------
V-------
X
X!`2016-Jul-1993`09`201.001`09CDR`20Original`20version.
X!`20
X!-
X`20`20`20`20option`20type`20=`20explicit,`20`26
X`09`20`20`20size`20=`20integer`20long,`20`26
X`09`20`20`20constant`20type`20=`20integer,`20`26
X`09`20`20`20handle`20=`20BASIC
X
X`20`20`20`20%include`20"OTS$ROUTINES"`20%from`20%library`20"SYS$LIBRARY:BASIC$
VSTARLET"
X
X`20`20`20`20common`20(hex$work_zone)`20string`20result_string`20=`208
X
X`20`20`20`20declare`20integer`20ots_status,`20digits
X
X`20`20`20`20declare`20integer`20constant`09RESULT_EDIT_MASK`20`20`20`20=`202
V`09!`20discard`20all`20spaces
X`09`09`09`09`09`09`09!`20and`20tabs
X
Xbegin:
X
X`20`20`20`20result_string`20=`20""
X
X`20`20`20`20!`20If`20the`20number_of_digits`20parameter`20was
X`20`20`20`20!`20omitted,`20default`20to`20one`20digit.`20`20Otherwise,
X`20`20`20`20!`20limit`20output`20to`20eight`20digits
X`20`20`20`20!`20
X`20`20`20`20if`20loc`20(number_of_digits)`20=`200`20then
X`09digits`20=`201
X`20`20`20`20else
X`09digits`20=`20max`20(1,`20number_of_digits)
X`09digits`20=`20min`20(digits,`20len`20(result_string))
X`20`20`20`20end`20if
X
X`20`20`20`20ots_status`20=`20ots$cvt_l_tz`20(the_integer,`20result_string,`20d
Vigits,`204)
X
X`20`20`20`20!`20If`20the`20call`20to`20OTS$CVT_L_TZ`20fails,`20return
X`20`20`20`20!`20a`20string`20of`20asterisks
X`20`20`20`20!`20
X`20`20`20`20if`20mod`20(ots_status,`208)`20<>`201`20then
X`09result_string`20=`20string$`20(digits,`20ascii`20("*"))
X`20`20`20`20end`20if
X
X!`20Return`20the`20result`20stripped`20of`20spaces`20and`20tabs
X!`20
Xend`20function`20edit$`20(result_string,`20RESULT_EDIT_MASK)`20`20!`20end`20of
V`20function`20hex$
X
X`0C
X
Xpiece2.bas
X
X%TITLE`20"PIECE"
X%IDENT`20"V1.001"
XFUNCTION`20LONG`20PIECE`20(STRING`20IN_STR,`20STRING`20OUT_ARRAY(),`09`09`26
X`09`09`20`20`20`20`20STRING`20DELIM,LONG`20PARTS)
X
X!+
X!`20`20`20Author:`09Chuck`20Abraham`09(INTRACORP,`20Berwyn,`20PA)
X!`20`20`20Date`20`20:`0905-mar-1992
X!
X!
X!`20FUNCTIONAL`20DESCRIPTION:
X!`20
X!`20`20`20function`20to`20take`20a`20string`20and`20break`20it`20into`20its`20
Vcomponents,`20putting`20the
X!`20`20`20components`20into`20out_array
X!`20
X!`20FORMAL`20PARAMETERS:
X!`20
X!`20`20`20IN_STR`09:`20`20`20String`20passed`20into`20function.`20`20May`20be
V`20a`20name,`20e.g.
X!`09`09`09DOE`20JOHN`20J`20MD
X!`09`09`20`20`20`20or`20some`20other`20string.
X!
X!`20`20`20OUT_ARRAY`09:`20`20`20array`20of`20strings`20which`20will`20hold`20t
Vhe`20pieces`20of`20the`20original
X!`09`09`20`20`20`20string.`20`20In`20the`20above`20example,`20out_array`20woul
Vd`20be`20returned
X!`09`09`20`20`20`20as`20:
X!`09`09`09out_array(1)`20=`20"DOE"
X!`09`09`09out_array(2)`20=`20"JOHN"
X!`09`09`09out_array(3)`20=`20"J"
X!`09`09`09out_array(4)`20=`20"MD"
X!`09`09`09out_array(5...10)`20=`20""
X!
X!`20`20`20DELIM`09:`20`20`20character`20or`20characters`20to`20use`20as`20a`20
Vdelimiter`20to`20break
X!`09`09`20`20`20`20up`20the`20string`20into`20its`20component`20pieces.
X!`09`09`20`20`20`20in`20the`20above`20example,`20this`20would`20be`20"`20".
X!
X!`20`20`20PARTS`09:`20`20`20longword`20returned`20with`20the`20number`20of`20c
Vomponents`20the
X!`09`09`20`20`20`20string`20was`20broken`20down`20into.`20`20In`20the`20above
V`20example,
X!`09`09`20`20`20`20this`20would`20be`204.
X
X!`20
X!`20IMPLICIT`20INPUT`20PARAMETERS:
X!`20
X!`20`20`20none.
X!`20
X!`20IMPLICIT`20OUTPUT`20PARAMETERS:
X!`20
X!`20`20`20none.
X!`20
X!`20RETURN`20VALUE:
X!`20
X!`20`20`20nothing`20yet
X!`20
X!`20SIDE`20EFFECTS:
X!`20
X!`20`20`20none.
X!`20
X!`20MODIFICATION`20HISTORY:
X!`09Who`09Vers`20`20`20`20`20`20Date`09`09Description
X!`09---`09------`09`20---------`09-------------------------------------
X!???
X!???`20`20`20`20CHA`20`20`20`20`20V1.001`20`20`2003-05-92`09Original`20version
V
X!???
X!-
X`20`20`20`20option`20type`20=`20explicit
X`20`20`20`20%PAGE
X`20`20`20`20%SBTTL`20"Declarations"
X`20`20`20`20
X`20`20`20`20!+
X`20`20`20`20!`20Local`20Variables
X`20`20`20`20!-
X`20`20`20`20DECLARE`20string`09`09`09`09`09`20`20`20`20`26
X`09`09string_left,`09`09`09`09`20`20`20`20`26
X`09`09x_tmp_string
X
X`20`20`20`20DECLARE`20long`09`09`09`09`09`20`20`20`20`26
X`09`09l_rtn_stat
X
X`20`20`20`20External`20LONG`20CONSTANT`20SS$_NORMAL
X`20`20`20`20External`20LONG`20FUNCTION`20STR$ELEMENT
X
X`20`20`20`20DECLARE`20BYTE`20CONSTANT`20MAX_SLOTS`20=`2010
X
X`20`20`20`20%PAGE
X`20`20`20`20
X
X`20!`20main
X`20`20`20`20
X`20`20`20`20string_left`20=`20in_str
X`20`20`20`20parts`20=`200%
X
X`20`20`20`20if`20delim`20=`20"`20"`20then
X`09string_left`20=`20edit$(string_left,156%)`09!`20Remove`20leading`20and`20tr
Vailing
X`20`20`20`20end`20if`09`09`09`09`09!`20spaces`20and`20special`20chars
X`09`09`09`09`09`09!`20reduce`20embedded`20to`201`20space
X`20`20`20`20if`20string_left`20=`20""`20then`09`09`09!`20nothing`20but`20space
Vs
X`09parts`20=`200
X`09EXIT`20FUNCTION
X`20`20`20`20end`20if
X
X`20`20`20`20l_rtn_stat`20=`20SS$_NORMAL
X
X`20`20`20`20while`20((l_rtn_stat`20And`20SS$_NORMAL)`20=`20SS$_NORMAL)
X`09`09!`20while`20we`20continue`20to`20find`20elements
X`09l_rtn_stat`20=`20STR$ELEMENT(x_tmp_string,parts,`20delim,`20string_left)
X`09If`20((l_rtn_stat`20And`20SS$_NORMAL)`20=`20SS$_NORMAL)`20then
X`09`20`20`20`20parts`20=`20parts`20+`201`09`09`09!`20increment`20part`20count
V
X`09`20`20`20`20out_array(parts)`20=`20x_tmp_string
X`09`20`20`20`20x_tmp_string`20=`20""`09`09`09!`20clear`20string
X`09end`20if
X`09if`20parts`20>=`20MAX_SLOTS`20then
X`09`20`20`20`20l_rtn_stat`20=`200`09`09`09!`20too`20many`20elements`20for`20ar
Vray
X`09end`20if
X`20`20`20`20next
X
X`20`20`20`20PIECE`20=`20l_rtn_stat
X`20`20`20`20
XEND`20FUNCTION`20`20!`20End`20of`20FUNCTION`20PIECE
X
$ call unpack RECLOK.DSJ;2 1450337069 "" 35 1 1 
$ v=f$verify(v)
$ exit