From: MERC::"uunet!WKUVX1.BITNET!DSJ-Mgr" 21-DEC-1992 09:16:03.83 To: galaxy::gleeve CC: Subj: OCTOBER92.MACRO $! ------------------ CUT HERE ----------------------- $ v='f$verify(f$trnlnm("SHARE_UNPACK_VERIFY"))' $! $! This archive created by VMS_SHARE Version 8.1 $! On 6-OCT-1992 12:26:37.75 By user GOATHUNTER (@WKUVX1.BITNET) $! $! The VMS_SHARE software that created this archive $! was written by Andy Harper, Kings College London UK $! -- September 1992 $! $! 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. [.MACRO]MACRO.VAX;1 $! $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 = "!" $ 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 $ 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-UNPACK, Unpacking file ''P1'" $ 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 'f'/OUT='n' PROCEDURE GetHex LOCAL x1,x2;x1:=INDEX(t,ERASE_CHARACTER(1))-1;x2:=INDEX(t, ERASE_CHARACTER(1))-1;RETURN 16*x1+x2;ENDPROCEDURE; PROCEDURE SkipPartsep LOOP EXITIF INDEX(ERASE_LINE,"-+-+-+-+-+-+-+-+")=1; ENDLOOP;ENDPROCEDURE; PROCEDURE ExpandChar CASE CURRENT_CHARACTER FROM ' ' TO 'z' ["`"] :ERASE_CHARACTER(1);COPY_TEXT(ASCII(GetHex));[" "]:ERASE_CHARACTER(1);[ OUTRANGE,INRANGE]:MOVE_HORIZONTAL(1);ENDCASE;ENDPROCEDURE; PROCEDURE ProcessLine s:=ERASE_CHARACTER(1);LOOP EXITIF CURRENT_OFFSET>=LENGTH( CURRENT_LINE);ExpandChar;ENDLOOP;IF s="V" THEN APPEND_LINE;ENDIF;ENDPROCEDURE; PROCEDURE AdvanceLine MOVE_HORIZONTAL(-CURRENT_OFFSET);MOVE_VERTICAL(1); ENDPROCEDURE;PROCEDURE Decode POSITION(BEGINNING_OF(b));LOOP EXITIF MARK(NONE)= END_OF(b);IF INDEX(CURRENT_LINE,"+-+-+-+-+-+-+-+-")=1 THEN SkipPartSep; ELSE ProcessLine;AdvanceLine;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'* $ if P2 .eqs. "" then $ goto ckskip $ checksum 'P1' $ if checksum$checksum .nes. P2 then $ - e "-E-CHKSMFAIL, Checksum of ''P1' failed." $ exit $ckskip: e "-W-CHKSUMSKIP, checksum validation unavailable for ''P1'" $ endsubroutine $start: $! $ create 'f' X`09Figure`201:`20`20MACRO-32`20routine`20rewritten`20in`20DEC`20C X X---------------------------------------------------------------------- XMACRO-32`20routine`20used`20in`20early`20versions`20of`20VMS`20to`20get`20the V`20process`20name X---------------------------------------------------------------------- X`09.library`20"sys$library:lib.mlb" X X`09$pcbdef X`09$ssdef X X`09.page X`09.sbttl`09extract_prcnam`20--`20copy`20process`20name`20to`20descriptor X;++ X;`20Abstract: X;`09Kernel`20mode`20procedure`20to`20copy`20the`20process`20name`20of`20the V`20current X;`09process`20into`20a`20use`20supplied`20descriptor. X; X;`20Inputs: X;`094(ap)`20--`20address`20of`20string`20descriptor`20to`20receive`20process V`20name. X; X;`20Outputs: X;`09Current`20process's`20name`20is`20written`20to`20supplied`20string`20descr Viptor. X; X;`20Return`20Value: X;`09-`20SS$_NORMAL X;`09-`20SS$_ACCVIO X;`09-`20SS$_BUFFEROVF X;-- X`09.psect`09code`20exe,`20shr,`20pic,`20novec,`20quad X Xextract_prcnam: X`09.word`09`5Em X`09moval`09g`5Elib$sig_to_ret,`20(fp)`09`09;`20ret`20exception`20status`20to V`20caller X`09movzwl`09#ss$_accvio,`20r0`09`09`09;`20assume`20access`20violation X`09ifnord`09#8,`20(ap),`2010$`09`09`09;`20br`20arguments`20not`20accessible X`09movl`094(ap),`20r1`09`09`09;`20load`20address`20of`20descriptor X`09ifnowrt`09#8,`20(r1),`2010$`09`09`09;`20br`20descriptor`20not`20writable X`09movq`09(r1),`20r2`09`09`09;`20load`20descriptor`20into`20r2,`20r3 X`09ifnowrt`09r2,`20(r3),`2010$`09`09`09;`20br`20descriptor`20not`20writable X`09movl`09g`5Esch$gl_curpcb,`20r4`09`09;`20load`20pcb`20into`20r4 X`09movzbl`09pcb$t_lname(r4),`20r0`09`09;`20get`20length`20of`20process`20name X`09movw`09r0,`20(r1)`09`09`09;`20write`20length`20into`20descriptor X`09movc5`09r0,`20pcb$t_lname+1(r4),`20#0,`20r2,`20(r3)`20;`20copy`20name`20int Vo`20descriptor X`09tstl`09r0`09`09`09`09;`20test`20buffer`20overflow X`09bneq`0920$`09`09`09`09;`20branch`20if`20yes X`09movl`09#ss$_normal,`20r0`09`09`09;`20load`20normal`20return`20status X10$:`09ret X X20$:`09movl`09g`5Esch$gl_curpcb,`20r4`09`09;`20restore`20r4 X`09movzbl`09pcb$t_lname(r4),`20r1`09`09;`20get`20length`20of`20process`20name X`09subl2`09r0,`20r1`09`09`09`09;`20get`20length`20of`20string`20copied X`09movw`09r1,`20@4(ap)`09`09`09;`20write`20length`20into`20descriptor X`09movzwl`09#ss$_bufferovf,`20r0`09`09;`20load`20buffer`20two`20small`20status V X`09ret X X`09.page X`09.sbttl`09getprcnam`20--`20procedure`20to`20hid`20cmkrnl`20system`20service X;++ X;`20Abstract: X;`09getprcnam`20hides`20the`20cmkrnl`20system`20service`20form`20the`20calling V`20program. X; X;`20Inputs: X;`09ap`20--`20argument`20list`20pointer`20passed`20to`20getprcnam X; X;`20Return`20Value X;`09any`20status`20returned`20from`20getprcnam X; X;`20Special`20Notes: X;`09Requires`20cmkrnl`20privilege X;-- X`09.align`09quad X`09.entry`09getprcnam,`20`5Em<> X`09$cmkrnl_s`20b`5Eextract_prcnam,`20(ap) X`09ret`09 X`09.end X`0C X--------------------------------------------------------------- XHigh`20level`20language`20routine`20to`20replace`20obsolute`20MACRO32`20routin Ve X--------------------------------------------------------------- X/* X`20*`20Abstract: X`20*`09Procedure`20to`20get`20the`20current`20process`20name`20using`20the`20S VYS$GETJPIW X`20*`09System`20Service. X`20* X`20*`20Inputs: X`20*`09None X`20* X`20*`20Outputs: X`20*`09Process`20name`20of`20current`20process`20is`20written`20into`20supplie Vd`20character X`20*`09string`20descriptor. X`20* X`20*`20Return`20Value: X`20*`09Program`20status X`20* X`20*/ X#include`20 X#include`20 X#include`20 X Xunsigned`20long`20int Xgetprcnam(`20struct`20dsc$descriptor_s`20*prcnam`20) X`7B X`20`20`20`20struct X`20`20`20`20`7B X`09unsigned`20short`09buflen;`09 X`09unsigned`20short`09item_code; X`09char`09*bufadr; X`09unsigned`20short`09*retlen; X`20`20`20`20`7D`20itmlst`5B2`5D; X X`20`20`20`20itmlst`5B0`5D.buflen`20=`20prcnam->dsc$w_length; X`20`20`20`20itmlst`5B0`5D.item_code`20=`20JPI$_PRCNAM; X`20`20`20`20itmlst`5B0`5D.bufadr`20=`20prcnam->dsc$a_pointer; X`20`20`20`20itmlst`5B0`5D.retlen`20=`20`26prcnam->dsc$w_length; X`20`20`20`20itmlst`5B1`5D.buflen`20=`200; X`20`20`20`20itmlst`5B1`5D.item_code`20=`200; X X`20`20`20`20return`20(`20SYS$GETJPIW(`200,`20NULL,`20NULL,`20itmlst,`20NULL, V`20NULL,`200`20)`20); X`7D $ call unpack [.MACRO]MACRO.VAX;1 40277635 "" $ v=f$verify(v) $ exit