OpenVMS Source-Code Demos

base64_encode

	function string base64_encode(string inbound)
	!=======================================================================
	! title    : base64_encode.fun
	! author   : Neil Rieck
	! created  :
	! refereces: http://www.faqs.org/rfcs/rfc3548.html
	!            http://www.faqs.org/rfcs/rfc4648.html
	!
	! ver who when     what
	! --- --- -------- -----------------------------------------------------
	! 100 NSR 20190606 1. original work (derived from BASE64_encode2_100.BAS)
	!=======================================================================
	option	type = explicit						,	! cuz tricks are for kids	&
		size = integer  quad					,	! overkill?			&
		size = real	xfloat 						! overkill?
	!
	declare string	buf0$						,	!&
			buf1$						,	!&
			junk$						,	!&
		long	i%						,	!&
			j%						,	!&
			k%						,	!&
			junk%						,	!&
			top, bot
	!=======================================================================
	!	main
	!=======================================================================
	main:
	buf0$ = inbound								! copy passed string
	gosub base64_encode							!
	base64_encode = buf1$							!
	goto fini								! adios
	!
	!====================================================================================================
	!	<<< base64 support >>>
	!
	!	encoding notes:
	!	1. each 24-bit group (3 bytes) is transmitted as four 6-bit characters
	!	2. characters must be sent in multiples of 4 (padding is appended as required)
	!	3. the "=" char means PAD or SPECIAL processing
	!	4. A=0, B=1, C=2, etc.
	!	5. examples:
	!	5.1	A					QQ==
	!			A = ascii:65 = 8-bit:01000001	24-bit:010000 01xxxx xxxxxx xxxxxx
	!							       aaaaaa aa
	!	5.2	AB					QUI=
	!			B = ascii:66 = 8-bit:01000010	24-bit:010000 010100 0010xx xxxxxx
	!							       aaaaaa aabbbb bbbb
	!	5.3	ABC					QUJD
	!			C = ascii:67 = 8-bit:01000011	24-bit:010000 010100 001001 000011
	!							       aaaaaa aabbbb bbbbcc cccccc
	!	5.4	ABCD					QUJDRA==
	!			D = ascii:68 = 8-bit:01000100	24-bit:010000 010100 001001 000011 010001 00xxxx
	!							       aaaaaa aabbbb bbbbcc cccccc dddddd dd
	!	5.5	THIS IS A TEST				VEhJUyBJUyBBIFRFU1Q=
	!	6. bit-mapping schematic:
	!
	!		+--first octet--+-second octet--+--third octet--+
	!		|7 6 5 4 3 2 1 0|7 6 5 4 3 2 1 0|7 6 5 4 3 2 1 0|
	!		+-----------+---+-------+-------+---+-----------+
	!		|5 4 3 2 1 0|5 4 3 2 1 0|5 4 3 2 1 0|5 4 3 2 1 0|
	!		+--1.index--+--2.index--+--3.index--+--4.index--+
	!
	!	7. bit-mapping example:
	!		              M|              a|              n  example unencoded data
	!		             77|             97|            110  ASCII value
	!		7 6 5 4 3 2 1 0|7 6 5 4 3 2 1 0|7 6 5 4 3 2 1 0  bits (3 sets of 8)
	!		---------------+---------------+---------------
	!		0 1 0 0 1 1 0 1 0 1 1 0 0 0 0 1 0 1 1 0 1 1 1 0  example bit stream
	!		-----------+-----------+-----------+-----------
	!		5 4 3 2 1 0|5 4 3 2 1 0|5 4 3 2 1 0|5 4 3 2 1 0  bits (4 sets of 6)
	!		         19|         22|          5|         46  base64 value
	!		          T|          W|          F|          u  example base64 encoded symbols
	!====================================================================================================
	!	entry:	buf0$	contains base64 encoded data
	!	exit:	buf1$	contains the decoded data (if no errors)
	!====================================================================================================
	!         position #2 (weight #1) --+                                  position #65 (weight #64) --+
	!         position #1 (weight #0) -+|                                  position #64 (weight #63) -+|
	declare string constant base64$ = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/="
	!
	declare		long	pad						!
	declare word	z(3)							! 0->3 words (to avoid signed bytes)
	!
	base64_encode:								!
	buf1$ = ""								! init
	goto base64_encode_error_exit	if buf0$ = ""				! exit if nothing to process
	!
	!	one peculiar thing about BASIC is this:
	!		if you ask for a character that is not there, an empty string will be returned
	!		same thing if you ask for three from a set of two
	!
	for i% = 1 to len(buf0$) step 3						! scan characters three at a time
	    mat z = zer								! init the array each pass thru
	    pad = 0								!	ditto
	    for j% = 0 to 2							! now process individual characters
		junk$ = mid$(buf0$, i%+j%, 1)					! select a character from buf0$
		if len(junk$)=0 then						!
		    pad = pad + 1						!
		else								!
		    junk% = asc(junk$)						! convert to ascii
		    select j%							!
			case 0							!
			    top = junk% and b'11111100'				! mask some bits
			    bot = junk% and b'00000011'				!	ditto
			    top = top / 4					! shift 2 places right
			    z(0)= top						! store here
			    bot = bot * 16					! shift 4 places left
			    z(1)= bot						! store here
			case 1							!
			    top = junk% and b'11110000'				! mask some bits
			    bot = junk% and b'00001111'				!	ditto
			    top = top / 16					! shift 4 places right
			    z(1)= top or z(1)					! store here
			    bot = bot * 4					! shift 2 places left
	!~~~		    z(2)= bot or z(2)					x store here (less efficient)
			    z(2)= bot						! store here (more efficient)
			case 2							!
			    top = junk% and b'11000000'				! mask some bits
			    bot = junk% and b'00111111'				!	ditto
			    top = top / 64					! shift 6 places right
			    z(2)= top or z(2)					! store here
	!~~~		    z(3)= bot or z(3)					x store here (less efficient)
			    z(3)= bot						! store here (more efficient)
		    end select							!
		end if								!
	    next j%								!
	    !
	    !	now scan the array then use the values to do a lookup into base64$
	    !	that returned value is tacked onto the end of buf1$
	    !
	    for j% = 0 to (3 - pad)						!
		buf1$ = buf1$ + mid$(base64$, z(j%)+1, 1)			!
	    next j%								!
	    !
	    !	append the necessary amount of base64 padding
	    !
	    while pad > 0							!
		buf1$ = buf1$ + "="						!
		pad = pad - 1							!
	    next 								!
	next i%									! get next 3 chars
	!
	base64_encode_exit:							!
	return									!
	base64_encode_error_exit:						!
	buf1$ = buf0$								! oops; better to return original data
	return									!
	!=======================================================================
	!	adios
	!=======================================================================
	fini:
	end function

left hand Back to OpenVMS
left hand Back to OpenVMS Demo Index
home Back to Home
Neil Rieck
Kitchener - Waterloo - Cambridge, Ontario, Canada.