Cecil
19+ years progress programming and still learning.
Hi All
Just for giggles, I thought it would be fun to emulate the ABL ENCODE() function and actually write my own version. This code has been tested and it does seam to work but definitely not to be used in any production or development environment, it's just toooooo slow. "It was only meant to be for fun."
Also I'm still teaching myself OO programming so the structure of the syntax could be better.
OpenEdgeEncode.cls
How to call the OpenEdgeEncoded Object:
Just for giggles, I thought it would be fun to emulate the ABL ENCODE() function and actually write my own version. This code has been tested and it does seam to work but definitely not to be used in any production or development environment, it's just toooooo slow. "It was only meant to be for fun."
Also I'm still teaching myself OO programming so the structure of the syntax could be better.
OpenEdgeEncode.cls
Code:
/**
THIS CODE HAS BE PORTED TO THE ABL PROGRAMMING LANGUAGE FROM THIS 'C' CODE.
https://github.com/pvginkel/ProgressEncode/blob/master/ProgressEncode/Progress.cs
CRC16 Encode Library for ABL simulate the Native ENCODE() function in the ABL.
**/
CLASS OpenEdgeEncode:
DEFINE PUBLIC PROPERTY Encoded AS CHARACTER GET. PRIVATE SET.
CONSTRUCTOR OpenEdgeEncode():
/** Do Nothing.**/
END CONSTRUCTOR.
DESTRUCTOR OpenEdgeEncode():
/** Do Nothing.**/
END DESTRUCTOR.
METHOD PRIVATE INTEGER RightShift(INPUT pinByte AS INTEGER,
INPUT pinShiftBy AS INTEGER):
DEFINE VARIABLE inLoop AS INTEGER NO-UNDO.
DO inLoop = 0 TO pinShiftBy - 1:
pinByte = TRUNCATE(pinByte / 2,0).
END.
RETURN pinByte.
END METHOD.
METHOD PRIVATE LOGICAL getBIT (INPUT pinBit AS INTEGER,
INPUT pinBitbit AS INTEGER):
DEFINE VARIABLE inBitPos AS INTEGER NO-UNDO.
DO inBitPos = 0 TO pinBitbit - 1:
pinBit = TRUNCATE( pinBit / 2, 0 ).
END.
RETURN ( pinBit MODULO 2 ) = 1.
END METHOD. /* getBIT */
METHOD PRIVATE INTEGER setBIT (INPUT pinBit AS INTEGER,
INPUT pinBitbit AS INTEGER):
IF NOT getBIT( pinBit, pinBitbit ) THEN
pinBit = pinBit + EXP( 2, pinBitbit ).
RETURN pinBit.
END METHOD. /* setBIT */
METHOD PRIVATE INTEGER and (INPUT pinBit1 AS INTEGER,
INPUT pinBit2 AS INTEGER):
DEFINE VARIABLE inBitPos AS INTEGER NO-UNDO.
DEFINE VARIABLE inResult AS INTEGER NO-UNDO.
DO inBitPos = 0 TO 15:
IF getBIT( pinBit1, inBitPos ) AND
getBIT( pinBit2, inBitPos )
THEN
inResult = setBIT( inResult, inBitPos ).
END.
RETURN inResult.
END METHOD. /* band */
METHOD PRIVATE INTEGER xor (INPUT int1 AS INTEGER,
INPUT int2 AS INTEGER):
DEFINE VARIABLE inBitPos AS INTEGER NO-UNDO.
DEFINE VARIABLE inResult AS INTEGER NO-UNDO.
DO inBitPos = 0 TO 15:
IF getBIT( int1, inBitPos ) NE getBIT( int2, inBitPos )
THEN
inResult = setBIT( inResult, inBitPos ).
END.
RETURN inResult.
END METHOD.
METHOD PUBLIC CHARACTER ENCODE(INPUT pchString AS CHARACTER):
DEFINE VARIABLE mpString AS MEMPTR NO-UNDO.
DEFINE VARIABLE inStringLength AS INTEGER NO-UNDO.
inStringLength = LENGTH(pchString,'RAW').
IF LOGICAL(inStringLength) THEN
DO:
SET-SIZE(mpString) = 0.
SET-SIZE(mpString) = inStringLength.
PUT-STRING(mpString,1,inStringLength) = pchString.
END.
RETURN THIS-OBJECT:ENCODE(INPUT mpString).
END METHOD.
METHOD PUBLIC CHARACTER ENCODE(INPUT pmpString AS MEMPTR):
DEFINE VARIABLE inHash AS INTEGER NO-UNDO INITIAL 17.
DEFINE VARIABLE mpScratch AS MEMPTR NO-UNDO.
DEFINE VARIABLE mptarget AS MEMPTR NO-UNDO.
DEFINE VARIABLE inLoop AS INTEGER NO-UNDO.
DEFINE VARIABLE inInnerLoop AS INTEGER NO-UNDO.
DEFINE VARIABLE inBytePos AS INTEGER NO-UNDO.
DEFINE VARIABLE inLower AS INTEGER NO-UNDO.
SET-SIZE(mpScratch) = 0.
SET-SIZE(mpScratch) = 16.
DO inLoop = 1 TO 5:
DO inInnerLoop = 0 TO GET-SIZE(pmpString) - 1:
inBytePos = 16 - (inInnerLoop MOD 16) .
PUT-BYTE(mpScratch, inBytePos) = THIS-OBJECT:xor(GET-BYTE(mpScratch, inBytePos),
GET-BYTE(pmpString, inInnerLoop + 1)
).
END.
DO inInnerLoop = 1 TO 16 BY 2:
inHash = THIS-OBJECT:Hash(mpScratch, inHash).
PUT-BYTE(mpScratch,inInnerLoop) = THIS-OBJECT:and(inHash, 0xFF).
PUT-BYTE(mpScratch,inInnerLoop + 1) = THIS-OBJECT:and( THIS-OBJECT:RightShift( inHash, 8 ), 0xFF).
END.
END.
SET-SIZE(pmpString) = 0.
SET-SIZE(mptarget) = 0.
SET-SIZE(mptarget) = 16.
DO inLoop = 1 TO 16:
inLower = THIS-OBJECT:and( GET-BYTE(mpScratch,inLoop), 0x7F ) .
IF (inLower GE ASC('A') AND inLower LE ASC('Z')) OR
(inLower GE ASC('a') AND inLower LE ASC('z')) THEN
PUT-BYTE(mptarget,inLoop) = inLower.
ELSE
PUT-BYTE(mptarget,inLoop) = THIS-OBJECT:RightShift( GET-BYTE(mpScratch,inLoop), 4 ) + 0x61. /** HEX '0x61' DEC '97' ASCII 'a' **/
END.
THIS-OBJECT:Encoded = GET-STRING(mptarget,1,16).
SET-SIZE(mptarget) = 0.
SET-SIZE(mpScratch) = 0.
RETURN THIS-OBJECT:Encoded.
END METHOD.
METHOD PRIVATE INTEGER Hash( INPUT mpScratch AS MEMPTR,
INPUT pinHash AS INTEGER ):
DEFINE VARIABLE hashLookup AS INTEGER EXTENT 256 INITIAL
[0x0000, 0xC0C1, 0xC181, 0x0140, 0xC301, 0x03C0, 0x0280, 0xC241,
0xC601, 0x06C0, 0x0780, 0xC741, 0x0500, 0xC5C1, 0xC481, 0x0440,
0xCC01, 0x0CC0, 0x0D80, 0xCD41, 0x0F00, 0xCFC1, 0xCE81, 0x0E40,
0x0A00, 0xCAC1, 0xCB81, 0x0B40, 0xC901, 0x09C0, 0x0880, 0xC841,
0xD801, 0x18C0, 0x1980, 0xD941, 0x1B00, 0xDBC1, 0xDA81, 0x1A40,
0x1E00, 0xDEC1, 0xDF81, 0x1F40, 0xDD01, 0x1DC0, 0x1C80, 0xDC41,
0x1400, 0xD4C1, 0xD581, 0x1540, 0xD701, 0x17C0, 0x1680, 0xD641,
0xD201, 0x12C0, 0x1380, 0xD341, 0x1100, 0xD1C1, 0xD081, 0x1040,
0xF001, 0x30C0, 0x3180, 0xF141, 0x3300, 0xF3C1, 0xF281, 0x3240,
0x3600, 0xF6C1, 0xF781, 0x3740, 0xF501, 0x35C0, 0x3480, 0xF441,
0x3C00, 0xFCC1, 0xFD81, 0x3D40, 0xFF01, 0x3FC0, 0x3E80, 0xFE41,
0xFA01, 0x3AC0, 0x3B80, 0xFB41, 0x3900, 0xF9C1, 0xF881, 0x3840,
0x2800, 0xE8C1, 0xE981, 0x2940, 0xEB01, 0x2BC0, 0x2A80, 0xEA41,
0xEE01, 0x2EC0, 0x2F80, 0xEF41, 0x2D00, 0xEDC1, 0xEC81, 0x2C40,
0xE401, 0x24C0, 0x2580, 0xE541, 0x2700, 0xE7C1, 0xE681, 0x2640,
0x2200, 0xE2C1, 0xE381, 0x2340, 0xE101, 0x21C0, 0x2080, 0xE041,
0xA001, 0x60C0, 0x6180, 0xA141, 0x6300, 0xA3C1, 0xA281, 0x6240,
0x6600, 0xA6C1, 0xA781, 0x6740, 0xA501, 0x65C0, 0x6480, 0xA441,
0x6C00, 0xACC1, 0xAD81, 0x6D40, 0xAF01, 0x6FC0, 0x6E80, 0xAE41,
0xAA01, 0x6AC0, 0x6B80, 0xAB41, 0x6900, 0xA9C1, 0xA881, 0x6840,
0x7800, 0xB8C1, 0xB981, 0x7940, 0xBB01, 0x7BC0, 0x7A80, 0xBA41,
0xBE01, 0x7EC0, 0x7F80, 0xBF41, 0x7D00, 0xBDC1, 0xBC81, 0x7C40,
0xB401, 0x74C0, 0x7580, 0xB541, 0x7700, 0xB7C1, 0xB681, 0x7640,
0x7200, 0xB2C1, 0xB381, 0x7340, 0xB101, 0x71C0, 0x7080, 0xB041,
0x5000, 0x90C1, 0x9181, 0x5140, 0x9301, 0x53C0, 0x5280, 0x9241,
0x9601, 0x56C0, 0x5780, 0x9741, 0x5500, 0x95C1, 0x9481, 0x5440,
0x9C01, 0x5CC0, 0x5D80, 0x9D41, 0x5F00, 0x9FC1, 0x9E81, 0x5E40,
0x5A00, 0x9AC1, 0x9B81, 0x5B40, 0x9901, 0x59C0, 0x5880, 0x9841,
0x8801, 0x48C0, 0x4980, 0x8941, 0x4B00, 0x8BC1, 0x8A81, 0x4A40,
0x4E00, 0x8EC1, 0x8F81, 0x4F40, 0x8D01, 0x4DC0, 0x4C80, 0x8C41,
0x4400, 0x84C1, 0x8581, 0x4540, 0x8701, 0x47C0, 0x4680, 0x8641,
0x8201, 0x42C0, 0x4380, 0x8341, 0x4100, 0x81C1, 0x8081, 0x4040].
DEFINE VARIABLE inLoop AS INTEGER NO-UNDO.
DEFINE VARIABLE inHashTemp AS INTEGER NO-UNDO.
DO inLoop = 16 TO 1 BY -1:
inHashTemp = THIS-OBJECT:RightShift(pinHash , 8).
inHashTemp = THIS-OBJECT:xor(inHashTemp, hashLookup[ THIS-OBJECT:and( pinHash , 0xFF) + 1 ] ).
inHashTemp = THIS-OBJECT:xor(inHashTemp , hashLookup[ GET-BYTE(mpScratch, inLoop) + 1 ] ).
pinHash = inHashTemp.
END.
RETURN pinHash.
END METHOD.
END CLASS.
How to call the OpenEdgeEncoded Object:
Code:
DEFINE VARIABLE oencode AS CLASS OpenEdgeEncode NO-UNDO.
DEFINE VARIABLE chPassword AS CHARACTER NO-UNDO.
oencode = NEW OpenEdgeEncode().
chPassword = "abcdefghijklmnopqrstuvwxyz".
oencode:encode(chPassword).
/** Compare the results between ABL ENCODE() function and gimmicky slower version. **/
IF oencode:Encoded EQ encode(chPassword) THEN
MESSAGE
"WOOO HOO, SUCCESS!" SKIP
chPassword '=' oencode:Encoded
VIEW-AS ALERT-BOX INFO.
ELSE
MESSAGE
"BUGGER! FAILED!"
VIEW-AS ALERT-BOX ERROR.
DELETE OBJECT oencode.
Last edited: