Focal Point
[SHARING] Base 64 Encoder

This topic can be found at:
https://forums.informationbuilders.com/eve/forums/a/tpc/f/7971057331/m/226107832

September 14, 2009, 01:15 AM
Waz
[SHARING] Base 64 Encoder
Here is something that I created, more as a challenge, rather than being usefile.

This is purely WebFOCUS code only.

It will encode a file available in an app directory as a Base64 encoded file.

Perhaps it will give someone a bit of a laugh...

-*******************************************************************************
-*  Report Title    : Base 64 Encoder
-*  Procedure Name  : BASE64
-*  Report Id       : N/A
-*  Author          : Warren Hinchliffe
-*  Date            : September 2009
-*******************************************************************************
-* Input Parms - See defaults below...
-*******************************************************************************
-* Comments
-*
-*******************************************************************************
-* Change History
-* DD/MM/YYYY - xx - CC  - Description (xx = Initials)
-*******************************************************************************
-SET &TMP_APP  = 'DEVFEX' ;
-SET &TMP_SRCE = 'testfile' ;
-SET &B64_OUT  = 'testfile.b64' ;

APP QUERY &TMP_APP HOLD

-RUN

TABLE   FILE FOCAPPQ
 PRINT  SIZE
 WHERE  FILENAME EQ '&TMP_SRCE'
 ON     TABLE SAVE AS SAV_SIZE
END

-RUN

-IF &LINES EQ 0 THEN GOTO NO_FILE ;

-READ SAV_SIZE &FILESIZE.A12.

-SET &Rem_Octets = IMOD(&FILESIZE,3,'I1') ;
-SET &Padding    = DECODE &Rem_Octets(1 '==' 2 '=' 0 '') ;

FILEDEF TMP_SRCE DISK &TMP_APP/&TMP_SRCE (RECFM F LRECL 1
FILEDEF B64_OUT  DISK &B64_OUT

-RUN

-* Write out a master to read the TMP_SRCE file
EX -LINES 4 EDAPUT MASTER,TMP_SRCE,CV,FILE
FILENAME=TMP_SRCE, SUFFIX=FIX,$
SEGNAME=TMP_SRCE, $
  FIELD=CHAR ,ALIAS=  ,A1 ,A1 ,$

-RUN

DEFINE FUNCTION B64_CHAR/A1 (BIT1/I1,BIT2/I1,BIT3/I1,BIT4/I1,BIT5/I1,BIT6/I1)
 Num/I2     = (BIT6 *  1) + (BIT5 *  2) + (BIT4 *  4) + 
              (BIT3 *  8) + (BIT2 * 16) + (BIT1 * 32) + 1 ;
 BASE64/A64 = 'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/' ;
 B64_CHAR/A1= SUBSTR(64,BASE64,Num,Num,1,'A1') ;
END

DEFINE  FILE TMP_SRCE
 Cntr/I9     = LAST Cntr + 1 ;
 BytBit/I9   = IF LAST BytBit EQ 3 THEN 1 ELSE LAST BytBit + 1 ;
 HEXCHAR/A2  = UFMT(CHAR, 1, HEXCHAR) ;
 Bit1/I1     = BITSON (1, CHAR, Bit1) ;
 Bit2/I1     = BITSON (2, CHAR, Bit2) ;
 Bit3/I1     = BITSON (3, CHAR, Bit3) ;
 Bit4/I1     = BITSON (4, CHAR, Bit4) ;
 Bit5/I1     = BITSON (5, CHAR, Bit5) ;
 Bit6/I1     = BITSON (6, CHAR, Bit6) ;
 Bit7/I1     = BITSON (7, CHAR, Bit7) ;
 Bit8/I1     = BITSON (8, CHAR, Bit8) ;

 LstRec/I1   = IF Cntr EQ &FILESIZE THEN 1 ELSE 0 ;

 BIT1/I1     = IF BytBit EQ 1 THEN      Bit1 ELSE
               IF BytBit EQ 2 THEN LAST Bit7 ELSE
               IF BytBit EQ 3 THEN LAST Bit5 ELSE 0 ;
 BIT2/I1     = IF BytBit EQ 1 THEN      Bit2 ELSE
               IF BytBit EQ 2 THEN LAST Bit8 ELSE
               IF BytBit EQ 3 THEN LAST Bit6 ELSE 0 ;
 BIT3/I1     = IF BytBit EQ 1 THEN      Bit3 ELSE
               IF BytBit EQ 2 THEN      Bit1 ELSE
               IF BytBit EQ 3 THEN LAST Bit7 ELSE 0 ;
 BIT4/I1     = IF BytBit EQ 1 THEN      Bit4 ELSE
               IF BytBit EQ 2 THEN      Bit2 ELSE
               IF BytBit EQ 3 THEN LAST Bit8 ELSE 0 ;
 BIT5/I1     = IF BytBit EQ 1 THEN      Bit5 ELSE
               IF BytBit EQ 2 THEN      Bit3 ELSE
               IF BytBit EQ 3 THEN      Bit1 ELSE 0 ;
 BIT6/I1     = IF BytBit EQ 1 THEN      Bit6 ELSE
               IF BytBit EQ 2 THEN      Bit4 ELSE
               IF BytBit EQ 3 THEN      Bit2 ELSE 0 ;
 XBT1/I1     = IF BytBit EQ 1 AND LstRec EQ 1 THEN      Bit7 ELSE
               IF BytBit EQ 2 AND LstRec EQ 1 THEN      Bit5 ELSE
               IF BytBit EQ 3                 THEN      Bit3 ELSE 0 ;
 XBT2/I1     = IF BytBit EQ 1 AND LstRec EQ 1 THEN      Bit8 ELSE
               IF BytBit EQ 2 AND LstRec EQ 1 THEN      Bit6 ELSE
               IF BytBit EQ 3                 THEN      Bit4 ELSE 0 ;
 XBT3/I1     = IF BytBit EQ 2 AND LstRec EQ 1 THEN      Bit7 ELSE
               IF BytBit EQ 3                 THEN      Bit5 ELSE 0 ;
 XBT4/I1     = IF BytBit EQ 2 AND LstRec EQ 1 THEN      Bit8 ELSE
               IF BytBit EQ 3                 THEN      Bit6 ELSE 0 ;
 XBT5/I1     = IF BytBit EQ 3                 THEN      Bit7 ELSE 0 ;
 XBT6/I1     = IF BytBit EQ 3                 THEN      Bit8 ELSE 0 ;

 Char/A1     = B64_CHAR(BIT1,BIT2,BIT3,BIT4,BIT5,BIT6) ;
 XChar/A1    = IF (BytBit EQ 3) OR (Cntr EQ &FILESIZE) THEN B64_CHAR(XBT1,XBT2,XBT3,XBT4,XBT5,XBT6) ELSE ' ' ;

 NewChars/A4 = IF Cntr EQ &FILESIZE
               THEN Char || XChar || '&Padding'
               ELSE Char || XChar ;

 Line/A76    = IF ARGLEN(76,LAST Line,'I2') EQ 76
               THEN NewChars
               ELSE SUBSTR(80,LAST Line || NewChars,1,76,76,'A76') ;

 Put_Line/A1 = IF (ARGLEN(76,Line,'I2') EQ 76) OR (Cntr EQ &FILESIZE) THEN 'Y' ELSE 'N' ;

END

TABLE   FILE TMP_SRCE
 PRINT 
        COMPUTE
        RET_CODE/I1 = IF Put_Line EQ 'Y'
                      THEN PUTDDREC('B64_OUT',7,Line,ARGLEN(76,Line,'I2'), 'I1')
                      ELSE 0 ;

 WHERE  TOTAL Put_Line EQ 'Y'

 ON     TABLE HOLD AS TMP_B64

END

-RUN

-NO_FILE

This message has been edited. Last edited by: FP Mod Chuck,


Waz...

Prod:WebFOCUS 7.6.10/8.1.04Upgrade:WebFOCUS 8.2.07OS:LinuxOutputs:HTML, PDF, Excel, PPT
In Focus since 1984
Pity the lost knowledge of an old programmer!

March 11, 2019, 11:34 AM
TexasStingray
By any chance do you have a base64 decoder.




Scott

Um, Yes.


Waz...

Prod:WebFOCUS 7.6.10/8.1.04Upgrade:WebFOCUS 8.2.07OS:LinuxOutputs:HTML, PDF, Excel, PPT
In Focus since 1984
Pity the lost knowledge of an old programmer!