$! ------------------ CUT HERE ----------------------- $ v='f$verify(f$trnlnm("SHARE_UNPACK_VERIFY"))' $! $! This archive created by VMS_SHARE Version 8.2A $! On 10-FEB-1993 17:12:39.25 By user UDAA055 $! $! The VMS_SHARE software that created this archive $! was written by Andy Harper, Kings College London UK $! -- December 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. TPU.CRYPT;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 = "!" $ 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 $ 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 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(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 LOOP EXITIF MARK(NONE)=END_OF(b);EXITIF INDEX(ERASE_LINE, "-+-+-+-+-+-+-+-+")=1;ENDLOOP;ENDPROCEDURE;PROCEDURE COPY_PREVIOUS(b,n)LOCAL m, s,e;m:=MARK(NONE);MOVE_HORIZONTAL(-b);s:=MARK(NONE);MOVE_HORIZONTAL(n-1);e:= MARK(NONE);POSITION(m);COPY_TEXT(CREATE_RANGE(s,e));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 '`' ['\']: b:=GetHex(s,p); n:=GetHex(s,p+2); p:=p+4; COPY_PREVIOUS(b,n);['`']: COPY_TEXT(ASCII(GetHex(s,p))); p:=p+2;[' ']: p:=p+1; [INRANGE,OUTRANGE]: COPY_TEXT(c);ENDCASE;ENDLOOP;ENDPROCEDURE; PROCEDURE Decode POSITION(BEGINNING_OF(b));LOOP EXITIF MARK(NONE)=END_OF(b); 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' XFrom:`09CBS%UK.AC.NSFNET-RELAY::EDU.SHSU::FILESERV`2026-JAN-1993`2015:23:57.89 V XTo:`09UDAA055 XCC:`09 XSubj:`09TPU.CRYPT X XVia:`20\6612;`20Tue,`2026`20Jan`2093`20\5706`20GMT XReceived:`20from`20odin.shsu.edu`20by`20sun3.nsfnet-relay.ac.uk`20with`20Inter Vnet`20SMTP`20 X`20`20`20\0303\0404id`20;\330B\A30C\FB092:23`20+0000 X\A90Aby`20SHSU\A205(MX`20V3.1C)\74042;\471209:23:19`20CST XDate:`20\241EFrom:`20FILESERV-Mgr@edu.SHSU XReply-To\200A\1C0ASubject:`20TPU.CRYPT XTo:`20UDAA055@UK.AC.KCL.CC.OAK X X$!! X$!!`20`20Module`20Name`20`20`20\0303\0606\0505:`20`20MAKE_CRYPT.COM\1605\3C0A V\0E04System`20Designation\3C08\240A\6407Descrip\240CText`20encry\1706program X\3B09\9411\9B09\240AOriginal`20P\3E06mer`20\2406UCS_KAS X\B20DDate`20Approved`20\EE0D9-MAY-1989\E607\1703WRITE`20SYS$OUTPUT`20"Creating V`20CRYPT`20sec\BC05file..."\3605EDIT/TPU/NOSECTION/NODISPLAY/COMMAND=SYS$INPUT V X! X!`20This`20program`20is`20put`20into`20the`20public`20domain. X!`20You`20may`20do`20anyth\9004you`20want`20with`20it\2804I`20take`20no`20resp Vonsibility`20for`20it's`20use`20or`20correctness\3804Please`20leave`20this`20d Visclaimer`20in\9506\AD06. X! X!`20Send`20comments\5104suggestions`20to`20UCS_KAS@SHSUODIN`20`20(BITNET) X!`20Ken`20Selvia X!`208-MAY-1989 X! XPROCEDURE`20TPU$INIT_P\1308 XLOCAL`20st1,st2,key,dir,idx,cipher1\08072,`20input_key,`20key_length,i; XSET(FACILITY_NAME,`20"CRYPT")\1D06SUCCESS,OFF); X\4806file`20:=`20FILE_SEARCH(GET_INFO`20(COMMAND_LINE,"FILE_NAME")); XIF`20INPUT_FILE`20=`20""`20THEN X`20`20`20`20MESSAGE("`20CRYPT`20-`20F\6804encryption`20utility."); X\320EUnable`20to`20read`20input`20file\2C13\3E13sage:`20\7807file.name\3B1AQUI VT; XENDIF; Xalpha`20:=`20'ABCDEFGHIJKLMNOPQRSTUVWXYZ`20abcdefghijklmnopqrstuvwxyz'; Xkey\4005';st1`20\0A082`20\0A06cipher\1808\0E06\1C08 Xsource_buffer\1504create\1107("\200D",input_file); Xposition(beginning_of(\320D)); Xif`20current_character`20=`20ascii(0)`20then X`20`20`20`20di\82050;\0E05resp\0F04read_line("Text`20is`20Encrypted,`20do`20yo Vu`20wish`20to`20decrypt`20(Y/N)?:`20"); X\4D04if`20index("Yy",substr(resp,1,1))\8F030`20\8809\0404quit\3B06endif Xelse\A50C1;\A520not`20\A91Aen\A958ndif; Xinput_key`20\9E0D'Enter`20password:`20'); Xkey_length`20:=`20\0A06(i\4108); Xi`20\F206loop\6B06xitif`20i`20>=`20\3E0A\C20Fkey\C108\4D09,i\C616\A907\0704+ V`20\3515\5D06\6105dx\2C04\0704+`20(index(alpha,\6E17*`2010\4007else\4909messag Ve(fao("Duplicate`20character`20>!AS<`20ignored.`20Continuing...", X\4808\0808\7F16\7A08ndif\0B06i`20\BF04\BD031; Xendloop; Xloop\2906xitif`20\DF04<`20255;\3406\F50A-`20255; X\3A09\4F050;\4212`20=`20256;\4006f`20index(key,ascii(i))`20=`200`20then X\C409t1\4F04\0704+`20\2808\C212\4E12255\9A03\54172`20\54052`20\5408\2E08\5A12 V\E605\28031;\E20Flength(key); X\EC09\ED0C0;\1306cipher\C805\0B08+`20substr(key,i,1)\2B07\6F07-`20\6F0C\B507 V\4105key\3D04t1\1709\CC0B\5E07\1B09len\AA0Bst2\6708\3608\8406st2,idx,stlen) V`20\9C09st2,1,idx\9004\3B08translate(current_buffer,st1,\630Bif`20dir`20=`200 V`20then`20erase_character(\5109\0505message`20('Text`20decrypted')\2607else V\300Bcopy_text(ascii(0))\4F1Ben\4F11ndif\0C08xit; Xendprocedure X!`20\1803This`20line`20is`20only`20executed`20w\D204compiling`20the`20TPU`20pr Vogram. Xsave`20("SYS$LOGIN:crypt"); Xquit; X$`20`20`20CRYPT`20==`20"EDIT/TPU/SECTION=S\3809CRYPT/NODISPLAY`20"\3B05TYPE V`20SYS$INPUT X$DECK X X X XC\5305section`20file`20created. X XUsage:`20\7A09file.name X\3807is`20defined`20for`20this`20session. XAdd`20\E704next`20line`20to`20your`20LOGIN.COM\3605future`20use... X X$C\E636 X X$EOD X\ED04EXIT $ call unpack TPU.CRYPT;1 352335423 "" $ v=f$verify(v) $ exit