#!/bin/sh
#
# This is a shell archive.  To extract its contents,
# execute this file with /bin/sh to create the file(s):
#
# bin.4gl		    binary.README
#
# This shell archive created: Tue Sep 17 10:51:59 EDT 2002
#
echo "Extracting file binary.README"
sed -e 's/^X//' <<\SHAR_EOF > binary.README
XHello,
X
XI would like to contribute to the software repository.
X
XThe file bin.4gl is a 4GL module that contains all the functionality needed
Xto have binary arithmetic in 4GL. The problem was, that on our machine was
Xno C-compiler installed, but we could have made good use of binary math,
Xfor password encryption for instance.
X
XAs a result I wrote this module that has all in it: AND,OR,XOR,NOT as binary
Xoperators, together with bit rotation and shifting and negation.
X
XDue to the nature of how I had to do it, it is not really fast, so no one
Xshould apply this on mass media, but for every day usage, like password
Xencryption it is more than sufficient.
X
XI hope you can make use of the code.
X
X
XKind regards,
X
XDietmar Bos
X
SHAR_EOF
if [ `wc -c < binary.README` -ne      723 ]
then
    echo "Lengths do not match -- Bad Copy of binary.README"
fi
echo "Extracting file bin.4gl"
sed -e 's/^X//' <<\SHAR_EOF > bin.4gl
X#-----------------------------------------------------------------------------
X#
X# Complete binary arithmetic in 4GL  ( Dietmar.Bos@Gmx.Net September '02)
X#
X# due to the nature of the implementation it can't be very fast, but
X# is more than sufficient for everyday purposes.
X#
X# the set contains all common binary arithmetic like AND,OR,XOR
X# together with the rotating, shifting, bitset and bitclear functions.
X#
X# as an example, what to do with it, I've put the function XORString()
X# in it, which allows pretty good password encryption/decryption.
X#
X# The following table gives a brief overview of the usable functions in
X# this module.
X#
X#-----------------------------------------------------------------------------
X#Function Word2Binary(iSource)          -> converts integer or smallint
X#                                       -> of range WORD
X#                                       -> into a binary string
X#                                       -> e.g.: Word2Binary(17) ->
X#                                       -> "0000000000010001"
X#Function Byte2Binary(iSource)          -> converts smallint of range BYTE into binary string
X#Function Long2Binary(iSource)          -> converts float of range LONG into binary string
X#Function Binary2Byte(cSource)          -> converts a binarystring into a Smallint of Range BYTE
X#Function Binary2Word(cSource)          -> converts a binarystring into a Smallint of Range WORD
X#Function Binary2Long(cSource)          -> converts a binarystring into a float of Range LONG
X#Function BitClearLong(iSource, iBitPos)-> clears a bit in a Long
X#Function BitClearWord(iSource, iBitPos)-> clears a bit in a word
X#                                       -> e.g.: BitClearWord(17,1) -> 16
X#Function BitClearByte(iSource, iBitPos)-> clears a bit in a byte
X#Function BitSetLong(iSource, iBitPos)  -> sets a bit in a Long
X#Function BitSetWord(iSource, iBitPos)  -> sets a bit in a word
X#Function BitSetByte(iSource, iBitPos)  -> sets a bit in a byte value
X#Function BitOrLong(iSource1, iSource2) -> binary ORs 2 longs
X#Function BitOrWord(iSource1, iSource2) -> binary ORs 2 words
X#Function BitOrByte(iSource1, iSource2) -> binary ORs 2 bytes
X#Function BitAndLong(iSource1, iSource2)-> binary ANDs 2 longs
X#Function BitAndWord(iSource1, iSource2)-> binary ANDs 2 words
X#Function BitAndByte(iSource1, iSource2)-> binary ANDs 2 bytes
X#Function BitXorLong(iSource1, iSource2)-> binary XORs 2 longs
X#Function BitXorWord(iSource1, iSource2)-> binary XORs 2 words
X#Function BitXorByte(iSource1, iSource2)-> binary XORs 2 bytes
X#
X#Function XORString(cText, cCrypt)      -> Encode/Decode cText with key cCrypt
X#
X#Function BitNotLong(dVal)              -> toggles every bit in long
X#Function BitNotWord(lVal)              -> toggles every bit in word
X#Function BitNotByte(iVal)              -> toggles every bit in byte
X#Function Hex2Dec(cHex  )               -> Hexstring to long value
X#Function Dec2Hex(lDec )                -> long value to Hex string
X#function RotateLeftLong(iLong,iBits)   -> bitwise rotate left of a Long
X#function RotateRightLong(iLong,iBits)  -> bitwise rotate right of a Long
X#function ShiftLeftLong(iLong,iBits)    -> bitwise shift left of a Long
X#function ShiftRightLong(iLong,iBits)   -> bitwise shift right of a Long
X#function RotateLeft(iWord,iBits)       -> bitwise rotate left of a word
X#function RotateRight(iWord,iBits)      -> bitwise rotate right of a word
X#function ShiftLeft(iWord,iBits)        -> bitwise shift left of a word
X#function ShiftRight(iWord,iBits)       -> bitwise shift right of a word
X#-----------------------------------------------------------------------------
X
X
Xglobals
X    #asciitable globals
X    define bAsciiTableInit smallint
X    define cAsciiTable char(256)
Xend globals
X
X
X
X
XMAIN         #TEST ROUTINE
X#
Xdefine cTmp char(32)
Xdefine fTmp float
Xdefine lTmp integer
X
X    # some examples to get the idea
X
X    let cTmp= long2binary(4294967295.0)
X    error cTmp clipped
X    sleep 1
X    let fTmp=binary2long(cTmp)
X    error fTmp clipped
X    sleep 1
X    let cTmp= long2binary(2863311530.0)
X    error cTmp clipped
X    sleep 1
X    let fTmp=binary2long(cTmp)
X    error fTmp clipped
X    sleep 1
X    let lTmp=BitOrWord(123,456)
X    error lTmp clipped
X    sleep 1
X    let lTmp=BitAndWord(123,456)
X    error lTmp clipped
X    sleep 1
X    let lTmp=BitXOrWord(123,456)
X    error lTmp clipped
X    sleep 1
X    let lTmp=BitNotWord(123)
X    error lTmp clipped
X    sleep 1
X
X
X    #crypt and decrypt a string by using XOR
X    let cTmp=XORString("This is going to be crypted","")
X    error cTmp clipped
X    sleep 1
X    let cTmp=XORString(cTmp,"")
X    error cTmp clipped
X    sleep 1
X
X    #convert number to hex and vice versa
X    let cTmp=Dec2Hex(123456)
X    error cTmp clipped
X    sleep 1
X    let lTmp=Hex2Dec(cTmp)
X    error lTmp clipped
X    sleep 1
X
Xend main
X
X
X
X
X
X
X#-----------------------------------------------------------------------------
Xfunction RotateLeftLong(iLong,iBits)
Xdefine iLong float
Xdefine iBits smallint
Xdefine cSrc,cTmp char(32)
X
X    let cTmp=Long2Binary(iLong)
X    let cSrc=cTmp[iBits+1,32] clipped,cTmp[1,iBits+1]
X    let iLong=Binary2Long(cSrc)
X
X    return iLong
X
Xend function
X
X#-----------------------------------------------------------------------------
Xfunction RotateRightLong(iLong,iBits)
Xdefine iLong float
Xdefine iBits smallint
Xdefine cSrc,cTmp char(32)
X
X    let cTmp=Long2Binary(iLong)
X    let cSrc=cTmp[32-iBits+1,32] clipped,cTmp[1,32-ibits+1]
X    let iLong=Binary2Long(cSrc)
X
X    return iLong
X
Xend function
X
X#-----------------------------------------------------------------------------
Xfunction ShiftLeftLong(iLong,iBits)
Xdefine iLong float
Xdefine iBits smallint
Xdefine cSrc,cTmp,cDummy char(32)
X
X    let cDummy="00000000000000000000000000000000"
X    let cTmp=Long2Binary(iLong)
X    let cSrc=cTmp[iBits+1,32] clipped,cDummy[1,iBits+1]
X    let iLong=Binary2Long(cSrc)
X
X    return iLong
X
Xend function
X
X#-----------------------------------------------------------------------------
Xfunction ShiftRightLong(iLong,iBits)
Xdefine iLong float
Xdefine iBits smallint
Xdefine cSrc,cTmp,cDummy char(32)
X
X    let cDummy="00000000000000000000000000000000"
X    let cTmp=Long2Binary(iLong)
X    let cSrc=cDummy[32-iBits+1,32] clipped,cTmp[1,32-ibits+1]
X    let iLong=Binary2Long(cSrc)
X
X    return iLong
X
Xend function
X
X#-----------------------------------------------------------------------------
Xfunction RotateLeft(iWord,iBits)
Xdefine iWord integer
Xdefine iBits smallint
Xdefine cSrc,cTmp char(16)
X
X    let cTmp=Word2Binary(iWord)
X    let cSrc=cTmp[iBits+1,16] clipped,cTmp[1,iBits+1]
X    let iWord=Binary2Word(cSrc)
X
X    return iWord
X
Xend function
X
X#-----------------------------------------------------------------------------
Xfunction RotateRight(iWord,iBits)
Xdefine iWord integer
Xdefine iBits smallint
Xdefine cSrc,cTmp char(16)
X
X    let cTmp=Word2Binary(iWord)
X    let cSrc=cTmp[16-iBits+1,16] clipped,cTmp[1,16-ibits+1]
X    let iWord=Binary2Word(cSrc)
X
X    return iWord
X
Xend function
X
X#-----------------------------------------------------------------------------
Xfunction ShiftLeft(iWord,iBits)
Xdefine iWord integer
Xdefine iBits smallint
Xdefine cSrc,cTmp,cDummy char(16)
X
X    let cDummy="0000000000000000"
X    let cTmp=Word2Binary(iWord)
X    let cSrc=cTmp[iBits+1,16] clipped,cDummy[1,iBits+1]
X    let iWord=Binary2Word(cSrc)
X
X    return iWord
X
Xend function
X
X#-----------------------------------------------------------------------------
Xfunction ShiftRight(iWord,iBits)
Xdefine iWord integer
Xdefine iBits smallint
Xdefine cSrc,cTmp,cDummy char(16)
X
X    let cDummy="0000000000000000"
X    let cTmp=Word2Binary(iWord)
X    let cSrc=cDummy[16-iBits+1,16] clipped,cTmp[1,16-ibits+1]
X    let iWord=Binary2Word(cSrc)
X
X    return iWord
X
Xend function
X
X
X#-----------------------------------------------------------------------------
XFunction Long2Binary(iSource)
Xdefine iSource float
Xdefine cBinary char(32)
X
X    let cBinary="00000000000000000000000000000000"
X
X    if iSource-2147483648.0>=0 then
X        let iSource=iSource-2147483648.0
X        let cBinary[1,1]="1"
X    end if
X    if iSource-1073741824.0>=0 then
X        let iSource=iSource-1073741824.0
X        let cBinary[2,2]="1"
X    end if
X    if iSource-536870912.0>=0 then
X        let iSource=iSource-536870912.0
X        let cBinary[3,3]="1"
X    end if
X    if iSource-268435456.0>=0 then
X        let iSource=iSource-268435456.0
X        let cBinary[4,4]="1"
X    end if
X    if iSource-134217728.0>=0 then
X        let iSource=iSource-134217728.0
X        let cBinary[5,5]="1"
X    end if
X    if iSource-67108864.0>=0 then
X        let iSource=iSource-67108864.0
X        let cBinary[6,6]="1"
X    end if
X    if iSource-33554432.0>=0 then
X        let iSource=iSource-33554432.0
X        let cBinary[7,7]="1"
X    end if
X    if iSource-16777216.0>=0 then
X        let iSource=iSource-16777216.0
X        let cBinary[8,8]="1"
X    end if
X    if iSource-8388608.0>=0 then
X        let iSource=iSource-8388608.0
X        let cBinary[9,9]="1"
X    end if
X    if iSource-4194304.0>=0 then
X        let iSource=iSource-4194304.0
X        let cBinary[10,10]="1"
X    end if
X    if iSource-2097152.0>=0 then
X        let iSource=iSource-2097152.0
X        let cBinary[11,11]="1"
X    end if
X    if iSource-1048576.0>=0 then
X        let iSource=iSource-1048576.0
X        let cBinary[12,12]="1"
X    end if
X    if iSource-524288.0>=0 then
X        let iSource=iSource-524288.0
X        let cBinary[13,13]="1"
X    end if
X    if iSource-262144.0>=0 then
X        let iSource=iSource-262144.0
X        let cBinary[14,14]="1"
X    end if
X    if iSource-131072.0>=0 then
X        let iSource=iSource-131072.0
X        let cBinary[15,15]="1"
X    end if
X    if iSource-65536.0>=0 then
X        let iSource=iSource-65536.0
X        let cBinary[16,16]="1"
X    end if
X    if iSource-32768.0>=0 then
X        let iSource=iSource-32768.0
X        let cBinary[17,17]="1"
X    end if
X    if iSource-16384>=0 then
X        let iSource=iSource-16384
X        let cBinary[18,18]="1"
X    end if
X    if iSource-8192>=0 then
X        let iSource=iSource-8192
X        let cBinary[19,19]="1"
X    end if
X    if iSource-4096>=0 then
X        let iSource=iSource-4096
X        let cBinary[20,20]="1"
X    end if
X    if iSource-2048>=0 then
X        let iSource=iSource-2048
X        let cBinary[21,21]="1"
X    end if
X    if iSource-1024>=0 then
X        let iSource=iSource-1024
X        let cBinary[22,22]="1"
X    end if
X    if iSource-512>=0 then
X        let iSource=iSource-512
X        let cBinary[23,23]="1"
X    end if
X    if iSource-256>=0 then
X        let iSource=iSource-256
X        let cBinary[24,24]="1"
X    end if
X    if iSource-128>=0 then
X        let iSource=iSource-128
X        let cBinary[25,25]="1"
X    end if
X    if iSource-64>=0 then
X        let iSource=iSource-64
X        let cBinary[26,26]="1"
X    end if
X    if iSource-32>=0 then
X        let iSource=iSource-32
X        let cBinary[27,27]="1"
X    end if
X    if iSource-16>=0 then
X        let iSource=iSource-16
X        let cBinary[28,28]="1"
X    end if
X    if iSource-8>=0 then
X        let iSource=iSource-8
X        let cBinary[29,29]="1"
X    end if
X    if iSource-4>=0 then
X        let iSource=iSource-4
X        let cBinary[30,30]="1"
X    end if
X    if iSource-2>=0 then
X        let iSource=iSource-2
X        let cBinary[31,31]="1"
X    end if
X    if iSource-1>=0 then
X        let cBinary[32,32]="1"
X    end if
X
X    return cBinary
X
XEnd Function
X
X
X#-----------------------------------------------------------------------------
XFunction Word2Binary(iSource)
Xdefine iSource integer
Xdefine cBinary char(16)
X
X    let cBinary="0000000000000000"
X
X    if iSource-32768>=0 then
X        let iSource=iSource-32768
X        let cBinary[1,1]="1"
X    end if
X    if iSource-16384>=0 then
X        let iSource=iSource-16384
X        let cBinary[2,2]="1"
X    end if
X    if iSource-8192>=0 then
X        let iSource=iSource-8192
X        let cBinary[3,3]="1"
X    end if
X    if iSource-4096>=0 then
X        let iSource=iSource-4096
X        let cBinary[4,4]="1"
X    end if
X    if iSource-2048>=0 then
X        let iSource=iSource-2048
X        let cBinary[5,5]="1"
X    end if
X    if iSource-1024>=0 then
X        let iSource=iSource-1024
X        let cBinary[6,6]="1"
X    end if
X    if iSource-512>=0 then
X        let iSource=iSource-512
X        let cBinary[7,7]="1"
X    end if
X    if iSource-256>=0 then
X        let iSource=iSource-256
X        let cBinary[8,8]="1"
X    end if
X    if iSource-128>=0 then
X        let iSource=iSource-128
X        let cBinary[9,9]="1"
X    end if
X    if iSource-64>=0 then
X        let iSource=iSource-64
X        let cBinary[10,10]="1"
X    end if
X    if iSource-32>=0 then
X        let iSource=iSource-32
X        let cBinary[11,11]="1"
X    end if
X    if iSource-16>=0 then
X        let iSource=iSource-16
X        let cBinary[12,12]="1"
X    end if
X    if iSource-8>=0 then
X        let iSource=iSource-8
X        let cBinary[13,13]="1"
X    end if
X    if iSource-4>=0 then
X        let iSource=iSource-4
X        let cBinary[14,14]="1"
X    end if
X    if iSource-2>=0 then
X        let iSource=iSource-2
X        let cBinary[15,15]="1"
X    end if
X    if iSource-1>=0 then
X        let cBinary[16,16]="1"
X    end if
X
X    return cBinary
X
XEnd Function
X
X#-----------------------------------------------------------------------------
XFunction Byte2Binary(iSource)
Xdefine iSource integer
Xdefine cBinary char(8)
X
X    let cBinary="00000000"
X    if iSource>255 then return "" end if
X
X    if iSource-128>=0 then
X        let iSource=iSource-128
X        let cBinary[1,1]="1"
X    end if
X    if iSource-64>=0 then
X        let iSource=iSource-64
X        let cBinary[2,2]="1"
X    end if
X    if iSource-32>=0 then
X        let iSource=iSource-32
X        let cBinary[3,3]="1"
X    end if
X    if iSource-16>=0 then
X        let iSource=iSource-16
X        let cBinary[4,4]="1"
X    end if
X    if iSource-8>=0 then
X        let iSource=iSource-8
X        let cBinary[5,5]="1"
X    end if
X    if iSource-4>=0 then
X        let iSource=iSource-4
X        let cBinary[6,6]="1"
X    end if
X    if iSource-2>=0 then
X        let iSource=iSource-2
X        let cBinary[7,7]="1"
X    end if
X    if iSource-1>=0 then
X        let cBinary[8,8]="1"
X    end if
X
X    return cBinary
X
XEnd Function
X
X#-----------------------------------------------------------------------------
XFunction Binary2Byte(cSource)
Xdefine cSource char(8)
Xdefine iBinary integer
X
X    let cSource=cSource[1,8]
X    let iBinary=0
X
X    if cSource[1,1]="1" then let iBinary=iBinary+128 end if
X    if cSource[2,2]="1" then let iBinary=iBinary+64 end if
X    if cSource[3,3]="1" then let iBinary=iBinary+32 end if
X    if cSource[4,4]="1" then let iBinary=iBinary+16 end if
X    if cSource[5,5]="1" then let iBinary=iBinary+8 end if
X    if cSource[6,6]="1" then let iBinary=iBinary+4 end if
X    if cSource[7,7]="1" then let iBinary=iBinary+2 end if
X    if cSource[8,8]="1" then let iBinary=iBinary+1 end if
X
X    return iBinary
X
XEnd Function
X
X#-----------------------------------------------------------------------------
XFunction Binary2Word(cSource)
Xdefine cSource char(16)
Xdefine iBinary integer
X
X    let cSource=cSource[1,16]
X    let iBinary=0
X
X    #if cSource[1,1]="1" then let iBinary=iBinary+65536 end if
X    if cSource[1,1]="1" then let iBinary=iBinary+32768 end if
X    if cSource[2,2]="1" then let iBinary=iBinary+16384 end if
X    if cSource[3,3]="1" then let iBinary=iBinary+8192 end if
X    if cSource[4,4]="1" then let iBinary=iBinary+4096 end if
X    if cSource[5,5]="1" then let iBinary=iBinary+2048 end if
X    if cSource[6,6]="1" then let iBinary=iBinary+1024 end if
X    if cSource[7,7]="1" then let iBinary=iBinary+512 end if
X    if cSource[8,8]="1" then let iBinary=iBinary+256 end if
X    if cSource[9,9]="1" then let iBinary=iBinary+128 end if
X    if cSource[10,10]="1" then let iBinary=iBinary+64 end if
X    if cSource[11,11]="1" then let iBinary=iBinary+32 end if
X    if cSource[12,12]="1" then let iBinary=iBinary+16 end if
X    if cSource[13,13]="1" then let iBinary=iBinary+8 end if
X    if cSource[14,14]="1" then let iBinary=iBinary+4 end if
X    if cSource[15,15]="1" then let iBinary=iBinary+2 end if
X    if cSource[16,16]="1" then let iBinary=iBinary+1 end if
X
X    return iBinary
X
XEnd Function
X
X#-----------------------------------------------------------------------------
XFunction Binary2Long(cSource)
Xdefine cSource char(32)
Xdefine iBinary float
X
X    let cSource=cSource[1,32]
X    let iBinary=0
X
X    if cSource[1,1]="1" then let iBinary=iBinary+2147483648.0 end if
X    if cSource[2,2]="1" then let iBinary=iBinary+1073741824.0 end if
X    if cSource[3,3]="1" then let iBinary=iBinary+536870912.0 end if
X    if cSource[4,4]="1" then let iBinary=iBinary+268435456.0 end if
X    if cSource[5,5]="1" then let iBinary=iBinary+134217728.0 end if
X    if cSource[6,6]="1" then let iBinary=iBinary+67108864.0 end if
X    if cSource[7,7]="1" then let iBinary=iBinary+33554432.0 end if
X    if cSource[8,8]="1" then let iBinary=iBinary+16777216.0 end if
X    if cSource[9,9]="1" then let iBinary=iBinary+8388608.0 end if
X    if cSource[10,10]="1" then let iBinary=iBinary+4194304.0 end if
X    if cSource[11,11]="1" then let iBinary=iBinary+2097152.0 end if
X    if cSource[12,12]="1" then let iBinary=iBinary+1048576.0 end if
X    if cSource[13,13]="1" then let iBinary=iBinary+524288.0 end if
X    if cSource[14,14]="1" then let iBinary=iBinary+262144.0 end if
X    if cSource[15,15]="1" then let iBinary=iBinary+131072.0 end if
X    if cSource[16,16]="1" then let iBinary=iBinary+65536.0 end if
X    if cSource[17,17]="1" then let iBinary=iBinary+32768.0 end if
X    if cSource[18,18]="1" then let iBinary=iBinary+16384 end if
X    if cSource[19,19]="1" then let iBinary=iBinary+8192 end if
X    if cSource[20,20]="1" then let iBinary=iBinary+4096 end if
X    if cSource[21,21]="1" then let iBinary=iBinary+2048 end if
X    if cSource[22,22]="1" then let iBinary=iBinary+1024 end if
X    if cSource[23,23]="1" then let iBinary=iBinary+512 end if
X    if cSource[24,24]="1" then let iBinary=iBinary+256 end if
X    if cSource[25,25]="1" then let iBinary=iBinary+128 end if
X    if cSource[26,26]="1" then let iBinary=iBinary+64 end if
X    if cSource[27,27]="1" then let iBinary=iBinary+32 end if
X    if cSource[28,28]="1" then let iBinary=iBinary+16 end if
X    if cSource[29,29]="1" then let iBinary=iBinary+8 end if
X    if cSource[30,30]="1" then let iBinary=iBinary+4 end if
X    if cSource[31,31]="1" then let iBinary=iBinary+2 end if
X    if cSource[32,32]="1" then let iBinary=iBinary+1 end if
X    return iBinary
X
XEnd Function
X
X#-----------------------------------------------------------------------------
XFunction BitClearLong(iSource, iBitPos)
Xdefine iSource float
Xdefine iBitPos smallint
Xdefine cBits char(32)
X
X    let cBits=Long2Binary(iSource)
X    let cBits[33-iBitPos]="0"
X    let iSource=Binary2Long(cBits)
X    return iSource
X
Xend function
X
X#-----------------------------------------------------------------------------
XFunction BitClearWord(iSource, iBitPos)
Xdefine iSource integer
Xdefine iBitPos smallint
Xdefine cBits char(16)
X
X    let cBits=Word2Binary(iSource)
X    let cBits[17-iBitPos]="0"
X    let iSource=Binary2Word(cBits)
X    return iSource
X
Xend function
X
X#-----------------------------------------------------------------------------
XFunction BitClearByte(iSource, iBitPos)
Xdefine iSource integer
Xdefine iBitPos smallint
Xdefine cBits char(8)
X
X    let cBits=Byte2Binary(iSource)
X    let cBits[9-iBitPos]="0"
X    let iSource=Binary2Byte(cBits)
X    return iSource
X
Xend function
X
X#-----------------------------------------------------------------------------
XFunction BitSetLong(iSource, iBitPos)
Xdefine iSource float
Xdefine iBitPos smallint
Xdefine cBits char(16)
X
X    let cBits=Long2Binary(iSource)
X    let cBits[33-iBitPos]="1"
X    let iSource=Binary2Long(cBits)
X    return iSource
X
Xend function
X
X#-----------------------------------------------------------------------------
XFunction BitSetWord(iSource, iBitPos)
Xdefine iSource integer
Xdefine iBitPos smallint
Xdefine cBits char(16)
X
X    let cBits=Word2Binary(iSource)
X    let cBits[17-iBitPos]="1"
X    let iSource=Binary2Word(cBits)
X    return iSource
X
Xend function
X
X#-----------------------------------------------------------------------------
XFunction BitSetByte(iSource, iBitPos)
Xdefine iSource integer
Xdefine iBitPos smallint
Xdefine cBits char(8)
X
X    let cBits=Byte2Binary(iSource)
X    let cBits[9-iBitPos]="1"
X    let iSource=Binary2Byte(cBits)
X    return iSource
X
Xend function
X
X
X#-----------------------------------------------------------------------------
XFunction BitOrLong(iSource1, iSource2)
Xdefine iSource1,iSource2,iResult float
Xdefine cBits1,cBits2,cBitsRes char(32)
Xdefine i smallint
X
X    let cBitsRes="00000000000000000000000000000000"
X    let cBits1=Long2Binary(iSource1)
X    let cBits2=Long2Binary(iSource2)
X
X    for i=1 to 32
X
X        if cBits1[i,i]="1" or cBits2[i,i]="1" then
X
X            let cBitsRes[i,i]="1"
X
X        end if
X
X    end for
X
X    let iResult=Binary2Long(cBitsRes)
X    return iResult
X
Xend function
X
X#-----------------------------------------------------------------------------
XFunction BitOrWord(iSource1, iSource2)
Xdefine iSource1,iSource2,iResult integer
Xdefine cBits1,cBits2,cBitsRes char(16)
Xdefine i smallint
X
X    let cBitsRes="0000000000000000"
X    let cBits1=Word2Binary(iSource1)
X    let cBits2=Word2Binary(iSource2)
X
X    for i=1 to 16
X
X        if cBits1[i,i]="1" or cBits2[i,i]="1" then
X
X            let cBitsRes[i,i]="1"
X
X        end if
X
X    end for
X
X    let iResult=Binary2Word(cBitsRes)
X    return iResult
X
Xend function
X
X#-----------------------------------------------------------------------------
XFunction BitOrByte(iSource1, iSource2)
Xdefine iSource1,iSource2,iResult integer
Xdefine cBits1,cBits2,cBitsRes char(8)
Xdefine i smallint
X
X    let cBitsRes="00000000"
X    let cBits1=Byte2Binary(iSource1)
X    let cBits2=Byte2Binary(iSource2)
X
X    for i=1 to 8
X
X        if cBits1[i,i]="1" or cBits2[i,i]="1" then
X
X            let cBitsRes[i,i]="1"
X
X        end if
X
X    end for
X
X    let iResult=Binary2Byte(cBitsRes)
X    return iResult
X
Xend function
X
X#-----------------------------------------------------------------------------
XFunction BitAndLong(iSource1, iSource2)
Xdefine iSource1,iSource2,iResult float
Xdefine cBits1,cBits2,cBitsRes char(32)
Xdefine i smallint
X
X    let cBitsRes="00000000000000000000000000000000"
X    let cBits1=Long2Binary(iSource1)
X    let cBits2=Long2Binary(iSource2)
X
X    for i=1 to 32
X
X        if cBits1[i,i]="1" AND cBits2[i,i]="1" then
X
X            let cBitsRes[i,i]="1"
X
X        end if
X
X    end for
X
X    let iResult=Binary2Long(cBitsRes)
X    return iResult
X
Xend function
X
X#-----------------------------------------------------------------------------
XFunction BitAndWord(iSource1, iSource2)
Xdefine iSource1,iSource2,iResult integer
Xdefine cBits1,cBits2,cBitsRes char(16)
Xdefine i smallint
X
X    let cBitsRes="0000000000000000"
X    let cBits1=Word2Binary(iSource1)
X    let cBits2=Word2Binary(iSource2)
X
X    for i=1 to 16
X
X        if cBits1[i,i]="1" AND cBits2[i,i]="1" then
X
X            let cBitsRes[i,i]="1"
X
X        end if
X
X    end for
X
X    let iResult=Binary2Word(cBitsRes)
X    return iResult
X
Xend function
X
X#-----------------------------------------------------------------------------
XFunction BitAndByte(iSource1, iSource2)
Xdefine iSource1,iSource2,iResult integer
Xdefine cBits1,cBits2,cBitsRes char(8)
Xdefine i smallint
X
X    let cBitsRes="00000000"
X    let cBits1=Byte2Binary(iSource1)
X    let cBits2=Byte2Binary(iSource2)
X
X    for i=1 to 8
X
X        if cBits1[i,i]="1" AND cBits2[i,i]="1" then
X
X            let cBitsRes[i,i]="1"
X
X        end if
X
X    end for
X
X    let iResult=Binary2Byte(cBitsRes)
X    return iResult
X
Xend function
X
X#-----------------------------------------------------------------------------
XFunction BitXorWord(iSource1, iSource2)
Xdefine iSource1,iSource2,iResult integer
Xdefine cBits1,cBits2,cBitsRes char(16)
Xdefine i smallint
X
X    let cBitsRes="0000000000000000"
X    let cBits1=Word2Binary(iSource1)
X    let cBits2=Word2Binary(iSource2)
X
X    for i=1 to 16
X
X        if cBits1[i,i]="1" or cBits2[i,i]="1" then
X
X            let cBitsRes[i,i]="1"
X
X        end if
X
X        if (cBits1[i,i]="1" and cBits2[i,i]="1") or (cBits1[i,i]="0" and cBits2[i,i]="0") then
X
X            let cBitsRes[i,i]="0"
X
X        end if
X
X    end for
X
X    let iResult=Binary2Word(cBitsRes)
X    return iResult
X
Xend function
X
X#-----------------------------------------------------------------------------
XFunction BitXorLong(iSource1, iSource2)
Xdefine iSource1,iSource2,iResult float
Xdefine cBits1,cBits2,cBitsRes char(32)
Xdefine i smallint
X
X    let cBitsRes="00000000000000000000000000000000"
X    let cBits1=Long2Binary(iSource1)
X    let cBits2=Long2Binary(iSource2)
X
X    for i=1 to 32
X
X        if cBits1[i,i]="1" or cBits2[i,i]="1" then
X
X            let cBitsRes[i,i]="1"
X
X        end if
X
X        if (cBits1[i,i]="1" and cBits2[i,i]="1") or (cBits1[i,i]="0" and cBits2[i,i]="0") then
X
X            let cBitsRes[i,i]="0"
X
X        end if
X
X    end for
X
X    let iResult=Binary2Long(cBitsRes)
X    return iResult
X
Xend function
X
X
X#-----------------------------------------------------------------------------
XFunction BitXorByte(iSource1, iSource2)
Xdefine iSource1,iSource2,iResult integer
Xdefine cBits1,cBits2,cBitsRes char(8)
Xdefine i smallint
X
X    let cBitsRes="00000000"
X    let cBits1=Byte2Binary(iSource1)
X    let cBits2=Byte2Binary(iSource2)
X
X    for i=1 to 8
X
X        if cBits1[i,i]="1" or cBits2[i,i]="1" then
X
X            let cBitsRes[i,i]="1"
X
X        end if
X
X        if (cBits1[i,i]="1" and cBits2[i,i]="1") or (cBits1[i,i]="0" and cBits2[i,i]="0") then
X
X            let cBitsRes[i,i]="0"
X
X        end if
X
X    end for
X
X    let iResult=Binary2Byte(cBitsRes)
X    return iResult
X
Xend function
X
X#-----------------------------------------------------------------------------
X# Encrypt/Decrypt a string
X#
X# The major advantage of XORString is, that two identical calls of this function,
X# where the result of the first call is passed as an argument to the second call,
X# gives the original input as the result.
X#
X# The disadvantage is, if your encryption key has the same characters at the same
X# position than the string to encrypt, we receive some 0 characters (n xor n -> 0)
X# 0 charaters are hard to handle in 4GL, so take care that, if you must, your
X# own encryption key consists of characters, that do not appear in the string to encrypt.
X# basically you're save to not pass an encryption key anyway. The code takes
X# care of it on its own then and ensures no 0-clashes if the string to encrypt is
X# plain ascii.
X#
X# e.G.
X# let cc=XORSTRING("dietmar.bos@gmx.net","§$%&()=?") -> ""&$/(&§!"§§$$%/&%/("
X# let cc=XORSTRING(cc,"§$%&()=?")                    -> "dietmar.bos@gmx.net"
X#-----------------------------------------------------------------------------
XFunction XORString(cText, cCrypt)
Xdefine cText char(1024)
Xdefine cTmp char(1024)
Xdefine cCrypt char(1024)
Xdefine cResult char(1024)
Xdefine i,iLen smallint
X
X    let cResult=""
X    let cTmp=""
X    if length(cCrypt)<=0 then let cCrypt="~#'´`)(&%%$§²³[]!?}{" end if
X
X    while length(cCrypt clipped)<1024
X
X        let cCrypt=cCrypt clipped,cCrypt
X
X    end while
X
X    let iLen=length(cText clipped)
X
X    for i=1 to iLen
X
X        let cResult[i,i]=chr( BitXorByte(asc(cText[i,i]),asc(cCrypt[i,i])) )
X
X    end for
X
X    return cResult[1,iLen]
X
Xend function
X
X
X#---------------------------------------------------------------------
X#
X# Num2BCD converts the long lNum to an EBCDIC string
X# this might be useful for data transformation in migration projects on
X# older IBM midrange like system /36
X#
X#---------------------------------------------------------------------
XFunction Num2BCD(lNum  )
Xdefine lNum integer
Xdefine i,iLen smallint
Xdefine cNum,cBCDStr char(64)
X
X    let cBCDStr=""
X    let cNum= LeftTrim(lNum)
X
X    If Length(cNum clipped) mod 2 <> 0 then
X        let cNum="0",cNum
X    End If
X
X    let iLen=Length(cNum clipped)
X
X    For i=0 To (iLen / 2) - 1
X
X        let cBCDStr=cBCDStr clipped,Chr(substr(cNum, (i * 2) + 1, 2)) clipped
X
X    end for
X
X    return cBCDStr clipped
X
Xend function
X
X#---------------------------------------------------------------------
X#
X# BCD2Num converts the EBCDIC string cBCDStr to a numeric value
X# this might be useful for data transformation in migration projects on
X# older IBM midrange like system /36
X#
X#---------------------------------------------------------------------
XFunction BCD2Num(cBCDStr)
Xdefine i,iLen smallint
Xdefine cNum,cBCDStr,cCopy char(64)
Xdefine iNum integer
X
X    let cNum=""
X    let cCopy=cBCDStr
X    let iLen=Length(cCopy clipped)
X
X    For i=1 To iLen
X
X        let cNum=cNum clipped, LeftTrim(Asc(substr(cCopy, i, 1))) clipped
X
X    end for
X
X    let iNum=cNum
X
X    return iNum
X
Xend function
X
X#---------------------------------------------------------------------
X#convert hexstring to decimal long
X#---------------------------------------------------------------------
XFunction Hex2Dec(cHex  )
Xdefine cHex,strChar char(32)
Xdefine lngValue float
Xdefine intCharValue,i,iLen smallint
X
X    let cHex=upshift(cHex)
X    let lngValue=0
X
X    If Length(cHex) > 8 then
X
X        let cHex= SubStr(cHex, 1, 8)
X
X    End If
X
X    let iLen=Length(cHex)
X
X    For i=0 To iLen - 1
X
X        let strChar=substr(cHex, Length(cHex) - i, 1)
X        let intCharValue=0
X
X        Case strChar
X            when "0"
X                let intCharValue=strChar
X            when "1"
X                let intCharValue=strChar
X            when "2"
X                let intCharValue=strChar
X            when "3"
X                let intCharValue=strChar
X            when "4"
X                let intCharValue=strChar
X            when "5"
X                let intCharValue=strChar
X            when "6"
X                let intCharValue=strChar
X            when "7"
X                let intCharValue=strChar
X            when "8"
X                let intCharValue=strChar
X            when "9"
X                let intCharValue=strChar
X            when "A"
X                let intCharValue=10
X            when "B"
X                let intCharValue=11
X            when "C"
X                let intCharValue=12
X            when "D"
X                let intCharValue=13
X            when "E"
X                let intCharValue=14
X            when "F"
X                let intCharValue=15
X        End case
X
X        let lngValue=lngValue + (intCharValue * (16 ** i))
X
X    end for
X
X    return lngValue
X
Xend function
X
X#---------------------------------------------------------------------
X#convert decimal long to heystring
X#---------------------------------------------------------------------
XFunction Dec2Hex(lDec )
Xdefine lDec float
Xdefine cTable char(16)
Xdefine lMod,lOld smallint
Xdefine sHex char(64)
X
X    let cTable="0123456789ABCDEF"
X    let sHex=""
X
X    While lDec > 0
X
X        let lMod=lDec mod 16
X
X        If lDec - lMod <= 0 then
X
X            let sHex=sHex clipped, cTable[lMod+1,lMod+1]
X            let lDec=0
X
X        Else
X
X            let lDec=lDec - lMod
X            let lOld=lDec
X            let lDec=lDec / 16
X            let sHex=sHex clipped,cTable[lMod+1,lMod+1]
X
X        End If
X
X    end while
X
X    If Length(sHex) mod 2 <> 0 then
X
X        let sHex=sHex clipped,"0"
X
X    End If
X
X    return StrReverse(sHex clipped)
X
Xend function
X
X#---------------------------------------------------------------------
X#reverse a string from back to front
X#---------------------------------------------------------------------
Xfunction StrReverse(cText)
Xdefine cText char(1024)
Xdefine cCopy char(1024)
Xdefine i,iLen smallint
X
X    let iLen=length(cText clipped)
X
X    let cCopy=cText
X
X    for i=1 to iLen
X
X        let cText[i,i]=cCopy[(iLen-i)+1,(iLen-i)+1]
X
X    end for
X
X    return cText clipped
X
Xend function
X
X
X#-----------------------------------------------
X# complementary functions
X# bits are toggled thru the whole value
X# for instance:
X# a bitvalue of 01010111 will result in:
X#               10101000
X#-----------------------------------------------
XFunction BitNotLong(dVal)
Xdefine dVal float
X    return 4294967295.0 - dVal # 4294967295=0x00ffffff
XEnd Function
X
X#-----------------------------------------------
XFunction BitNotWord(lVal)
Xdefine lVal integer
X    return 65535 - lVal # 65535=0xffff
XEnd Function
X
X#-----------------------------------------------
XFunction BitNotByte(iVal)
Xdefine iVal smallint
X    return 255 - iVal # 255=0xff  or 0b11111111
XEnd Function
X
X
X#-----------------------------------------------
X# returns the ascii value of a character
X# ASC("@")  -> 64
X#-----------------------------------------------
Xfunction Asc(cString)
Xdefine cString char(1)
Xdefine i,iRet smallint
X
X    # init table if not done already
X    if not bAsciiTableInit then
X
X        let bAsciiTableInit=1
X
X        for i=1 to 256
X
X            let cAsciiTable[i,i]= ASCII i
X
X        end for
X
X    end if
X
X    for i=1 to 256
X
X        if cString[1,1]= cAsciiTable[i] then
X
X            return i
X            exit for
X
X        end if
X
X    end for
X
X    # still nothing found, return 0 as an error
X    return 0
X
Xend function
X
X#-----------------------------------------------
X# returns the character of an ascii value (1-255)
X# CHR(64)  -> "@"
X#-----------------------------------------------
Xfunction Chr(iChar)
Xdefine iChar smallint
Xdefine cRes char(1)
Xdefine i,iRet smallint
X
X    # init table if not done already
X    if not bAsciiTableInit then
X
X        let bAsciiTableInit=1
X
X        for i=1 to 256
X
X            let cAsciiTable[i,i]= ASCII i
X
X        end for
X
X    end if
X
X    if iChar>0 and iChar<257 then
X
X        return cAsciiTable[iChar]
X
X    else
X
X        return 0
X
X    end if
X
Xend function
X
X#-----------------------------------------------------------------------------
XFUNCTION LeftTrim(TrmChar)
XDEFINE trmchar      CHAR(80)
Xdefine i,charpos,lt INTEGER
X
X    IF trmchar IS NULL THEN
X
X        let trmchar = " "
X
X    END IF
X
X    let lt = LENGTH(trmchar)
X
X    IF trmchar <> " " THEN
X
X        FOR i = 1 TO lt
X
X
X            IF trmchar[i] <> " " THEN
X                EXIT FOR
X
X            ELSE
X
X                let charpos = i
X
X            END IF
X
X        END FOR
X
X    END IF
X
X    IF lt > 0 THEN
X
X        let trmchar = trmchar[charpos+1,lt]
X
X    ELSE
X
X        let trmchar = " "
X
X    END IF
X
X    RETURN trmchar CLIPPED
X
XEND FUNCTION
X
X#-----------------------------------------------
X# returns a substring of cString from iStart with
X# length=iLen
X# not really necessary in 4GL, just there for completeness
X#-----------------------------------------------
Xfunction SubStr(cString,iStart,iLen)
Xdefine cString char(1024)
Xdefine iStart,iLen smallint
X
X    return cString[iStart,(iStart+iLen)-1]
X
Xend function
X
SHAR_EOF
if [ `wc -c < bin.4gl` -ne    34497 ]
then
    echo "Lengths do not match -- Bad Copy of bin.4gl"
fi
echo "Done."
exit 0