OpenVMS Source Code Demos

BASIC_VMS_MAIL_FORWARD_DEMO.BAS

1000    %title "VMS_MAIL_FORWARD_DEMO"
	%ident "Version 100.1"
	!====================================================================================================
	! title  : VMS_MAIL_FORWARD_DEMO_100.bas
	! author : Neil Rieck (https://neilrieck.net) (mailto:[email protected])
	! created: 2009.06.17
	!====================================================================================================
	option type=explicit							! no kid stuff
        set no prompt								!
	!
	!	fetch a few declarations from the OpenVMS system library
	!
	%include "lib$routines"  %from %library "sys$library:basic$starlet"	! lib$
	%include "mail$routines" %from %library "sys$library:basic$starlet"	! mail$
	%include "$maildef"      %from %library "sys$library:basic$starlet"	! mail$_user_
	!
	!	declare a data structure to be used with MAIL$ calls
	!
	record ItemRec								! structure of item record
	    variant								!
		case								!
		    group one							!
			word	BuffLen
			word	ItemCode
			long	BuffAddr
			long	RtnLenAdr
		    end group one
		case
		    group two							!
			long	List_Terminator
			long	Junk1
			long	Junk2
		    end group two
	    end variant								!
	end record ItemRec							!
	!
	!	use the new data structure to declare some variables
	!
	declare itemRec list_i(7)						! input list supports items 0-7
	declare itemRec list_o(7)						! output list supports items 0-7
	!
	map(xyz)string	username	=  20				,	&
		long	username_L					,	&
		string	forward		= 255				,	&
		long	forward_L
	!
	declare long	context%					,	&
			rc%						,	&
		string	junk$
	!----------------------------------------------------------------------------------------------------
	!	init mail$user contract
	!----------------------------------------------------------------------------------------------------
	init:
	rc% = MAIL$USER_BEGIN(context%,0,0)					!
	print "MAIL$USER_BEGIN error: ";rc%	if ((rc% and 7%) <> 1%)		!
	!----------------------------------------------------------------------------------------------------
	!	lookup these users
	!----------------------------------------------------------------------------------------------------
	main:
	junk$				= "STEVE"				! this user has forwarding in place
	username			= junk$					!
	username_L			= len(junk$)				!
	gosub	lookup								!
	!
	junk$				= "NEIL"				! this user does not have forwarding
	username			= junk$					!
	username_L			= len(junk$)				!
	gosub	lookup								!
	!
	goto nomore								!
	!----------------------------------------------------------------------------------------------------
	!	lookup a user
	!----------------------------------------------------------------------------------------------------
	lookup:
	list_i(0)::BuffLen		= username_L				! size of string
	list_i(0)::ItemCode		= MAIL$_USER_USERNAME			!
	list_i(0)::BuffAddr		= loc(username)				! location of string
	list_i(0)::RtnLenAdr		= 0					! n/a
	list_i(1)::List_Terminator	= 0					! no more items in this list
	!
	list_o(0)::BuffLen		= len(forward)				! maximum size of return buffer buffer
	list_o(0)::ItemCode		= MAIL$_USER_FORWARDING			! 
	list_o(0)::BuffAddr		= loc(forward)				! location of return buffer buffer
	list_o(0)::RtnLenAdr		= loc(forward_L)			! location of buffer which will hold byte count
	list_o(1)::List_Terminator	= 0					! no more items in this list
	!
	rc% = MAIL$USER_GET_INFO(context%, list_i(0), list_o(0))		!
	print "MAIL$USER_GET_INFO error: ";rc%	if ((rc% and 7%) <> 1%)		!
	if ((rc% and 7%) = 1%) then						!
	    print "-i-user: "+ left$(username, username_L)			!
	    print "-i-forwarded to: "+ left$(forward, forward_L)		!	
	end if									!
	return									!
	!----------------------------------------------------------------------------------------------------
	!	release mail$user resources
	!----------------------------------------------------------------------------------------------------
	nomore:
	rc% = MAIL$USER_END(context%,0,0)					!
	print "MAIL$USER_END error: ";rc%  if ((rc% and 7%) <> 1%)		!
	!----------------------------------------------------------------------------------------------------
	!	that's all folks
	!----------------------------------------------------------------------------------------------------
	print "Adios..."							!
	end									!

---

Back to Home
Neil Rieck
Waterloo, Ontario, Canada.