From:	CRDGW2::CRDGW2::MRGATE::"SMTP::CRVAX.SRI.COM::RELAY-INFO-VAX" 13-MAR-1992 20:06:56.07
To:	ARISIA::EVERHART
CC:	
Subj:	Re: "MAILUAF.COM" for VMS 5.x?

From:	RELAY-INFO-VAX@CRVAX.SRI.COM@SMTP@CRDGW2
To:	Everhart@Arisia@MRGATE

Received:  by crdgw1.ge.com (5.57/GE 1.123)
	 id AA15706; Fri, 13 Mar 92 18:47:12 EST
Received: From ucbvax.Berkeley.EDU ([128.32.133.1]) by CRVAX.SRI.COM with TCP; Fri, 13 MAR 92 14:31:48 PST
Received: by ucbvax.Berkeley.EDU (5.63/1.43)
	id AA07145; Fri, 13 Mar 92 13:34:47 -0800
Received: from USENET by ucbvax.Berkeley.EDU with netnews
	for info-vax@kl.sri.com (info-vax@kl.sri.com)
	(contact usenet@ucbvax.Berkeley.EDU if you have questions)
Date: 9 Mar 92 16:42:13 GMT
From: psinntp!iscnvx!sunfse!news@uunet.uu.net  (news)
Organization: LMSC, Sunnyvale, California
Subject: Re: "MAILUAF.COM" for VMS 5.x?
Message-Id: <1070@sunfse.ese.lmsc.lockheed.com>
References: <4922059@zl2tnm.gen.nz>,<1992Mar4.114934.16236@yang.earlham.edu>
Sender: info-vax-request@kl.sri.com
To: info-vax@kl.sri.com

In article <1992Mar4.114934.16236@yang.earlham.edu>, nathant@yang.earlham.edu writes:
>I just saw the following code and it reminded me of a .com file we got back
>in VMS 4.x (from DECUS, maybe?) called MAILUAF.COM or some such.  It would
>let you edit the VMS mail profile file directly, examining and setting
>forwarding addresses, mail directories, etc -- even deleting records
>entirely.
>
>This program broke with VMS 5.x.  Has anyone upgraded it?

I picked up this MAILUAF.COM from somewhere; it works great. It doesn't
let you "edit" VMSMAIL_PROFILE.DATA, as you are suggesting, but it does
have a command line interface with "MOD" and "ADD" and "LIST" commands, etc.
It's about 500 lines long; I normally would post such a long procedure but
I've seen several requests for this one, so...

Bob Marshall
marshall@force.ssd.lmsc.lockheed.com

P.S. - I DID NOT WRITE THIS PROCEDURE!! I TAKE NO CREDIT NOR BLAME FOR IT!!
Oh, and don't forget to strip out my .SIG at the end; I don't think DCL
would like it.
*------------------------------- Cut here --------------------------------*
$   ver = 'F$VERIFY(0)
$!++
$!
$!  MAILUAF.COM -- Modify SYS$SYSTEM:VMSMAIL_PROFILE.DATA
$!
$!  ABSTRACT:
$!	This procedure can be called interactively (it prompts for
$!	commands to perform) or non-interactively (it does a single
$!	command, with the command specified as P1 and any data needed
$!	as P2 and P3).  The valid commands are:
$!
$!	  ADD username fwdaddr		Add a user to VMSMAIL_PROFILE.DATA
$!	  CANCEL username		Cancel forwarding
$!	  DIRSET username subdir	Set/Modify/Cancel mail subdirectory
$!	  EXIT				Exit MAILUAF
$!	  FORWARD username fwdaddr	Set/Modify/Cancel forwarding
$!	  HELP				Display help text
$!	  LIST [outfile]		List all users, showing forwarding
$!	  NAME oldusername newuser	Rename a user
$!	  REMOVE username		Remove a user from VMSMAIL_PROFILE.DATA
$!	  SHOW username			Display user's mail information
$!	  SET username			Set any of user's mail information
$!	  WRITE username outfile	Build command to copy user's data
$!	  LISTF pattern [outfile]	List all users who are forwarding to:
$!					  node::     user     node::user
$!					  *   (any forwarding)
$!					  *:: (forwarding to any node)
$!					  **  (forwarding to a different user)
$!
$!	If used interactively:  any data not supplied on the command line
$!	is prompted for; entering a null command performs an EXIT.
$!
$!	If ADD is used non-interactively, P4 can be a personal name, and
$!	P5 can be a mail subdirectory.
$!
$!	If LIST is used with no output file name, SYS$OUTPUT is used.
$!
$!	The DIRSET command does not create the subdirectory or move any
$!	MAIL files; it just updates VMSMAIL_PROFILE.DATA.  Entering "[]"
$!	for the directory name cancels any existing subdirectory.  Sub-
$!	directories must be in the format "[.name]".
$!
$!	Entering "*" for the forwarding address on the FORWARD command
$!	cancels any existing forwarding.  Entering "*" for the username
$!	on the WRITE command copies all users' data.
$!
$!
$!  REQUIRED PRIVILEGES:
$!		SYSPRV
$!
$!  IMPLICIT OUTPUT:
$!		SYS$SYSTEM:VMSMAIL_PROFILE.DATA will be created if it
$!		does not currently exist.
$!
$!
$!	Alan L. Zirkle			17 April 1987
$!
$!	Naval Surface Warfare Center
$!	Dahlgren, Virginia  22448
$!
$!	(703) 663-8023
$!
$!	Updated to VMS V5		26 May 1989
$!
$!--
$   SET = "SET"
$   SET SYMBOL /SCOPE=(NOLOCAL,NOGLOBAL)
$   ON CONTROL_Y THEN  GOTO DONE
$!
$   IF F$MODE() .EQS. "OTHER"
$   THEN
$	Enquire = "READ AZ"		! For OTHERNODE utility (on DECUS tape)
$	OPEN AZ SYS$COMMAND
$   ELSE
$	Enquire = "READ SYS$COMMAND"
$   ENDIF
$   Echo = "WRITE SYS$OUTPUT"
$   sysmai = "SYS$SYSTEM:VMSMAIL_PROFILE.DATA" ! Change this line when debugging
$   prev_priv = F$SETPRV("SYSPRV")
$!
$   node = F$TRNLNM("SYS$NODE") - "::"
$   IF node .NES. "" THEN  node = " for node " + node
$   cluster = F$TRNLNM("SYS$CLUSTER_NODE") - "::"
$   IF cluster .NES. "" THEN  node = " for " + cluster + " cluster"
$   Echo F$FAO("!/(Processing VMS MAIL Information File!AS)!/",node)
$!
$   IF F$SEARCH(sysmai) .EQS. "" THEN  GOTO NO_FILE
$!
$ OPEN_FILE:
$   OPEN /SHARE=WRITE /READ /WRITE fl 'sysmai'
$!
$   canned = p1 .NES. ""
$   IF canned THEN  line = p1 + " " + p2 + " " + p3
$   IF canned THEN  GOTO PARSE
$!
$ MAIN_LOOP:
$   IF canned THEN  GOTO DONE
$   ENQUIRE line /PROMPT="MAILUAF> "
$!
$ PARSE:
$   line = F$EDIT(line,"UNCOMMENT,TRIM,COMPRESS,UPCASE")
$   IF line .EQS. "" THEN  GOTO DONE
$!
$   command = F$ELEMENT(0," ",line)
$   user = F$ELEMENT(1," ",line)
$   data = F$ELEMENT(2," ",line)
$   IF canned .AND. data .EQS. "" THEN  data = ""
$!
$   IF F$LOCATE(command,"HELP")  .EQ. 0 THEN  GOTO HELP_USER
$   IF F$LOCATE(command,"EXIT")  .EQ. 0 THEN  GOTO DONE
$   IF F$LOCATE(command,"LIST")  .EQ. 0 THEN  GOTO LIST_USERS
$   IF F$LOCATE(command,"LISTF") .EQ. 0 THEN  GOTO LISTF_USERS
$!
$   IF user .NES. " " THEN  GOTO PARSE_10
$   IF canned THEN  GOTO DONE
$   Enquire user /PROMPT="  Username to ''command': "
$   user = F$EDIT(user,"UNCOMMENT,COLLAPSE,UPCASE")
$   IF user .EQS. "" THEN  GOTO MAIN_LOOP
$!
$ PARSE_10:
$   keyed_read = "READ /INDEX=0 /KEY=""" + F$FAO("!31AS",user) + """ FL record "
$!
$   IF F$LOCATE(command,"ADD")     .EQ. 0 THEN  GOTO ADD_USER
$   IF F$LOCATE(command,"CANCEL")  .EQ. 0 THEN  GOTO CANCEL_USER
$   IF F$LOCATE(command,"FORWARD") .EQ. 0 THEN  GOTO FORWARD_USER
$   IF F$LOCATE(command,"REMOVE")  .EQ. 0 THEN  GOTO REMOVE_USER
$   IF F$LOCATE(command,"SHOW")    .EQ. 0 THEN  GOTO SHOW_USER
$   IF F$LOCATE(command,"DIRSET")  .EQ. 0 THEN  GOTO DIRSET_USER
$   IF F$LOCATE(command,"SET")     .EQ. 0 THEN  GOTO SET_USER
$   IF F$LOCATE(command,"NAME")    .EQ. 0 THEN  GOTO NAME_USER
$   IF F$LOCATE(command,"WRITE")   .EQ. 0 THEN  GOTO WRITE_USER
$!----------------------------------------------------------------------
$ HELP_USER:
$   TYPE SYS$INPUT:

	ADD username	  Add a new user; optionally set forwarding
	CANCEL username	  Cancel forwarding for a user
	DIRSET username	  Set/Change a user's MAIL subdirectory
	EXIT		  Exit from MAILUAF
	FORWARD username  Set/Modify/Cancel forwarding for a user
	HELP		  Type this text
	LIST [outfile]	  List all known users, showing forwarding
	NAME old new	  Rename a user
	REMOVE username	  Remove a user completely
	SHOW username	  Show MAIL information about a user
	SET username	  Set any of user's mail information (be careful!)
	WRITE uname file  Build command to copy user(s) data
	LISTF pat [file]  List all users who are forwarding to:
                            node::     user     node::user
                             *   (any forwarding)
                             *:: (forwarding to any node)
                             **  (forwarding to a different user)

$   GOTO MAIN_LOOP
$!----------------------------------------------------------------------
$ ADD_USER:
$   KEYED_READ /ERR=ADD_10
$   Echo "%MAILUAF-W-ALREADY, user ",user,"'s record already exists"
$   GOTO MAIN_LOOP
$!
$ ADD_10:
$   record = F$FAO("!31AS",user)
$   IF data .EQS. " " .AND. .NOT. canned THEN -
	       Enquire data /PROMPT="Forwarding address (enter <CR> if none): "
$   data = F$EDIT(data,"UNCOMMENT,TRIM,COMPRESS,UPCASE")
$   IF data .EQS. "*" .OR. data .EQS. " " THEN  data = ""
$   iforward = data
$!
$   iunread = 0
$   iflags = 0
$   ipersonal = ""
$   isubdir = ""
$   ieditor = ""
$   iqueue = ""
$   iform = ""
$!
$   IF canned
$   THEN
$     ipersonal = p4
$     isubdir = p5	! iflags, ieditor, iqueue, iform
$   ENDIF
$!
$   GOSUB PUTFIELDS
$   WRITE FL record
$   Echo "  User ",user," successfully added"
$   GOTO MAIN_LOOP
$!----------------------------------------------------------------------
$ CANCEL_USER:
$   data = "*"
$   GOTO FORWARD_USER
$!----------------------------------------------------------------------
$ LIST_USERS:
$   file = user
$   GOSUB STARTLIST
$!
$ LIST_10:
$   READ /END=LIST_20 FL record
$   user = F$FAO("!12AS",F$EDIT(F$EXTRACT(0,31,record),"TRIM"))
$   GOSUB GETFIELDS
$   WRITE 'outfile' user,"  ",iforward
$   GOTO LIST_10
$!
$ LIST_20:
$   WRITE 'outfile' ""
$   IF outfile .EQS. "OFL" THEN  CLOSE OFL
$   GOTO MAIN_LOOP
$!______________________________________________________________________
$ STARTLIST:
$   node_ = node
$   IF node_ .NES. "" THEN  node_ = "Node" + (node_ - " for node") + "  "
$   IF cluster .NES. "" THEN  node_ = cluster + " Cluster  "
$!
$   IF file .EQS. " "			! Output file name used?
$   THEN
$	outfile = "SYS$OUTPUT"
$   ELSE
$	OPEN /WRITE OFL 'file'
$	outfile = "OFL"
$   ENDIF
$!
$   CLOSE FL
$   OPEN /SHARE=WRITE /READ /WRITE FL 'sysmai'
$!
$   WRITE 'outfile' -
	F$FAO("!/Username      Forwarding address      !AS!17%D!/",node_,0),-
		"--------      ------------------"
$   RETURN
$!----------------------------------------------------------------------
$ LISTF_USERS:
$   IF user .EQS. " " THEN -
		 Enquire user /PROMPT="Enter forwarding pattern to check for: "
$   fwdpat = F$EDIT(user,"UNCOMMENT,TRIM,COMPRESS,UPCASE")
$   IF fwdpat - "::" .NES. fwdpat
$   THEN
$	fcode = 1					    ! NODE::
$	IF F$ELEMENT(2,":",fwdpat) .NES. "" THEN  fcode = 2 ! NODE::USER
$	IF fwdpat .EQS. "*::"  THEN  fcode = 4		    ! *:: (any oth node)
$   ELSE
$	fcode = 0					    ! USER
$	IF fwdpat .EQS. "*"  THEN  fcode = 3		    ! * (any forwarding)
$	IF fwdpat .EQS. "**" THEN  fcode = 5		    ! ** (any oth user)
$   ENDIF
$!
$   file = data
$   GOSUB STARTLIST
$!
$ LISTF_10:
$   READ /END=LIST_20 FL record
$   user = F$EDIT(F$EXTRACT(0,31,record),"TRIM")
$   GOSUB GETFIELDS
$   IF iforward .EQS. "" THEN  GOTO LISTF_10
$   IF iforward - "::" .EQS. iforward
$   THEN
$	IF fcode .EQ. 0 THEN -
	      IF fwdpat .NES. iforward THEN  iforward = ""
$       IF fcode .EQ. 1 THEN  iforward = ""
$       IF fcode .EQ. 2 THEN  iforward = ""
$       IF fcode .EQ. 4 THEN  iforward = ""
$       IF fcode .EQ. 5 THEN -
	      IF user .EQS. iforward THEN  iforward = ""
$   ELSE
$	IF fcode .EQ. 0 THEN -
	      IF fwdpat .NES. F$ELEMENT(2,":",iforward) THEN  iforward = ""
$	IF fcode .EQ. 1 THEN -
	      IF fwdpat-"::" .NES. F$ELEMENT(0,":",iforward) THEN  iforward = ""
$	IF fcode .EQ. 2 THEN -
	      IF fwdpat .NES. iforward THEN  iforward = ""
$	IF fcode .EQ. 5 THEN -
	      IF user .EQS. F$ELEMENT(2,":",iforward) THEN  iforward = ""
$   ENDIF
$   IF iforward .NES. "" THEN  WRITE 'outfile' F$FAO("!12AS",user),"  ",iforward
$   GOTO LISTF_10
$!----------------------------------------------------------------------
$ FORWARD_USER:
$   KEYED_READ /ERR=NOSUCHUSER
$   GOSUB GETFIELDS
$   oldfwd = iforward
$   IF oldfwd .EQS. "" THEN  oldfwd = "(none)"
$!
$   IF data .EQS. " " THEN -
    Enquire data /PROMPT="New forwarding address (or * to cancel forwarding): "
$   data = F$EDIT(data,"UNCOMMENT,TRIM,COMPRESS,UPCASE")
$   IF data .NES. ""
$   THEN
$	IF data .EQS. "*" THEN  data = ""
$	iforward = data
$	GOSUB PUTFIELDS
$	WRITE /UPDATE FL record
$	IF data .EQS. "" THEN  data = "(none)"
$	Echo "  User ",user,"'s forwarding changed from ",oldfwd," to ",data
$   ELSE
$	Echo "%MAILUAF-W-NOCHG, forwarding NOT changed for ",user
$   ENDIF
$   GOTO MAIN_LOOP
$!----------------------------------------------------------------------
$ REMOVE_USER:			! Note no confirmation prompt
$   KEYED_READ /ERR=NOSUCHUSER
$   KEYED_READ /DELETE
$   Echo "  User ",user," successfully removed"
$   GOTO MAIN_LOOP
$!----------------------------------------------------------------------
$ SHOW_USER:
$   KEYED_READ /ERR=NOSUCHUSER
$   GOSUB GETFIELDS
$!
$   Echo F$FAO("!/User !AS                   Unread: !UL        Flags: %X!4XL",-
							    user,iunread,iflags)
$   Echo F$FAO(   " Mail subdirectory: !AS!/     Personal name: !AS" + -
		"!/        Forwarding: !AS!/            Editor: !AS" + -
		"!/             Queue: !AS!/              Form: !AS!/",-
				isubdir,ipersonal,iforward,ieditor,iqueue,iform)
$   GOTO MAIN_LOOP
$!----------------------------------------------------------------------
$ DIRSET_USER:
$   KEYED_READ /ERR=NOSUCHUSER
$   GOSUB GETFIELDS
$   olddir = isubdir
$   If olddir .EQS. "" THEN  olddir = "(none)"
$!
$   IF data .EQS. " " THEN -
	     Enquire data /PROMPT="New mail subdirectory (enter [] for none): "
$   data = F$EDIT(data,"UNCOMMENT,TRIM,COMPRESS,UPCASE")
$   IF data .EQS. "" THEN  GOTO DIRSET_50
$   IF data .EQS. "[]" THEN  data = ""
$   t1 = F$LENGTH(data)
$   IF data .EQS. "" THEN  GOTO DIRSET_30
$   IF F$EXTRACT(0,2,data) .NES. "[." .OR. F$EXTRACT(t1-1,1,data) .NES. "]" -
							THEN  GOTO DIRSET_40
$ DIRSET_30:
$   isubdir = data
$   GOSUB PUTFIELDS
$   WRITE /UPDATE FL record
$   If data .EQS. "" THEN  data = "(none)"
$   Echo "  User ",user,"'s mail subdirectory changed from ",olddir," to ",data
$   GOTO MAIN_LOOP
$!
$ DIRSET_40:
$   Echo "%MAILUAF-W-BADDIR, directory must begin with '[.' and end with ']'"
$!
$ DIRSET_50:
$   Echo "%MAILUAF-W-NOCHG, mail directory NOT changed for ",user
$   GOTO MAIN_LOOP
$!----------------------------------------------------------------------
$ SET_USER:
$   KEYED_READ /ERR=NOSUCHUSER
$   GOSUB GETFIELDS
$!
$   Enquire x /PROMPT="  New mail count (default ''iunread'): "
$     IF x .NES. "" THEN  iunread = F$INTEGER(x)
$   Enquire x /PROMPT="  Flags (default ''F$FAO("%X!4ZL",iflags)'): "
$     IF x .NES. "" THEN  iflags = F$INTEGER("%X" + (x - "%X"))
$!
$   fields =              " isubdir iforward ipersonal ieditor iqueue iform"
$   names = "/Mail subdirectory/Forwarding/Personal name/Editor/Queue/Form"
$   i = 0
$   Echo "  Enter ""*"" to clear any field--"
$ SET_10:
$   i = i + 1
$   field = F$ELEMENT(i," ",fields)
$   IF field .EQS. " " THEN  GOTO SET_20
$   default = 'field'
$   IF default .EQS. "" THEN  default = "<none>"
$   name = F$ELEMENT(i,"/",names)
$   Enquire x /PROMPT="  ''name' (default ""''default'""): "
$   IF x .NES. ""  THEN  'field' = x
$   IF x .EQS. "*" THEN  'field' = ""
$   GOTO SET_10
$!
$ SET_20:
$   Enquire x /PROMPT="Enter Y to modify user record: "
$   IF F$EXTRACT(0,1,F$EDIT(x,"UPCASE")) .NES. "Y" THEN  GOTO MAIN_LOOP
$   GOSUB PUTFIELDS
$   WRITE /UPDATE FL record
$   GOTO MAIN_LOOP
$!----------------------------------------------------------------------
$ NAME_USER:
$   IF data .EQS. " " THEN Enquire data /PROMPT="Enter new username: "
$   data = F$EDIT(data,"UNCOMMENT,COLLAPSE,UPCASE")
$   IF data .EQS. "" THEN  GOTO NAME_20
$!
$   newname = F$FAO("!31AS",data)
$   READ /INDEX=0 /ERR=NAME_10 /KEY="''newname'" FL record
$   Echo "%MAILUAF-W-ALREADY, user ",user,"'s record already exists"
$   GOTO MAIN_LOOP
$!
$ NAME_10:
$   KEYED_READ /ERR=NOSUCHUSER
$   newrec = newname + F$EXTRACT(31,512,record)
$   KEYED_READ /DELETE
$   WRITE FL newrec
$   Echo "  Record successfully renamed from ",user," to ",data
$   GOTO MAIN_LOOP
$!
$ NAME_20:
$   Echo "%MAILUAF-W-NOTDONE, user ",user," was NOT renamed"
$   GOTO MAIN_LOOP
$!----------------------------------------------------------------------
$ WRITE_USER:
$   IF data .EQS. " " .OR. data .EQS. "" THEN  data = "MAILUAF.OUT"
$   OPEN /WRITE OFL 'data'
$   IF user .EQS. "*" THEN  GOTO WRITE_10
$   KEYED_READ /ERR=NOSUCHUSER
$   GOSUB GETFIELDS
$   GOTO WRITE_30
$!
$ WRITE_10:
$   CLOSE FL
$   OPEN /SHARE=WRITE /READ /WRITE FL 'sysmai'
$!
$ WRITE_20:
$   READ /END=WRITE_40 FL record
$!
$ WRITE_30:
$   user_ = F$EDIT(F$EXTRACT(0,31,record),"TRIM")
$   WRITE OFL "$ MAILUAF ADD ",user_," """,iforward,""" """,-
						ipersonal,""" """,isubdir,""""
$   IF user .EQS. "*" THEN  GOTO WRITE_20
$!
$ WRITE_40:
$   CLOSE OFL
$   IF user .EQS. "*" THEN  user = "All Users"
$   Echo "  Data for ",user," written to ",data
$   GOTO MAIN_LOOP
$!----------------------------------------------------------------------
$ NO_FILE:
$   Echo F$FAO("!/!AS not found; creating new file . . .!/",sysmai)
$!
$   CREATE /FDL=SYS$INPUT: 'sysmai'	! Note--FDL is from VMS V4

IDENT	VMS MAIL Information data file

FILE
	ALLOCATION		10
	BEST_TRY_CONTIGUOUS	yes
	BUCKET_SIZE		2
	CONTIGUOUS		no
	GLOBAL_BUFFER_COUNT	0
	ORGANIZATION		indexed
	OWNER			[001,004]
	PROTECTION		(system:RWE, owner:RWE, group:, world:)

RECORD
	BLOCK_SPAN		yes
	CARRIAGE_CONTROL	none
	FORMAT			variable
	SIZE			0

AREA 0
	ALLOCATION		10
	BEST_TRY_CONTIGUOUS	yes
	BUCKET_SIZE		2
	CONTIGUOUS		no
	EXTENSION		10

KEY 0
	CHANGES			no
	DATA_KEY_COMPRESSION	yes
	DATA_RECORD_COMPRESSION	yes
	DATA_AREA		0
	DATA_FILL		100
	DUPLICATES		no
	INDEX_AREA		0
	INDEX_COMPRESSION	yes
	INDEX_FILL		100
	LEVEL1_INDEX_AREA	0
	NULL_KEY		no
	PROLOGUE		3
	SEG0_LENGTH		31
	SEG0_POSITION		0
	TYPE			string

$   GOTO OPEN_FILE
$!
$ NOSUCHUSER:
$   Echo "%MAILUAF-W-NOSUCH, ",user," is not a known user"
$   GOTO MAIN_LOOP
$!
$! Format of a VMSMAIL_PROFILE.DATA record:
$!
$!  Characters 0-30 -- Username, blank-filled (key for indexed sequential file)
$!
$!  Characters 31+  -- Itemlist; each item is:
$!			16-bit item code
$!			16-bit item length (n)
$!			n-byte item value
$ GETFIELDS:
$   iunread = 0		! Code 1 -- Unread message count -- (length 2) Required
$   iflags = 0		! Code 2 -- Flags (cc, auto, etc) -- (length 2) Optional
$   isubdir = ""	! Code 3 -- Mail subdirectory -- requires [. and ]
$   iforward = ""	! Code 4 -- Forwarding
$   ipersonal = ""	! Code 5 -- Personal name
$   ieditor = ""	! Code 8 -- Editor (default EDT)
$   iqueue = ""		! Code 9 -- Queue (default SYS$PRINT)
$   iform = ""		! Code D -- Form
$   pos = 31
$ FLOOP:
$   code  = F$CVUI(pos*8,16,record)
$   len   = F$CVUI(pos*8+16,16,record)
$   value = F$EXTRACT(pos+4,len,record)
$   IF code.LT.1 .OR. code.GT.13 THEN  GOTO BADCODE
$   GOTO F'code'
$ F1: iunread = F$CVUI(0,16,value)
$   GOTO FEND
$ F2: iflags = F$CVUI(0,16,value)
$   GOTO FEND
$ F3: isubdir = value
$   GOTO FEND
$ F4: iforward = value
$   GOTO FEND
$ F5: ipersonal = value
$   GOTO FEND
$ F6:
$ F7:
$ F10:
$ F11:
$ F12:
$ BADCODE:
$   Echo "%MAILUAF-F-FATAL, illegal item code ",code," found in record"
$   GOTO DONE
$ F8: ieditor = value
$   GOTO FEND
$ F9: iqueue = value
$   GOTO FEND
$ F13: iform = value
$   GOTO FEND
$ FEND:
$   pos = pos + 4 + len
$   IF pos .LT. F$LENGTH(record) THEN  GOTO FLOOP
$   IF ieditor .EQS. "" THEN  ieditor = "EDT"
$   IF iqueue  .EQS. "" THEN  iqueue  = "SYS$PRINT"
$   RETURN
$!
$ PUTFIELDS:
$   fields = " iunread iflags isubdir iforward ipersonal * * " + -
						    "ieditor iqueue * * * iform"
$   IF ieditor .EQS. "EDT"       THEN  ieditor = ""
$   IF iqueue  .EQS. "SYS$PRINT" THEN  iqueue  = ""
$   record = F$EXTRACT(0,31,record)
$   pos = 31
$   code = 0			! Loop counter--Field Code
$ PUTLOOP:
$   code = code + 1
$   fieldname = F$ELEMENT(code," ",fields)
$   IF fieldname .EQS. " " THEN  RETURN
$   IF fieldname .EQS. "*" THEN  GOTO PUTLOOP
$   value = 'fieldname'			! Note indirection!!
$   IF F$TYPE(value) .EQS. "INTEGER"
$   THEN
$	IF value .EQ. 0 .AND. fieldname .NES. "iunread" THEN   GOTO PUTLOOP
$	record[pos*8,16]    = code
$	record[pos*8+16,16] = 002	! Length 2 assumed
$	record[pos*8+32,16] = value
$	pos = pos + 4 + 002
$   ELSE					! Character String Field
$	IF value .EQS. "" THEN  GOTO PUTLOOP
$	len = F$LENGTH(value)
$	record[pos*8,16]    = code
$	record[pos*8+16,16] = len
$	record[pos+4,len]  := 'value'
$	pos = pos + 4 + len
$   ENDIF
$   GOTO PUTLOOP
$!
$ DONE:
$   CLOSE /NOLOG FL
$   CLOSE /NOLOG OFL
$   IF F$TYPE(prev_priv) .NES. "" THEN  prev_priv = F$SETPRV(prev_priv)
$   IF ver THEN  SET VERIFY
=============================================================================
Bob Marshall                     \\ Gloria:  "I used to have a dream, but..."
Lockheed Missiles & Space Co.     \\Pee Wee: "That's the trouble with everybody
Sunnyvale, CA                      \\         these days; everybody has a
marshall@force.ssd.lmsc.lockheed.com\\        big but. Let's talk about
"I tell the truth 'cept when I lie"  \\       your big but, Gloria."
=============================================================================

