Here are some handy functions that are missing as of Progress OpenEdge 10.2b: Base64 encoding and decoding procedures for strings, as well as some procedure about binary operations on numbers. Comments are in French and English at the moment.
First we need to add some binary data helpers because they don’t exist in Progress ABL. I put them in a file named binaire.i:
/*------------------------------------------------------------------------
File : binaire.i
Purpose : Ajouter ce qu'il manque à Progress
Syntax :
Description : Outils de traitements binaires sur les nombres
Sources :
* http://code.google.com/p/autoedgethefactory/source/browse/trunk/referencecomponents/support/src/OpenEdge/Core/Util/BinaryOperationsHelper.cls?r=154
Author(s) : Gabriel Hautclocq, and see sources
Created : Thu Sep 26 11:20:38 CEST 2013
Notes :
----------------------------------------------------------------------*/
/* *************************** Definitions ************************** */FUNCTION BIN_LSHIFT RETURNS INTEGER ( INPUT a AS INTEGER, INPUT b AS INTEGER) FORWARDS.
FUNCTION BIN_RSHIFT RETURNS INTEGER ( INPUT a AS INTEGER, INPUT b AS INTEGER) FORWARDS.
FUNCTION BIN_AND RETURNS INTEGER ( a AS INTEGER, b AS INTEGER) FORWARDS.
FUNCTION BIN_OR RETURNS INTEGER ( a AS INTEGER, b AS INTEGER ) FORWARDS.
FUNCTION BIN_XOR RETURNS INTEGER ( a AS INTEGER, b AS INTEGER ) FORWARDS.
FUNCTION BIN_NOT RETURNS INTEGER ( a AS INTEGER ) FORWARDS.
/* ******************** Preprocessor Definitions ******************** */
/* *************************** Main Block *************************** */
/*
Left bit shifting
*/FUNCTION BIN_LSHIFT RETURNS INTEGER ( INPUT a AS INTEGER, INPUT b AS INTEGER) :
RETURN INT( a * EXP( 2, b ) ).
END FUNCTION.
/*
Right bit shifting
*/FUNCTION BIN_RSHIFT RETURNS INTEGER ( INPUT a AS INTEGER, INPUT b AS INTEGER) :
RETURN INT( TRUNCATE( a / EXP( 2, b ), 0 ) ).
END FUNCTION.
/* BIN_AND - returns the bitwise AND of two INTEGERs as an INT
INPUT a AS INTEGER - first operand to AND operation
INPUT b AS INTEGER - second operand to AND operation
note : (myval & 255) same as (myval mod 256) */FUNCTION BIN_AND RETURNS INTEGER ( a AS INTEGER, b AS INTEGER):
DEFINE VARIABLE res AS INTEGER NO-UNDO INITIAL 0.
DEFINE VARIABLE i AS INTEGER NO-UNDO.
DO i = 1 TO 32:
IF GET-BITS(a, i, 1) + GET-BITS(b, i, 1) >= 2 THEN
DO :
PUT-BITS( res, i, 1 ) = 1.
END.
END.
RETURN res.
END FUNCTION.
/* BIN_OR - returns the bitwise OR of two INTEGERs as an INT
INPUT a AS INTEGER - first operand to OR operation
INPUT b AS INTEGER - second operand to OR operation */FUNCTION BIN_OR RETURNS INTEGER( a AS INTEGER, b AS INTEGER ):
DEFINE VARIABLE res AS INTEGER NO-UNDO INITIAL 0.
DEFINE VARIABLE i AS INTEGER NO-UNDO.
DO i = 1 TO 32:
IF GET-BITS( a, i, 1 ) + GET-BITS( b, i, 1 ) >= 1 THEN
DO :
PUT-BITS( res, i, 1 ) = 1.
END.
END.
RETURN res.
END FUNCTION.
/* BIN_XOR - returns the bitwise Xor of two INTEGERs as an INT
INPUT a AS INTEGER - first operand to Xor operation
INPUT b AS INTEGER - second operand to Xor operation
Derivations:
BinXor - same operation, provided for consistent naming */FUNCTION BIN_XOR RETURNS INTEGER ( a AS INTEGER, b AS INTEGER ) :
DEFINE VARIABLE res AS INTEGER NO-UNDO INITIAL 0.
DEFINE VARIABLE i AS INTEGER NO-UNDO.
DO i = 1 TO 32:
IF GET-BITS( a, i, 1) + GET-BITS( b, i, 1 ) = 1 THEN
DO :
PUT-BITS( res, i, 1 ) = 1.
END.
END.
RETURN res.
END FUNCTION.
/* BIN_NOT - returns the bitwise NOT of an INTEGER as an INT
INPUT a AS INTEGER - the operand to the NOT operation
Note that this is performed on ALL 32 bits of the int.
This is also the same as the following arithmetic:
-1 (ipiOp1 + 1) */FUNCTION BIN_NOT RETURNS INTEGER ( a AS INTEGER ) :
DEFINE VARIABLE res AS INTEGER NO-UNDO INITIAL 0.
DEFINE VARIABLE i AS INTEGER NO-UNDO.
DO i = 1 TO 32:
IF GET-BITS( a, i, 1) = 0 THEN
DO :
PUT-BITS( res, i, 1 ) = 1.
END.
END.
RETURN res.
END FUNCTION.
Then the file that contains the Base64 encoding and decoding algorithms is named base64.i :
/*------------------------------------------------------------------------
File : base64.i
Purpose :
Syntax :
Description :
Sources :
* http://en.wikibooks.org/wiki/Algorithm_Implementation/Miscellaneous/Base64
Author(s) : Gabriel Hautclocq, et voir sources
Created : Wed Sep 25 15:25:01 CEST 2013
Notes :
----------------------------------------------------------------------*/
/* *************************** Definitions ************************** */FUNCTION CHAINE_VERS_BASE64 RETURNS LONGCHAR(
INPUT s AS CHARACTER, /* string to encode */ INPUT w AS LOGICAL ) /* true for wordwrap at col 76 */ FORWARDS.
FUNCTION BASE64_VERS_CHAINE RETURNS LONGCHAR(
INPUT s AS LONGCHAR ) /* string to decode */ FORWARDS.
/* require binary utils to work */{ binaire.i }
/* ******************** Preprocessor Definitions ******************** */
/* *************************** Main Block *************************** */
/* Encode une chaine en base 64 */FUNCTION CHAINE_VERS_BASE64 RETURNS LONGCHAR(
INPUT s AS CHARACTER, /* chaine à encoder */ INPUT w AS LOGICAL ): /* mettre à vrai pour activer le wordwrap à 76 */
/* caractères valides en base64 */ DEFINE VARIABLE ch_base64chars AS CHARACTER NO-UNDO
INITIAL "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/"
CASE-SENSITIVE.
/* résultat */ DEFINE VARIABLE r AS CHARACTER NO-UNDO INITIAL "".
/* chaine de padding */ DEFINE VARIABLE p AS CHARACTER NO-UNDO INITIAL "".
/* pad count */ DEFINE VARIABLE c AS INTEGER NO-UNDO.
/* nombre de 24 bits */ DEFINE VARIABLE n AS INTEGER NO-UNDO.
/* 4 indexs de 6 bits */ DEFINE VARIABLE n0 AS INTEGER NO-UNDO.
DEFINE VARIABLE n1 AS INTEGER NO-UNDO.
DEFINE VARIABLE n2 AS INTEGER NO-UNDO.
DEFINE VARIABLE n3 AS INTEGER NO-UNDO.
/* variables temporaires */ DEFINE VARIABLE t1 AS CHARACTER NO-UNDO.
DEFINE VARIABLE t2 AS CHARACTER NO-UNDO.
DEFINE VARIABLE t3 AS CHARACTER NO-UNDO.
DEFINE VARIABLE b2 AS LOGICAL NO-UNDO INITIAL FALSE.
DEFINE VARIABLE b3 AS LOGICAL NO-UNDO INITIAL FALSE.
DEFINE VARIABLE ls AS INTEGER NO-UNDO.
/* compte le nombre de caractères de padding */ ASSIGN c = LENGTH( s ) MODULO 3.
/* ajoute un zéro à droite pour que la longueur de la chaine soit un multiple de 3 */ IF c > 0 THEN
DO :
DO WHILE c < 3 :
IF c = 1 THEN ASSIGN b2 = TRUE.
IF c = 2 THEN ASSIGN b3 = TRUE.
ASSIGN
p = p + "="
s = s + CHR( 61 ) /* En Progress, CHR(0) n'ajoute en fait aucun caractère... */ c = c + 1
.
END.
END.
/* pour chaque groupe de 3 caractères */ ASSIGN
c = 0
ls = LENGTH( s )
.
DO WHILE c < ls : /* on ajoute une nouvelle ligne tous les 76 caractères si demandé */ IF w THEN DO : IF c > 0 AND ( INT( TRUNCATE( c / 3 * 4, 0 ) ) ) MODULO 76 = 0
THEN DO :
ASSIGN r = r + CHR( 13 ) + CHR( 10 ).
END.
END.
/* transformation des 3 caractères en nombre 24 bits */ ASSIGN
t1 = SUBSTRING( s, c + 1, 1 )
t2 = SUBSTRING( s, c + 2, 1 )
t3 = SUBSTRING( s, c + 3, 1 )
n = BIN_LSHIFT( ASC( t1 ), 16 )
+ BIN_LSHIFT( IF c + 3 >= ls AND t2 = CHR( 61 ) AND b2
THEN 0
ELSE ASC( t2 ), 8 )
+ IF c + 3 >= ls AND t3 = CHR( 61 ) AND b3
THEN 0
ELSE ASC( t3 )
.
/* séparation en 4 indexs de 6 bits */ ASSIGN
n0 = BIN_AND( BIN_RSHIFT( n, 18 ), 63 )
n1 = BIN_AND( BIN_RSHIFT( n, 12 ), 63 )
n2 = BIN_AND( BIN_RSHIFT( n, 6 ), 63 )
n3 = BIN_AND( n , 63 )
.
/* récupération des caractères correspondants à chaque index */ ASSIGN
r = r + SUBSTRING( ch_base64chars, n0 + 1, 1 )
+ SUBSTRING( ch_base64chars, n1 + 1, 1 )
+ SUBSTRING( ch_base64chars, n2 + 1, 1 )
+ SUBSTRING( ch_base64chars, n3 + 1, 1 )
.
/* les 3 caractères suivants */ ASSIGN c = c + 3.
END.
/* remplace les caractères de padding et renvoie le résultat */ ASSIGN r = SUBSTRING( r, 1, LENGTH( r ) - LENGTH( p ) ) + p.
RETURN r.
END FUNCTION.
/* Décode une chaine encodée en base64 */FUNCTION BASE64_VERS_CHAINE RETURNS LONGCHAR ( INPUT s AS LONGCHAR ) :
/* caractères valides en base64 */ DEFINE VARIABLE ch_base64chars AS CHARACTER NO-UNDO
INITIAL "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/"
CASE-SENSITIVE.
/* résultat */ DEFINE VARIABLE r AS CHARACTER NO-UNDO INITIAL "".
/* chaine de padding */ DEFINE VARIABLE p AS CHARACTER NO-UNDO INITIAL "".
/* pad count */ DEFINE VARIABLE c AS INTEGER NO-UNDO.
/* nombre de 24 bits */ DEFINE VARIABLE n AS INTEGER NO-UNDO.
/* remplace tous les caractères qui ne sont pas dans la liste + "=" */ DO n = 1 TO LENGTH( s ) :
IF INDEX( ch_base64chars + "=", SUBSTRING( s, n, 1 ) ) > 0 THEN DO :
ASSIGN r = r + SUBSTRING( s, n, 1 ).
END.
END.
ASSIGN s = r.
/* remplace les éventuels caractères de padding par zero (zero = A) */ ASSIGN
p = IF SUBSTRING( s, LENGTH( s ), 1 ) = "="
THEN
IF SUBSTRING( s, LENGTH( s ) - 1, 1 ) = "="
THEN "AA"
ELSE "A"
ELSE ""
r = ""
s = SUBSTRING( s, 1, LENGTH( s ) - LENGTH( p ) ) + p
.
/* On parcourt la chaine encodée quatre caractères à la fois */ ASSIGN c = 0.
DO WHILE c < LENGTH( s ) :
/*
Chaque groupe de 4 caractère représente un index sur 6 bits dans la liste
des caractères valides en base64, et qui, une fois concaténés, nous donne
un nombre 24 bits qui nous sert à retrouver les 3 caractères d'origine
*/ ASSIGN
n = BIN_LSHIFT( INDEX( ch_base64chars, SUBSTRING( s, c + 1, 1 ) ) - 1, 18 )
+ BIN_LSHIFT( INDEX( ch_base64chars, SUBSTRING( s, c + 2, 1 ) ) - 1, 12 )
+ BIN_LSHIFT( INDEX( ch_base64chars, SUBSTRING( s, c + 3, 1 ) ) - 1, 6 )
+ ( INDEX( ch_base64chars, SUBSTRING( s, c + 4, 1 ) ) - 1 )
.
/* On sépare le nombre de 24 bits en 3 caractères de 8 bits (ASCII) */ ASSIGN
r = r + CHR( BIN_AND( BIN_RSHIFT( n, 16 ), 255 ) )
+ CHR( BIN_AND( BIN_RSHIFT( n, 8 ), 255 ) )
+ CHR( BIN_AND( n, 255 ) )
.
/* les 4 caractères suivants */ ASSIGN c = c + 4.
END.
/* Renvoie le résultat */ RETURN r.
END FUNCTION.