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
Back to OpenVMS
Back to OpenVMS Demo Index
Back to Home
Neil Rieck
Waterloo, Ontario, Canada.