$! ................... Cut between dotted lines and save. ................... $!........................................................................... $! VAX/VMS archive file created by VMS_SHARE V06.10 7-FEB-1989. $! $! 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 MOELLER $! on 10-AUG-1994 18:17:22.33. $! $! It contains the following 1 file: $! VMS_UNSHARE.COM $! $!============================================================================ $ SET SYMBOL/SCOPE=( NOLOCAL, NOGLOBAL ) $ VERSION = F$GETSYI( "VERSION" ) $ if f$getsyi("cpu").gt.127 then goto version_ok $ IF VERSION .GES "V4.4" THEN GOTO VERSION_OK $ WRITE SYS$OUTPUT "You are running VMS ''VERSION'; ", - "VMS_SHARE V06.10 7-FEB-1989 requires VMS V4.4 or higher." $ EXIT 44 ! SS$_ABORT $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 ) ); LOOP EXITIF SEARCH( SPAN( ' ' )@r_trail & LINE_END, FORWARD) = 0; POSITION( r_trail ); ERASE( r_trail ); ENDLOOP ; 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 ); COPY_TEXT( ASCII( INT( ERASE_CHARACTER( 3 ) ) ) ); 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_UNSHARE.COM" $ CHECKSUM_IS = 1964528115 $ COPY SYS$INPUT VMS_SHARE_DUMMY.DUMMY X$!*****`009VMS_UNSHARE.COM: unpack VMS_SHAR[E] files without executing them. X$!`009Apart from a temporary file in SYS$SCRATCH, this procedure will X$!`009create files only in or below the current default directory. X$! X$! p1: file[s] to UNSHARE, may be comma-separated list, X$!`009may contain wildcards, provided that a DIRECTORY command X$!`009with the same p1 lists the files in part order X$!`009(plus some more conditions not documented here ;-). X$! X$! Written by Wolfgang J. Moeller X$! on 04-dec-1989 (after VMS_SHARE 7.1-004). X$! mod 06-dec-1989 wjm: add support for older versions V$! fix 15-dec-1989 wjm: f$edit(,"trim") won't work when argument has 1 '"' in X it V$! fix 07-apr-1990 wjm: support 6.3's "`096`096" escape (comes as "`096096" i Xn 6.10) X$! mod 07-apr-1990 wjm: add support for 7.2 X$! mod 18-sep-1992 wjm: 1 fix, add support for 8.1 V$! fix 23-nov-1992 wjm: don't try to rename between SYS$SCRATCH and destinati Xon X$! mod 19-feb-1993 wjm: add support for 8.2 (old version heuristics broken!), X$!`009`009`009add notification when an old version of a file existed, X$!`009`009`009fix a bug with file specs used on CONVERT/FDL X$! mod 29-mar-1993 wjm: checked compatibility with 8.3, cosmetic fixes X$! mod 07-sep-1993 wjm: adapt (not perfectly) to 8.4; always invoke TPU`032 X$!`009`009`009with /NOJOURNAL qualifier; consistently use "UNSHARE" X$!`009`009`009for messages and logname prefix; add some debugging`032 X$!`009`009`009output depending upon logname UNSHARE_DEBUG X$! mod 16-feb-1994 wjm: support Pat Rankin: do look at 7.x version number X$! mod 10-aug-1994 wjm: work around a $CONVERT misfeature as 8.5-1 does, X$!`009`009`009fix conversion of files with void name, X$!`009`009`009claim support for 8.5-x X$! X$!`009... supports VMS_SHARE 8.1, 8.2, 8.3, 8.4 (usually), 8.5-x (usually) X$!`009`009 VMS_SHARE 7.1-001 thru -004, 7.2-007 X$!`009`009 VMS_SHARE 6.10, 6.3 X$!`009`009 VMS_SHAR 5.4 X$!`009`009and maybe more ... X$! X$! Acknowledgements: X$!`009VMS_SHAR: Copyright (c) 1987, by Michael Bednarek X$!`009VMS_SHARE 6.x: Copyright `169 1988, by James Gray X$! `009VMS_SHARE 7.x and up: Written by Andy Harper, Kings College London UK X$!`009`009`009`009 V$! `009VMS_SHARE 8.x: Copyright (C) 199% Andy Harper, Kings College London`03 X2 X$! X$!***** X$! X$ v = 'f$verify(f$trnlnm("UNSHARE_VERIFY"),f$env("verify_image"))' X$ set = "set" X$ set symbol/scope=(nolocal,noglobal) X$! X$ on warning then goto err_on X$! X$ SS$_FORMAT = %x00BC`009`009! %SYSTEM-F-FORMAT, invalid media format X$ RMS$_NMF = %x182CA X$! X$ dbg = "!" X$ if f$trnlnm("UNSHARE_DEBUG") then dbg = "" X$! X$ sum_files = 0 X$ sum_skip = 0 X$ sum_cksum = 0 X$ sum_ckskp = 0 X$! X$ sharvers = ""`009`009! unknown yet X$ sharvers7 = ""`009! unknown yet X$ sharvers8 = ""`009! unknown yet X$ sharvers84 = ""`009! unknown yet X$ recfm = ""`009`009! void unless set by 8.x X$! X$ f = f$parse("SYS$SCRATCH:.UNSHARE_TMP_" + f$getjpi("","PID")) X$ if f$trnlnm("UNSHARE_TEMP").nes."" then -`009`009! make sure that ... V f = f$parse(f$parse("UNSHARE_TEMP",,,"node") +-`009! ... name & version . X.. X`009`009f$parse("UNSHARE_TEMP",,,"device") +-`009! ... are blank X`009`009f$parse("UNSHARE_TEMP",,,"directory"),f) X$ if f$parse(f,,,"name").nes."" then X$ e = "write sys$error ""%UNSHARE"", " X$ w = "write sys$output ""%UNSHARE"", " X$ if f$getsyi("CPU") .gt. 127 then $ goto start`009! supposedly AXP/VMS X$ vmsv = f$getsyi("version") X$ vmsv = f$extract(1,f$length(vmsv)-1,vmsv)`009! ... w/o initial letter X$ if vmsv.ges."4.4" then $ goto START X$ e "-F-VMSVERSION, Must run at least VMS 4.4" X$ return %x10000674`009! F, SS$_SYSVERDIF (signalled) X$! X$! X$!*****`009GOSUBroutine: fetch 'line' from input X$! X$getline_init:`009`009`009`009`009!GOSUB entry X$ define UNSHARE_INPUTS`009'p1' X$ oldfn = "" X$ gosub getline_open X$ return 1 X$! X$getline_open:`009`009`009`009`009!internal GOSUB X$ fn = f$search("UNSHARE_INPUTS",1) X$ if fn.eqs."".or.fn.eqs.oldfn then return RMS$_NMF`009! trigger ON WARNING X$ oldfn = fn X$ w "-I-Opening input file ",fn X$ open/read UNSHARE_INPUT 'fn' X$ return 1 X$! X$getline:`009`009`009!GOSUB entry, repeated below for faster access X$ read/end=getline_eof UNSHARE_INPUT line X$ return 1 X$getline_eof: X$ close UNSHARE_INPUT X$ gosub getline_open X$ goto getline X$! X$! X$!*****`009start of UNSHARing X$! X$START: X$ gosub getline_init X$! X$!*****`009search for "$START:" label, or version info (required as of 8.2) X$sloop: X$ gosub getline V$ if f$extract(0,45,line).eqs."$! This archive created by VMS_SHARE Version " X - X`009then goto hit_78 X$ if f$extract(0,23,line).eqs."$! Using: VMS_SHARE 8." then goto hit_804 X$ if f$edit(f$element(0," ",line),"upcase").nes."$START:" then goto sloop X$ if f$edit(f$extract(7,f$length(line)-7,line),"trim").nes."" then goto sloop X$ goto nextfile X$! X$hit_78: X$ if f$extract(46,1,line).nes."." then goto sloop X$ i = f$extract(45,1,line) X$ if i.eq.8 then goto hit_80 X$ if i.ne.7 then goto sloop X$ if f$extract(48,1,line).nes."-" then goto sloop X$ sharvers7 = f$extract(47,1,line) X$ goto sloop X$hit_80: X$ sharvers8 = f$extract(47,f$length(line)-47,line) X$ goto sloop X$! X$hit_804: X$ if f$element(1,",",line).nes." (C) 1993 Andy Harper" then goto sloop X$ sharvers84 = f$element(0,",",f$extract(23,99,line)) X$ goto sloop X$! X$! X$!*****`009decide upon version by looking at the line(s) after "$START:" X$!`009`009end of input may also occur X$nextfile: X$ gosub getline X$ if f$edit(line,"trim").eqs."" then gosub getline`009! void line in 6.x X$! X$ if f$edit(line,"trim").nes."$!" then goto next_not_8`009! "$!" in 8.x X$ gosub getline X$ if f$edit(line,"trim").eqs."$ create 'f'" then goto share8xx`009!8.x X$ goto expect_end`009`009`009`009`009! ??? X$next_not_8: X$! X$ if f$edit(line,"trim").eqs."$ create 'f'" then goto share702`009`009![7.2] V$ if f$edit(line,"trim").eqs."$ create/nolog 'f'" then goto share701`009![7.1 X] X$ x1 = f$element(0,"""",line) X$ if x1.eqs."$ FILE_IS = " then goto share6`009`009`009`009!6.x X$ if x1.eqs."$File_is=" then goto share5`009`009`009`009!5.x X$ if f$extract(0,10,line).nes."$Goto Part" then goto expect_end`009`009!5.x X$! X$!*****`009skip to "$Part:" (VMS_SHAR only) X$ lab = "$"+f$element(1," ",line) X$gloop: X$ gosub getline X$ if f$element(0,":",line).nes.lab then goto gloop X$ if f$edit(line-(lab+":"),"trim").nes."" then goto gloop X$ goto nextfile X$! X$!*****`009come back here when file 'f' has been written X$!`009and 'sharvers','outfn','cksum','recfm' are known X$unpack: X$ close UNSHARE_TEMP X$! X$ ospec = f$parse(outfn,"[]",,,"syntax_only") X$! V$!*****`009make sure that output files will be created in the current directo Xry X$!`009`009`009`009`009`009or in a subdirectory thereof X$! X$ dummy = f$parse("DUMMY.DUMMY;1","[]",,,"syntax_only") X$ defdir = dummy - "DUMMY.DUMMY;1" X$ if defdir.eqs.dummy then return 4`009! must not happen X$ defdirlen = f$length(defdir) X$retry_dir: X$ outdir = ospec-(f$parse(ospec,,,"name","syntax_only")+- X`009`009f$parse(ospec,,,"type","syntax_only")+- X`009`009f$parse(ospec,,,"version","syntax_only")) X$ if outdir.nes.ospec then`009-`009`009! need properly formed dir X if outdir.eqs.defdir .or.`009-`009`009`009! same directory V (f$extract(0,defdirlen-1,outdir).eqs.f$extract(0,defdirlen-1,defdir).and X.- X f$extract(defdirlen-1,1,outdir).eqs.".") then -`009! subdirectory X`009goto dir_ok X$ e "-F-DIRCHANGED, ",f$fao("directory for file !AS changed!/"+- X`009"to the current directory !AS,!/"+- X`009"because the SHARE file specifies an improper directory name.",- X`009outfn,defdir) X$ ospec = f$parse(defdir,outfn,,,"syntax_only") X$ goto retry_dir`009`009`009! verify again, just in case ... X$dir_ok: X$! X$ newvers = "" X$! X$ if f$parse(ospec).nes."" then goto no_credir`009`009! directory exists X$ dn = f$parse(ospec,,,"device")+f$parse(ospec,"[]",,"directory") X$ w "-I-Creating directory ",dn X$ create/dir 'dn' X$ goto no_skip`009`009! can't be duplicate X$no_credir: X$! X$ if f$search(f$parse(";",ospec)).eqs."" then goto no_skip X$ newvers = " (new version)"`009`009`009! *some* old version exists X$! X$!*****`009reject duplicate file - only if version is given (7.x and up) X$! X$ if f$parse(ospec).eqs.f$parse(";",ospec) then - X`009goto no_skip`009`009`009`009! br if no version given X$ if f$search(ospec).eqs."" then goto no_skip`009! br if no such version X$! X$ e "-W-SKIPPED, File ''outfn' exists - skipped." X$ sum_skip = sum_skip + 1 X$ delete/nolog 'f'* X$ goto nextfile X$no_skip: X$! X$ w "-I-Unpacking file ",outfn,newvers X$ gosub unpack_'sharvers' X$ delete/nolog 'f'* X$! X$ if recfm.eqs."" then goto fdl_skip X$ open/write UNSHARE_TEMP 'f' X$ write UNSHARE_TEMP "RECORD" X$ write UNSHARE_TEMP recfm X$ close UNSHARE_TEMP X$ w "-I-CONVRFM, converting record format to ",recfm X$ copy/concat NL:,'ospec' 'f'`009`009! make sure name of 'f' remains void X$ convert/fdl='f'-1 'f' 'f'`009`009! this would "maximize version" ... X$ delete/nolog 'ospec'`009`009! replace 'ospec' with converted file X$ on error then goto err_on X$ copy 'f' 'ospec'`009`009`009! WARNING if higher version exists X$ on warning then goto err_on X$ delete/nolog 'f'* X$fdl_skip: X$! X$ if cksum.eqs."""""" then goto cksum_skip`009`009`009! new with 8.x X$ CHECKSUM 'ospec' X$ sum_files = sum_files + 1 X$ IF CHECKSUM$CHECKSUM .eqs. cksum then goto nextfile`009! all o.k. X$ e "-E-CHKSUMFAIL, Checksum of ''outfn' failed." X$ sum_cksum = sum_cksum + 1 X$ goto nextfile X$! X$cksum_skip: X$ w "-W-CHKSUMSKIP, checksum validation unavailable for ",outfn X$ sum_files = sum_files + 1 X$ sum_ckskp = sum_ckskp + 1 X$ goto nextfile X$! V$!*****`009VMS_SHARE 8.x **************************************************** X****** X$share8xx: X$ if sharvers.eq.801 .or.- X sharvers.eq.802 .or.- X sharvers.eq.804 then goto share8yy X$ if sharvers.nes."" then return SS$_FORMAT X$ sharvers = 801`009`009`009`009! need *some* default X$ if f$type(sharvers8).eqs."INTEGER" then - X`009sharvers = 800 + f$integer(sharvers8) X$ if sharvers.gt.802 then sharvers = 802`009! 8.3 treated like 8.2 X$ if sharvers84.nes."" then sharvers = 804`009! 8.4 and beyond ??? X$ 'dbg' if sharvers.eq.801 then w "-I-Assuming VMS_SHARE version 8.1" X$ 'dbg' if sharvers.eq.802 then w "-I-Assuming VMS_SHARE version 8.2 or 8.3" X$ 'dbg' if sharvers.eq.804 then w "-I-Assuming VMS_SHARE version 8.4 or 8.5" X$ goto share8xx`009`009`009`009`009! loop at most once X$! X$share8yy: X$ open/write UNSHARE_TEMP 'f' X$ w "-I-Working on next file ..." X$ goto cloop8 X$! X$! GOSUB entry repeated for faster access X$getline: X$ read/end=getline_eof UNSHARE_INPUT line X$ return 1 X$! X$cloop8: X$ gosub getline X$ if f$extract(0,14,line).eqs."$ call unpack " then goto cloop8end X$ write UNSHARE_TEMP line X$ goto cloop8 X$cloop8end: X$ long_line = f$edit(line,"trim,compress")`009! this line may be continued X$lloop8: V$ if f$extract(f$length(long_line)-1,1,long_line).nes."-" then goto lloop8e Xnd X$ long_line = f$extract(0,f$length(long_line)-1,long_line) X$ gosub getline X$ long_line = f$edit(long_line + line,"trim,compress") X$ goto lloop8 X$lloop8end: X$ outfn = f$element(3," ",long_line) X$ cksum = f$element(4," ",long_line)`009`009! maybe "" X$ recfm = long_line - ("$ call unpack " + outfn + " " + cksum + " ") X$! ... as of 8.4, may have to strip extra "unpack" arguments X$ if f$extract(0,1,recfm).eqs."""" X$ then`009`009`009`009`009`009! recfm = quoted string X$`009l = f$length(recfm) - 1 X$`009unp_more = f$extract(1,l,recfm)`009`009! ... w/o leading " X$`009recfm = "" X$uloop8: X$`009s = f$element(0,"""",unp_more) X$`009recfm = recfm + s X$`009unp_more = unp_more - (s + """") X$`009if f$extract(0,1,unp_more).eqs."""" X$`009then`009`009`009`009`009! handle double " X$`009`009recfm = recfm + """" X$`009`009unp_more = unp_more - """" X$`009`009goto uloop8 X$`009endif X$`009unp_more = f$edit(unp_more - """","trim") X$ else X$`009s = f$element(0," ",recfm) X$`009unp_more = f$edit(recfm - s,"trim") X$`009recfm = s X$ endif X$ recfm = f$edit(recfm,"trim")`009`009`009! blanks => empty string X$ 'dbg' show sym recfm X$ goto unpack X$! X$!***** X$! X$unpack_801:`009!GOSUB`009`009`009! from VMS_SHARE 8.1 with /COMPRESS X$! `009`009`009! NOTE: this will also work for files w/o /COMPRESS, X$!`009`009`009!`009since Run_Flag='&' is always escaped by 8.1 X$ define/user sys$output nl: X$ EDIT/TPU/NOSEC/NODIS/NOJOU/COM=SYS$INPUT 'f'/OUT='ospec' XPROCEDURE GetHex LOCAL x1,x2;x1:=INDEX(t,ERASE_CHARACTER(1))-1;x2:=INDEX(t, XERASE_CHARACTER(1))-1;RETURN 16*x1+x2;ENDPROCEDURE; XPROCEDURE SkipPartsep LOOP EXITIF INDEX(ERASE_LINE,"-+-+-+-+-+-+-+-+")=1; XENDLOOP;ENDPROCEDURE; XPROCEDURE ExpandChar CASE CURRENT_CHARACTER FROM ' ' TO 'z' ["&"] V:ERASE_CHARACTER(1);x:=GetHex;COPY_TEXT(ASCII(GetHex)*x);["`096"]:ERASE_CHARA XCTER( X1);COPY_TEXT(ASCII(GetHex));[" "]:ERASE_CHARACTER(1);[OUTRANGE,INRANGE] X:MOVE_HORIZONTAL(1);ENDCASE;ENDPROCEDURE;PROCEDURE ProcessLine s:= VERASE_CHARACTER(1);LOOP EXITIF CURRENT_OFFSET>=LENGTH(CURRENT_LINE);ExpandCha Xr; XENDLOOP;IF s="V" THEN APPEND_LINE;ENDIF;ENDPROCEDURE; XPROCEDURE AdvanceLine MOVE_HORIZONTAL(-CURRENT_OFFSET);MOVE_VERTICAL(1); VENDPROCEDURE;PROCEDURE Decode POSITION(BEGINNING_OF(b));LOOP EXITIF MARK(NONE X)= XEND_OF(b);IF INDEX(CURRENT_LINE,"+-+-+-+-+-+-+-+-")=1 THEN SkipPartSep; XELSE ProcessLine;AdvanceLine;ENDIF;ENDLOOP;ENDPROCEDURE;SET(FACILITY_NAME, X"UNPACK");SET(SUCCESS,OFF);SET(INFORMATIONAL,OFF);t:="0123456789ABCDEF";f:= XGET_INFO(COMMAND_LINE,"file_name");b:=CREATE_BUFFER(f,f);Decode;WRITE_FILE(b, XGET_INFO(COMMAND_LINE,"output_file"));QUIT; X$ return X$! V$unpack_802:`009!GOSUB`009! from VMS_SHARE 8.2, with code for both /COMPRESS= X1 X$!`009`009`009! and /COMPRESS=2 (both '&' and '\' are always escaped) X$!`009`009`009! still o.k. with VMS_SHARE 8.3 X$ define/user sys$output nl: X$ EDIT/TPU/NOSEC/NODIS/NOJOU/COM=SYS$INPUT 'f'/OUT='ospec' XPROCEDURE GetHex(s,p)LOCAL x1,x2;x1:=INDEX(t,SUBSTR(s,p,1))-1;x2:=INDEX(t, XSUBSTR(s,p+1,1))-1;RETURN 16*x1+x2;ENDPROCEDURE; VPROCEDURE SkipPartsep LOOP EXITIF MARK(NONE)=END_OF(b);EXITIF INDEX(ERASE_LIN XE, V"-+-+-+-+-+-+-+-+")=1;ENDLOOP;ENDPROCEDURE;PROCEDURE COPY_PREVIOUS(b,n)LOCAL X m, Xs,e;m:=MARK(NONE);MOVE_HORIZONTAL(-b);s:=MARK(NONE);MOVE_HORIZONTAL(n-1);e:= XMARK(NONE);POSITION(m);COPY_TEXT(CREATE_RANGE(s,e));ENDPROCEDURE; XPROCEDURE ProcessLine LOCAL c,s,l,b,n,p;c := ERASE_CHARACTER(1);s := V ERASE_LINE;IF c = "X" THEN SPLIT_LINE; ENDIF;MOVE_HORIZONTAL(-1);l := LENGTH X( Xs);p := 1;LOOP EXITIF p > l;c := SUBSTR(s,p,1);p := p+1; XCASE c FROM ' ' TO '`096'`032 X['\']: b:=GetHex(s,p); n:=GetHex(s,p+2); p:=p+4; COPY_PREVIOUS(b,n); X['&']: b:=GetHex(s,p); n:=GetHex(s,p+2); p:=p+4; COPY_TEXT(ASCII(n)*b); X['`096']: COPY_TEXT(ASCII(GetHex(s,p))); p:=p+2; [' ']: p:=p+1; X[INRANGE,OUTRANGE]: COPY_TEXT(c);ENDCASE;ENDLOOP;ENDPROCEDURE; XPROCEDURE Decode POSITION(BEGINNING_OF(b));LOOP EXITIF MARK(NONE)=END_OF(b); VIF INDEX(CURRENT_LINE,"+-+-+-+-+-+-+-+-")=1 THEN SkipPartSep;ELSE ProcessLine X; VMOVE_HORIZONTAL(1);ENDIF;ENDLOOP;ENDPROCEDURE;SET(FACILITY_NAME,"UNPACK");SET X( XSUCCESS,OFF);SET(INFORMATIONAL,OFF);t:="0123456789ABCDEF";f:=GET_INFO( XCOMMAND_LINE,"file_name");b:=CREATE_BUFFER(f,f);Decode;WRITE_FILE(b,GET_INFO( XCOMMAND_LINE,"output_file"));QUIT; X$ return X$! V$unpack_804:`009!GOSUB`009! from VMS_SHARE 8.4, with code for both /COMPRESS= X1 X$!`009`009`009! and /COMPRESS=2 (both '&' and '\' are always escaped); X$!`009`009`009! modified to always TRIM_TRAILING the input, but X$!`009`009`009! *not* ignore intermediate spaces (no way to find out`032 X$!`009`009`009! about /[NO]SPACE_ENCODE mode) X$ define/user sys$output nl: X$ EDIT/TPU/NOSEC/NODIS/NOJOU/COM=SYS$INPUT 'f'/OUT='ospec' XPROCEDURE GetHex(s,p)LOCAL x1,x2;x1:=INDEX(t,SUBSTR(s,p,1))-1; Xx2:=INDEX(t,SUBSTR(s,p+1,1))-1;RETURN 16*x1+x2;ENDPROCEDURE; VPROCEDURE SkipPartsep LOCAL m;LOOP m:=MARK(NONE);EXITIF m=END_OF(b);DELETE(m) X; XEXITIF INDEX(ERASE_LINE,"-+-+-+-+-+-+-+-+")=1;ENDLOOP;ENDPROCEDURE; VPROCEDURE ProcessLine LOCAL c,s,l,b,n,p;c := ERASE_CHARACTER(1);s := ERASE_LI XNE; XIF c = "X" THEN SPLIT_LINE; ENDIF;MOVE_HORIZONTAL(-1); XEDIT(s,TRIM_TRAILING,OFF);`009!*** added by wjm (won't skip spaces below) Xl := LENGTH(s);p := 1;LOOP EXITIF p > l;c := SUBSTR(s,p,1);p := p+1; XCASE c FROM ' ' TO '`096'`032 X['\']: b:=GetHex(s,p); n:=GetHex(s,p+2); p:=p+4; X`009COPY_TEXT(SUBSTR(CURRENT_LINE,CURRENT_OFFSET-b+1,n)); X['&']: b:=GetHex(s,p); n:=GetHex(s,p+2); p:=p+4; COPY_TEXT(ASCII(n)*b); X['`096']: COPY_TEXT(ASCII(GetHex(s,p))); p:=p+2; X!*** removed by wjm (not used with /NOSPACE_ENCODING) ... [' ']: p:=p+1; X[INRANGE,OUTRANGE]: COPY_TEXT(c);ENDCASE;ENDLOOP;ENDPROCEDURE; XPROCEDURE Decode LOCAL m;POSITION(BEGINNING_OF(b));LOOP m:=MARK(NONE); VEXITIF m=END_OF(b);DELETE(m);IF INDEX(CURRENT_LINE,"+-+-+-+-+-+-+-+-")=1 THEN X`032 XSkipPartSep;ELSE ProcessLine;MOVE_HORIZONTAL(1);ENDIF;ENDLOOP;ENDPROCEDURE; XSET(FACILITY_NAME,"UNPACK");SET(SUCCESS,OFF);SET(INFORMATIONAL,OFF); Xt:="0123456789ABCDEF";f:=GET_INFO(COMMAND_LINE,"file_name"); Vb:=CREATE_BUFFER(f,f);Decode;WRITE_FILE(b,GET_INFO(COMMAND_LINE,"output_file" X)); XQUIT; X$ return X$! V$!*****`009VMS_SHARE 7.1-001 thru -004[-x], 7.2-007 ************************* X****** X$share701: X$ tmp = 701 X$ goto share7xx X$share702: X$ tmp = 702 X$share7xx: X$ if sharvers.eq.701 .or.- X sharvers.eq.702 then goto share7 X$ if sharvers.nes."" then return SS$_FORMAT X$ sharvers = tmp X$ if f$type(sharvers7).eqs."INTEGER" then - X`009if sharvers7.eq.1 .or. sharvers7.eq.2 then - X`009`009sharvers = 700 + sharvers7 X$ 'dbg' if sharvers.eq.701 then w "-I-Assuming VMS_SHARE version 7.1" X$ 'dbg' if sharvers.eq.702 then w "-I-Assuming VMS_SHARE version 7.2" X$ goto share7xx`009`009`009`009`009! loop at most once X$! X$share7: X$ open/write UNSHARE_TEMP 'f' X$ w "-I-Working on next file ..." X$ goto cloop7 X$! X$! GOSUB entry repeated for faster access X$getline: X$ read/end=getline_eof UNSHARE_INPUT line X$ return 1 X$! X$cloop7: X$ gosub getline X$ if f$extract(0,14,line).eqs."$ CALL UNPACK " then goto cloop7end X$ write UNSHARE_TEMP line X$ goto cloop7 X$cloop7end: X$ outfn = f$element(3," ",f$edit(line,"compress")) X$ cksum = f$element(4," ",f$edit(line,"compress")) X$ goto unpack X$! X$!***** X$! X$unpack_701:`009!GOSUB`009`009`009`009! from VMS_SHARE 7.1-004 X$ define/user sys$output nl: X$ EDIT/TPU/NOSEC/NODIS/NOJOU/COM=SYS$INPUT 'f'/OUT='ospec' XPROCEDURE Unpacker ON_ERROR ENDON_ERROR;SET(FACILITY_NAME,"UNPACK");SET( XSUCCESS,OFF);SET(INFORMATIONAL,OFF);f:=GET_INFO(COMMAND_LINE,"file_name"); Xbuff:=CREATE_BUFFER(f,f);p:=SPAN(" ")@r&LINE_END;POSITION(BEGINNING_OF(buff)) X;LOOP EXITIF SEARCH(p,FORWARD)=0;POSITION(r);ERASE(r);ENDLOOP;POSITION( XBEGINNING_OF(buff));g:=0;LOOP EXITIF MARK(NONE)=END_OF(buff);x:= XERASE_CHARACTER(1);IF g = 0 THEN IF x="X" THEN MOVE_VERTICAL(1);ENDIF;IF x= X"V" THEN APPEND_LINE;MOVE_HORIZONTAL(-CURRENT_OFFSET);MOVE_VERTICAL(1);ENDIF; XIF x="+" THEN g:=1;ERASE_LINE;ENDIF;ELSE IF x="-" THEN g:=0;ENDIF;ERASE_LINE; VENDIF;ENDLOOP;p:="`096";POSITION(BEGINNING_OF(buff));LOOP r:=SEARCH(p,FORWARD X); XEXITIF r=0;POSITION(r);ERASE(r);COPY_TEXT(ASCII(INT(ERASE_CHARACTER(3)))); XENDLOOP;o:=GET_INFO(COMMAND_LINE,"output_file");WRITE_FILE(buff,o); XENDPROCEDURE;Unpacker;EXIT; X$ return X$! X$!***** X$! X$unpack_702:`009!GOSUB`009`009`009`009! from VMS_SHARE 7.2-007 X$ define/user sys$output nl: X$ EDIT/TPU/NOSEC/NODIS/NOJOU/COM=SYS$INPUT 'f'/OUT='ospec' XPROCEDURE Unpacker ON_ERROR ENDON_ERROR;SET(FACILITY_NAME,"UNPACK");SET( XSUCCESS,OFF);SET(INFORMATIONAL,OFF);f:=GET_INFO(COMMAND_LINE,"file_name");b:= XCREATE_BUFFER(f,f);p:=SPAN(" ")@r&LINE_END;POSITION(BEGINNING_OF(b)); XLOOP EXITIF SEARCH(p,FORWARD)=0;POSITION(r);ERASE(r);ENDLOOP;POSITION( XBEGINNING_OF(b));g:=0;LOOP EXITIF MARK(NONE)=END_OF(b);x:=ERASE_CHARACTER(1); XIF g=0 THEN IF x="X" THEN MOVE_VERTICAL(1);ENDIF;IF x="V" THEN APPEND_LINE; XMOVE_HORIZONTAL(-CURRENT_OFFSET);MOVE_VERTICAL(1);ENDIF;IF x="+" THEN g:=1; XERASE_LINE;ENDIF;ELSE IF x="-" THEN IF INDEX(CURRENT_LINE,"+-+-+-+-+-+-+-+")= X1 THEN g:=0;ENDIF;ENDIF;ERASE_LINE;ENDIF;ENDLOOP;t:="0123456789ABCDEF"; VPOSITION(BEGINNING_OF(b));LOOP r:=SEARCH("`096",FORWARD);EXITIF r=0;POSITION( Xr); XERASE(r);x1:=INDEX(t,ERASE_CHARACTER(1))-1;x2:=INDEX(t,ERASE_CHARACTER(1))-1; XCOPY_TEXT(ASCII(16*x1+x2));ENDLOOP;WRITE_FILE(b,GET_INFO(COMMAND_LINE, X"output_file"));ENDPROCEDURE;Unpacker;QUIT; X$ return X$! V$!*****`009VMS_SHARE 6.10 *************************************************** X****** X$share6: X$ 'dbg' if sharvers.eqs."" then w "-I-Assuming VMS_SHARE version 6.x" X$ if sharvers.eqs."" then sharvers = 610 X$ if sharvers.ne.610 then return SS$_FORMAT X$! X$ line = f$edit(line-x1,"trim") X$ outfn = f$element(1,"""",line) X$ if line.nes.""""+outfn+"""" then goto err_unx X$ gosub getline X$ if f$element(0,"=",line).nes."$ CHECKSUM_IS " then goto err_unx X$ cksum = f$edit(line-"$ CHECKSUM_IS = ","trim") X$ if f$type(cksum).nes."INTEGER" then goto err_unx X$ gosub getline X$ if f$edit(line,"trim").nes."$ COPY SYS$INPUT VMS_SHARE_DUMMY.DUMMY" then - X`009goto err_unx X$!*****`009do it X$ open/write UNSHARE_TEMP 'f' X$ w "-I-Working on ",outfn X$ goto cloop6 X$! X$! GOSUB entry repeated for faster access X$getline: X$ read/end=getline_eof UNSHARE_INPUT line X$ return 1 X$! X$cloop6: X$ gosub getline X$ if f$extract(0,19,line).eqs."$ GOSUB UNPACK_FILE" then goto cloop6end X$ write UNSHARE_TEMP line X$ goto cloop6 X$cloop6end: X$ goto unpack X$! X$!***** X$! X$unpack_610:`009!GOSUB`009`009`009`009! from VMS_SHARE 6.10 X$ define/user sys$output nl: X$ EDIT/TPU/NOSECT/NODISP/NOJOU/COMM=SYS$INPUT 'f'/OUTPUT='ospec' Vb_part := CREATE_BUFFER( "`123Part`125", GET_INFO( COMMAND_LINE, "file_name" X ) ) X; s_file_spec := GET_INFO( COMMAND_LINE, "output_file" ); SET( OUTPUT_FILE V, b_part, s_file_spec ); b_errors := CREATE_BUFFER( "`123Errors`125" ); i_err Xors`032 X:= 0; pat_beg_1 := ANCHOR & "-+-+-+ Beginning"; pat_beg_2 := LINE_BEGIN`032 X& "+-+-+-+ Beginning"; pat_end := ANCHOR & "+-+-+-+-+ End"; POSITION X( BEGINNING_OF( b_part ) ); LOOP EXITIF SEARCH( SPAN( ' ' )@r_trail`032 X& LINE_END, FORWARD) = 0; POSITION( r_trail ); ERASE( r_trail ); ENDLOOP X; POSITION( BEGINNING_OF( b_part ) ); i_append_line := 0; LOOP EXITIF MARK X( NONE ) = END_OF( b_part ); s_x := ERASE_CHARACTER( 1 ) V; IF s_x = '+' THEN r_skip := SEARCH( pat_beg_1, FORWARD, EXACT ); IF r_skip` X032 X<> 0 THEN s_x := ''; MOVE_HORIZONTAL( -CURRENT_OFFSET ); ERASE_LINE; ENDIF X; ENDIF; IF s_x = '-' THEN r_skip := SEARCH( pat_end, FORWARD, EXACT ) V; IF r_skip <> 0 THEN s_x := ''; MOVE_HORIZONTAL( -CURRENT_OFFSET ); m_skip`0 X32 X:= MARK( NONE ); r_skip := SEARCH( pat_beg_2, FORWARD, EXACT ); IF r_skip`032 X<> 0 THEN POSITION( END_OF( r_skip ) ); MOVE_HORIZONTAL( -CURRENT_OFFSET ) V; MOVE_VERTICAL( 1 ); MOVE_HORIZONTAL( -1 ); ELSE POSITION( END_OF( b_part`03 X2 X) ); ENDIF; ERASE( CREATE_RANGE( m_skip, MARK( NONE ), NONE ) ); ENDIF; ENDIF X; IF s_x = 'V' THEN s_x := ''; IF i_append_line <> 0 THEN APPEND_LINE X; MOVE_HORIZONTAL( -CURRENT_OFFSET ); ENDIF; i_append_line := 1 V; MOVE_VERTICAL( 1 ); ENDIF; IF s_x = 'X' THEN s_x := ''; IF i_append_line`03 X2 X<> 0 THEN APPEND_LINE; MOVE_HORIZONTAL( -CURRENT_OFFSET ); ENDIF V; i_append_line := 0; MOVE_VERTICAL( 1 ); ENDIF; IF s_x <> '' THEN i_errors`0 X32 X:= i_errors + 1; s_text := CURRENT_LINE; POSITION( b_errors ); COPY_TEXT X( "The following line could not be unpacked properly:" ); SPLIT_LINE X; COPY_TEXT( s_x ); COPY_TEXT( s_text ); POSITION( b_part ); MOVE_VERTICAL X( 1 ); ENDIF; ENDLOOP; POSITION( BEGINNING_OF( b_part ) ); LOOP r_x := SEARCH X( "`096", FORWARD, EXACT ); EXITIF r_x = 0; POSITION( r_x ); ERASE_CHARACTER X( 1 );`032 VIF CURRENT_CHARACTER = "`096" THEN MOVE_HORIZONTAL( 1 ); ELSE`009! wjm added X ... X COPY_TEXT( ASCII( INT( ERASE_CHARACTER( 3 ) ) ) );`032 XENDIF;`009`009`009`009`009`009`009 ! ... for 6.03 - "`096`096" X`009`009`009`009`009`009`009 ENDLOOP`009 X; IF i_errors = 0 THEN SET( NO_WRITE, b_errors, ON ); ELSE POSITION X( BEGINNING_OF( b_errors ) ); COPY_TEXT( FAO X( "The following !UL errors were detected while unpacking !AS", i_errors X, s_file_spec ) ); SPLIT_LINE; SET( OUTPUT_FILE, b_errors, "SYS$COMMAND" ) X; ENDIF; EXIT;`032 X$ return X$! V$!*****`009VMS_SHAR 5.04 **************************************************** X****** X$share5: X$ 'dbg' if sharvers.eqs."" then w "-I-Assuming VMS_SHAR version 5.x" X$ if sharvers.eqs."" then sharvers = 504 X$ if sharvers.ne.504 then return SS$_FORMAT X$! X$ line = f$edit(line-x1,"trim") X$ outfn = f$element(1,"""",line) X$ if line.nes.""""+outfn+"""" then goto err_unx X$ gosub getline X$ if f$element(0,"=",line).nes."$Check_Sum_is" then goto err_unx X$ cksum = f$edit(line-"$Check_Sum_is=","trim") X$ if f$type(cksum).nes."INTEGER" then goto err_unx X$ gosub getline X$ if f$edit(line,"trim").nes."$Copy SYS$Input VMS_SHAR_DUMMY.DUMMY" then - X`009goto err_unx X$!*****`009do it X$ open/write UNSHARE_TEMP 'f' X$ w "-I-Working on ",outfn X$ goto cloop5 X$! X$! GOSUB entry repeated for faster access X$getline: X$ read/end=getline_eof UNSHARE_INPUT line X$ return 1 X$! X$cloop5: X$ gosub getline X$ if f$extract(0,19,line).eqs."$GoSub Convert_File" then goto cloop5end X$ write UNSHARE_TEMP line X$ goto cloop5 X$cloop5end: X$ goto unpack X$! X$!***** X$! X$unpack_504:`009!GOSUB`009`009`009`009! from VMS_SHAR 5.04-wjm X$ define/user sys$output nl: X$ EDIT/TPU/NOSECT/NODISP/NOJOU/COMM=SYS$INPUT 'f'/OUTPUT='ospec' Xf:=Get_Info(Command_Line,"File_Name");b:=Create_Buffer("",f); Xo:=Get_Info(Command_Line,"Output_File");Set(Output_File,b,o); XPosition(Beginning_of(b));Loop x:=Erase_Character(1);Loop ExitIf x<>"V"; XMove_Vertical(1);x:=Erase_Character(1);Append_Line; XMove_Horizontal(-Current_Offset);EndLoop;Move_Vertical(1); XExitIf Mark(None)=End_of(b) EndLoop;Position(Beginning_of(b));Loop Xx:=Search("`096",Forward,Exact);ExitIf x=0;Position(x);Erase_Character(1); XIf Current_Character='`096' then Move_Horizontal(1);else XCopy_Text(ASCII(INT(Erase_Character(3))));EndIf;EndLoop;Exit; X$ return V$!*************************************************************************** X*** X$! X$!*****`009no more files ...`032 X$expect_end: X$ if f$edit(line,"trim").eqs."$ v=f$verify(v)" then -`009! 7.1-004 X`009gosub getline X$ if f$edit(line,"trim,upcase,collapse").nes."$EXIT" then goto err_unx X$ close UNSHARE_INPUT X$eoi: X$ xstat=1 X$ goto done X$! X$!***** error handling X$err_on: X$ xstat=$status X$ set noon X$ if xstat.eq.RMS$_NMF then goto err_eoi X$ e f$fao("-F-VMS error !AS!/-!AS",f$string(xstat),f$message(xstat)-"%") X$ xstat=(xstat.and.%xFFFFFFF8).or.%x10000004 X$ goto done X$err_unx: X$ e "-E-UNXCMD, unexpected command in file: "+line X$ xstat=%x10000002 X$ goto done X$err_eoi: X$ e "-E-UNXEOF, unexpected end of input file(s)" X$ xstat=%x10000002 X$! X$!*****`009final cleanup X$done: X$ if f$search(f).eqs."" then goto notemp X$ close/nolog UNSHARE_TEMP X$ delete/nolog 'f'* X$notemp: X$ close/nolog UNSHARE_INPUT X$ deassign UNSHARE_INPUTS X$! X$ w "-I-Summary: "+- X f$fao("!SL file!%S created, !SL checksum error!%S, !SL file!%S skipped",- X`009 sum_files,sum_cksum,sum_skip) X$ if sum_ckskp.gt.0 then - X`009w "-W-Checksum NOT checked on " +- X`009 f$fao("!SL file!%S - NO GUARANTEES",sum_ckskp) X$! X$ exit xstat+f$ver(v,f$env("verify_image"))*0 $ GOSUB UNPACK_FILE $ EXIT