$! ------------------ 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<sg.28699-0@s\4516>;\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
