home *** CD-ROM | disk | FTP | other *** search
/ Planet Source Code Jumbo …e CD Visual Basic 1 to 7 / 6_2008-2009.ISO / data / zips / FYI___Bits2132981122008.psc / cBits.cls < prev   
Text File  |  2008-11-02  |  69KB  |  1,379 lines

  1. VERSION 1.0 CLASS
  2. BEGIN
  3.   MultiUse = -1  'True
  4.   Persistable = 0  'NotPersistable
  5.   DataBindingBehavior = 0  'vbNone
  6.   DataSourceBehavior  = 0  'vbNone
  7.   MTSTransactionMode  = 0  'NotAnMTSObject
  8. END
  9. Attribute VB_Name = "cBits"
  10. Attribute VB_GlobalNameSpace = False
  11. Attribute VB_Creatable = True
  12. Attribute VB_PredeclaredId = False
  13. Attribute VB_Exposed = False
  14. Option Explicit
  15.  
  16. ' Though most functions are replicated 3 times (1 for Longs, 1 for Integers, 1 for Bytes), it could
  17. ' be done in single functions but would require passing Variants, testing those Variants for the
  18. ' variable they contain and then performing the function, handling special overflow cases.
  19. ' So... to improve speed, each variable type has its own function
  20.  
  21. ' Whenever a variable is passed to a function that modifies the variable, any bit modifications
  22. ' performed are done in the context of the variable type passed. With Integers and Longs, any
  23. ' modifications to the high bit can change the value from negative to positive and vice versa.
  24. ' Those functions are: SetBit_xxx, SetMidBits_xxx, SetByte_xxx, ShiftBitsLeft_xxx & ShiftBitsRight_xxx
  25.  
  26. ' General Info
  27. ' Byte = 8 bits.  Bits are either 0 or 1.
  28. ' Integer = 2 bytes (16 bits), Long = 4 bytes (32 bits)
  29.  
  30. ' Bits are generally read from right to left and each bit has the value shown below, if it is ON (has value of 1 vs 0)
  31. '   low bit: 1, 2nd bit: 2, 3rd bit: 4, etc. The 1st 8 bits are: 1, 4, 8, 16, 32, 64, 128
  32. '   For Integers, the additional 8 bits are: 256, 512, 1024, 2048, 4096, 8192, 16384, 32768
  33. '   For Longs, the additional 16 bits are: 65536,131072,262144,524288,1048576,2097152,4194304,8388608,16777216,33554432,67108864,134217728,268435456,536870912,1073741824,2147483648
  34. ' Bits are referenced from zero, not 1.  So the 1st bit is bit zero.
  35. ' To calculate the bit position values, powers of two are used: Therefore for the 1st bit position, bit 0, value is 1,  2^0 = 1
  36. '   :: For p=0 To lastBitPosition: Debug.Print p, 2^p : Next
  37.  
  38. ' Integer & Long variables' high bits indicate whether or not the value is negative, not the value associated with that bit position.
  39. '   Because of this VB Integers/Longs are signed vs unsigned
  40. '       A signed Integer's min/max values range from -2^15 to 2^15-1
  41. '           An unsigned integer (C++ terms) ranges from 0 to 2^16-1. Unsigned Integers should be Longs in VB
  42. '       A signed Long's min/max values range from -2^31 to 2^31-1
  43. '           An unsigned long (C++ terms) ranges from 0 to 2^32-1. Unsigned Longs should be Doubles in VB
  44. '   A signed byte (C++ terms) values range from -2^7 to 2^7-1. Signed Bytes should be Integers/Longs in VB
  45. '       An unsigned Byte ranges from 0 to 2^8-1. VB Byte variables are always unsigned
  46. ' ... Determine min/max values
  47. ' :: Multiply bytes used by the variable type by 8 to get number of bits
  48. ' :: Is the type signed or unsigned, i.e., can variable type have negative values
  49. ' Then the calculation is:
  50. '   if Signed:      min= -2^(nrBits-1), max= (2^(nrBits-1))-1
  51. '   if Unsigned:    min= 0              max= (2^nrBits)-1
  52.  
  53. ' Note regarding Right Shift. Some shifters out there fill negative values with zeroes, but should not.
  54. ' Shifting right is done via integer division. (3) 0011 >>1 = 0001 (1) (decimal: 3 \ 2^1 = 1)
  55. ' When a negative number is shifted: (-32768) 10000000 00000000 >>1 = 11000000 00000000 (-16384)
  56. '                                    decimal: -32768 \ 2^1 = -16384
  57. ' If the far left were filled with zeros, then the result 01000000 00000000 (16384) is wrong.
  58. ' Therefore, all the shifting functions allow you to choose how you want vacated bits to be filled
  59. ' there are 3 options:
  60. ' :: Fill with zeros, Fill with onex, or use Arithmetic fills (Default)
  61. ' What is Arithmetic? Fill with the high bit. For positive values, zeros, for negative, ones
  62. ' When forcing non-Arithmetic, then the term is a Logical fill
  63.  
  64. ' following APIs & UDT are used for CRC functions
  65. Private Declare Sub CopyMemory Lib "kernel32.dll" Alias "RtlMoveMemory" (ByRef Destination As Any, ByRef Source As Any, ByVal Length As Long)
  66. Private Declare Function VarPtrArray Lib "msvbvm60.dll" Alias "VarPtr" (ByRef Ptr() As Any) As Long
  67. Private Type SafeArrayBound
  68.     cElements As Long
  69.     lLbound As Long
  70. End Type
  71. Private Type SafeArray        ' used as DMA overlay on a string
  72.     cDims As Integer
  73.     fFeatures As Integer
  74.     cbElements As Long
  75.     cLocks As Long
  76.     pvData As Long
  77.     rgSABound(0 To 1) As SafeArrayBound ' allows using up to 2 dimensional arrays
  78. End Type
  79. ' following API used for ShiftBitsLeft_Array & ShiftBitsRight_Array
  80. Private Declare Sub FillMemory Lib "kernel32.dll" Alias "RtlFillMemory" (ByRef Destination As Any, ByVal Length As Long, ByVal Fill As Byte)
  81.  
  82. Public Enum StringTypeConstants
  83.     crcANSI = 0
  84.     crcUnicode = 1
  85. End Enum
  86. Public Enum BitShiftWrapEnum
  87.     bitShift_Truncate = 0
  88.     bitShift_Wrap = 1
  89. End Enum
  90. Public Enum FillTypeConstants
  91.     fillZeros_Logical = 0
  92.     fillOnes_Logical = 1
  93.     fillArithmetic_HighBit = 2
  94. End Enum
  95.  
  96. Private CRC32LUT() As Long
  97. Private CRC32LUTbuilt As Boolean
  98. Private Const MaxUnsignedLongAnd1 As Double = 4294967296#
  99. Private Const MaxSignedLongAnd1 As Double = 2147483648#
  100. Private Const MaskHighBit_Long As Long = &H80000000
  101. Private Const MaskHighBit_Int As Integer = &H8000
  102. Private Const MaskHighBit_Byte As Byte = &H80
  103. Private Const BitCount_Long As Byte = 32
  104. Private Const BitCount_Int As Byte = 16
  105. Private Const BitCount_Byte As Byte = 8
  106. Private mPO2lut(0 To 31) As Double ' 2^31 is a double not Long & used when wrapping shifts
  107.  
  108. Public Function SignedIntegerToUnsigned(ByVal theValue As Integer) As Long
  109.     ' function converts a signed integer to an unsigned Long
  110.     SignedIntegerToUnsigned = (theValue And &HFFFF&)
  111. End Function
  112. Public Function UnsignedIntegerToSigned(ByVal theValue As Long) As Integer
  113.     ' function converts a Long to a signed integer
  114.     ' if the passed value contains more than 16 usable bits, we can't scrunch 16+ into a 16bit variable
  115.     If theValue < 0& Or theValue > mPO2lut(BitCount_Int) - 1& Then Exit Function ' overflow
  116.     If theValue < mPO2lut(15) Then
  117.         UnsignedIntegerToSigned = theValue
  118.     Else
  119.         UnsignedIntegerToSigned = theValue - mPO2lut(BitCount_Int)
  120.     End If
  121. End Function
  122. Public Function SignedLongToUnsigned(ByVal theValue As Long) As Double
  123.     ' function converts a signed long to an unsigned Double
  124.     If (theValue And MaskHighBit_Long) Then
  125.         SignedLongToUnsigned = theValue + MaxUnsignedLongAnd1
  126.     Else
  127.         SignedLongToUnsigned = theValue
  128.     End If
  129. End Function
  130. Public Function UnsignedLongToSigned(ByVal theValue As Double) As Long
  131.     ' function converts a Double to a signed Long
  132.     
  133.     ' if the passed value contains more than 32 usable bits, we can't scrunch 32+ into a 32bit variable
  134.     If theValue < 0# Or theValue > MaxUnsignedLongAnd1 Then Exit Function  ' overflow
  135.     If theValue < MaxSignedLongAnd1 Then
  136.         UnsignedLongToSigned = theValue
  137.     Else
  138.         UnsignedLongToSigned = theValue - MaxUnsignedLongAnd1
  139.     End If
  140. End Function
  141.  
  142. Public Function MakeDWord2(ByVal theHiWord As Integer, ByVal theLoWord As Integer) As Long
  143.     ' create a Long (4 bytes) from the passed 2 Integers (2 bytes each)
  144.     MakeDWord2 = (CLng(theHiWord) * mPO2lut(BitCount_Int)) Or (theLoWord And &HFFFF&)
  145. End Function
  146. Public Function MakeDWord4(ByVal theHiByte As Byte, ByVal theByte2 As Byte, ByVal theByte1 As Byte, ByVal theLoByte As Byte) As Long
  147.     ' create a Long (4 bytes) from the passed 4 bytes
  148.     If (theHiByte And MaskHighBit_Byte) Then
  149.         MakeDWord4 = ((theHiByte And &H7F) * &H1000000) Or theByte2 * &H10000 Or theByte1 * &H100& Or theLoByte Or MaskHighBit_Long
  150.     Else
  151.         MakeDWord4 = theHiByte * &H1000000 Or theByte2 * &H10000 Or theByte1 * &H100& Or theLoByte
  152.     End If
  153. End Function
  154. Public Function MakeWord(ByVal theHiByte As Byte, ByVal theLoByte As Byte) As Integer
  155.     ' create an Integer (2 bytes) from the passed 2 bytes
  156.     If theHiByte And MaskHighBit_Byte Then
  157.         MakeWord = ((theHiByte And &H7F) * &H100&) Or theLoByte Or MaskHighBit_Int
  158.     Else
  159.         MakeWord = (theHiByte * &H100&) Or theLoByte
  160.     End If
  161. End Function
  162. Public Function GetBit_FromLong(ByVal theValue As Long, ByVal Position0to31 As Byte) As Byte
  163.     ' function returns the bit on/off from the passed value.
  164.     ' Position must be 0 to max bits - 1 for the variable passed
  165.     If Position0to31 = BitCount_Long - 1& Then ' high bit requested
  166.         If (theValue And MaskHighBit_Long) Then GetBit_FromLong = 1
  167.     ElseIf Position0to31 < BitCount_Long Then
  168.         GetBit_FromLong = ((theValue And &H7FFFFFFF) \ mPO2lut(Position0to31)) And 1
  169.     End If
  170. End Function
  171. Public Function GetBit_FromInteger(ByVal theValue As Integer, ByVal Position0to15 As Byte) As Byte
  172.     ' function returns the bit on/off from the passed value.
  173.     ' Position must be 0 to max bits - 1 for the variable passed
  174.     If Position0to15 < BitCount_Int Then GetBit_FromInteger = ((theValue And &HFFFF&) \ mPO2lut(Position0to15)) And 1
  175. End Function
  176. Public Function GetBit_FromByte(ByVal theValue As Byte, ByVal Position0to7 As Byte) As Byte
  177.     ' function returns the bit on/off from the passed value.
  178.     ' Position must be 0 to max bits - 1 for the variable passed
  179.     If Position0to7 < BitCount_Byte Then GetBit_FromByte = (theValue \ mPO2lut(Position0to7)) And 1
  180. End Function
  181. Public Function SetBit_Long(ByRef theValue As Long, ByVal Position0to31 As Byte, ByVal TurnOn As Boolean) As Boolean
  182.     ' Sets a single bit either on or off within passed Long
  183.     ' Positions are from right to left
  184.     If Position0to31 = BitCount_Long - 1& Then ' playing with the high bit
  185.         If TurnOn Then
  186.             theValue = theValue Or MaskHighBit_Long
  187.         Else
  188.             theValue = theValue Xor MaskHighBit_Long
  189.         End If
  190.         SetBit_Long = True
  191.     ElseIf Position0to31 < BitCount_Long Then
  192.         If TurnOn Then
  193.             theValue = theValue Or (mPO2lut(Position0to31))
  194.         Else
  195.             theValue = theValue Xor (mPO2lut(Position0to31))
  196.         End If
  197.         SetBit_Long = True
  198.     End If
  199. End Function
  200. Public Function SetBit_Integer(ByRef theValue As Integer, ByVal Position0to15 As Byte, ByVal TurnOn As Boolean) As Boolean
  201.     ' Sets a single bit either on or off within passed Integer
  202.     ' Positions are from right to left
  203.     If Position0to15 = BitCount_Int - 1& Then ' playing with the high bit
  204.         If TurnOn Then
  205.             theValue = theValue Or MaskHighBit_Int
  206.         Else
  207.             theValue = theValue Xor MaskHighBit_Int
  208.         End If
  209.         SetBit_Integer = True
  210.     ElseIf Position0to15 < BitCount_Int Then
  211.         If TurnOn Then
  212.             theValue = theValue Or (mPO2lut(Position0to15))
  213.         Else
  214.             theValue = theValue Xor (mPO2lut(Position0to15))
  215.         End If
  216.         SetBit_Integer = True
  217.     End If
  218. End Function
  219. Public Function SetBit_Byte(ByRef theValue As Byte, ByVal Position0to7 As Byte, ByVal TurnOn As Boolean) As Boolean
  220.     ' Sets a single bit either on or off within passed Byte
  221.     ' Positions are from right to left
  222.     If Position0to7 < BitCount_Byte Then
  223.         If TurnOn Then
  224.             theValue = theValue Or (mPO2lut(Position0to7))
  225.         Else
  226.             theValue = theValue Xor (mPO2lut(Position0to7))
  227.         End If
  228.         SetBit_Byte = True
  229.     End If
  230. End Function
  231.  
  232. Public Function SetMidBits_FromByte(ByRef destValue As Byte, ByVal fromBit0to7 As Byte, ByVal BitsLength1to8 As Byte, ByVal setValue As Byte) As Boolean
  233.     ' Sets a range of consecutive bits within passed Byte, to the pased value
  234.     ' Positions are from right to left
  235.     ' Note: provide the unshifted values for setValue.
  236.     ' Example: if you want to set the far left 2 bits on, simply provide 3 which is binary 11
  237.     Dim modMask As Long
  238.     ' validate passed parameters
  239.     If fromBit0to7 < BitCount_Byte And BitsLength1to8 > 0 Then
  240.         ' validate number of bits to be modified
  241.         If fromBit0to7 + BitsLength1to8 > BitCount_Byte Then BitsLength1to8 = BitCount_Byte - fromBit0to7
  242.         ' validate setValue fits within the number of bits being modified (i.e, if modifying 2 bits, max value can be 3)
  243.         If setValue < mPO2lut(BitsLength1to8) Then
  244.             modMask = CreateBitMask(fromBit0to7, BitsLength1to8)
  245.             destValue = (destValue Xor (destValue And modMask)) Or (setValue * mPO2lut(fromBit0to7))
  246.             SetMidBits_FromByte = True
  247.         End If
  248.     End If
  249.  
  250. End Function
  251.  
  252. Public Function SetMidBits_FromLong(ByRef destValue As Long, ByVal fromBit0to31 As Byte, ByVal BitsLength1to32 As Byte, ByVal setValue As Long) As Boolean
  253.     ' Sets a range of consecutive bits within passed Long, to the pased value
  254.     ' Positions are from right to left
  255.     ' Note: provide the unshifted values for setValue.
  256.     ' Example: if you want to set the far left 2 bits on, simply provide 3 which is binary 11
  257.     Dim modMask As Long
  258.     ' validate passed parameters
  259.     If fromBit0to31 < BitCount_Long And BitsLength1to32 > 0 Then
  260.         ' validate number of bits to be modified
  261.         If fromBit0to31 + BitsLength1to32 > BitCount_Long Then BitsLength1to32 = BitCount_Long - fromBit0to31
  262.         ' validate setValue fits within the number of bits being modified (i.e, if modifying 2 bits, max value can be 3)
  263.         If setValue < mPO2lut(BitsLength1to32) Or BitsLength1to32 = BitCount_Long Then
  264.             modMask = CreateBitMask(fromBit0to31, BitsLength1to32)
  265.             ' remove the previous bits values
  266.             destValue = destValue Xor (destValue And modMask)
  267.             ' now add the new bits values, shifting bits into place first
  268.             If modMask And MaskHighBit_Long Then
  269.                 If (setValue \ mPO2lut(BitsLength1to32 - 1&)) Then ' the new bits value will set the high bit
  270.                     destValue = destValue Or ((setValue And mPO2lut(BitsLength1to32 - 1&) - 1&) * mPO2lut(fromBit0to31)) Or MaskHighBit_Long
  271.                 Else    ' else the new bits value does not contain high bit
  272.                     destValue = destValue Or ((setValue And mPO2lut(BitsLength1to32 - 1&) - 1&) * mPO2lut(fromBit0to31))
  273.                 End If
  274.             Else    ' shift & set
  275.                 destValue = destValue Or (setValue * mPO2lut(fromBit0to31))
  276.             End If
  277.             
  278.             SetMidBits_FromLong = True
  279.         End If
  280.     End If
  281.  
  282. End Function
  283.  
  284. Public Function SetMidBits_FromInteger(ByRef destValue As Integer, ByVal fromBit0to15 As Byte, ByVal BitsLength1to16 As Byte, ByVal setValue As Integer) As Boolean
  285.     ' Sets a range of consecutive bits within passed Integer, to the pased value
  286.     ' Positions are from right to left
  287.     ' Note: provide the unshifted values for setValue.
  288.     ' Example: if you want to set the far left 2 bits on, simply provide 3 which is binary 11
  289.     Dim modMask As Long
  290.     ' validate passed parameters
  291.     If fromBit0to15 < BitCount_Int And BitsLength1to16 > 0 Then
  292.         ' validate number of bits to be modified
  293.         If fromBit0to15 + BitsLength1to16 > BitCount_Int Then BitsLength1to16 = BitCount_Int - fromBit0to15
  294.         ' validate setValue fits within the number of bits being modified (i.e, if modifying 2 bits, max value can be 3)
  295.         If setValue < mPO2lut(BitsLength1to16) Or BitsLength1to16 = BitCount_Int Then
  296.             modMask = CreateBitMask(fromBit0to15, BitsLength1to16)
  297.             ' remove the previous bits values
  298.             destValue = destValue Xor (destValue And modMask)
  299.             ' now add the new bits values, shifting bits into place first
  300.             If modMask And MaskHighBit_Int Then
  301.                 ' overflow checks
  302.                 If (setValue \ mPO2lut(BitsLength1to16 - 1&)) Then ' the new bits value will set the high bit
  303.                     destValue = destValue Or ((setValue And mPO2lut(BitsLength1to16 - 1&) - 1&) * mPO2lut(fromBit0to15)) Or MaskHighBit_Int
  304.                 Else    ' else the new bits value does not contain high bit
  305.                     destValue = destValue Or ((setValue And mPO2lut(BitsLength1to16 - 1&) - 1&) * mPO2lut(fromBit0to15))
  306.                 End If
  307.             Else    ' shift & set
  308.                 destValue = destValue Or (setValue * mPO2lut(fromBit0to15))
  309.             End If
  310.             SetMidBits_FromInteger = True
  311.         End If
  312.     End If
  313.  
  314. End Function
  315.  
  316. Public Function GetMidBits_Long(ByVal theValue As Long, ByVal fromBit0to31 As Byte, ByVal Length As Byte) As Long
  317.     ' Returns the value of a range of consecutive bits within passed Long
  318.     ' Positions are from right to left
  319.     ' Note: the return value is unshifted bit value
  320.     ' Example: if returning the far 2 left bits and they were binary 11, the result is 3 not -1073741824 (shifted)
  321.     If fromBit0to31 < BitCount_Long Then
  322.         If Length + fromBit0to31 > BitCount_Long Then Length = BitCount_Long - fromBit0to31
  323.         If fromBit0to31 + Length = BitCount_Long Then  ' high bit is part of what is returned
  324.             ' overflow checks
  325.             If fromBit0to31 = 31& Then ' return high bit on/off
  326.                 If (theValue And MaskHighBit_Long) Then GetMidBits_Long = 1&
  327.             ElseIf fromBit0to31 Then ' range starting >0 and ending <31
  328.                 If (theValue And MaskHighBit_Long) Then  ' high bit set?
  329.                     GetMidBits_Long = ((theValue And &H7FFFFFFF) \ mPO2lut(fromBit0to31)) Or (mPO2lut(Length - 1&)) And (mPO2lut(Length) - 1&)
  330.                 Else
  331.                     GetMidBits_Long = ((theValue And &H7FFFFFFF) \ mPO2lut(fromBit0to31)) And (mPO2lut(Length) - 1&)
  332.                 End If
  333.             Else    ' entire 32bit range
  334.                 GetMidBits_Long = theValue
  335.             End If
  336.         ElseIf Length Then
  337.             GetMidBits_Long = ((theValue And &H7FFFFFFF) \ mPO2lut(fromBit0to31)) And (mPO2lut(Length) - 1&)
  338.         End If
  339.     End If
  340. End Function
  341. Public Function GetMidBits_Integer(ByVal theValue As Integer, ByVal fromBit0to15 As Byte, ByVal Length As Byte) As Long
  342.     ' Returns the value of a range of consecutive bits within passed Integer
  343.     ' Positions are from right to left
  344.     ' Note: the return value is unshifted bit value
  345.     ' Example: if returning the far 2 left bits and they were binary 11, the result is 3 not -16384 (shifted)
  346.     If fromBit0to15 < BitCount_Int Then
  347.         If Length + fromBit0to15 > BitCount_Int Then Length = BitCount_Int - fromBit0to15
  348.         GetMidBits_Integer = ((theValue And &HFFFF&) \ mPO2lut(fromBit0to15)) And (mPO2lut(Length) - 1&)
  349.     End If
  350. End Function
  351. Public Function GetMidBits_Byte(ByVal theValue As Byte, ByVal fromBit0to7 As Byte, ByVal Length As Byte) As Long
  352.     ' Returns the value of a range of consecutive bits within passed Byte
  353.     ' Positions are from right to left
  354.     ' Note: the return value is unshifted bit value
  355.     ' Example: if returning the far 2 left bits and they were binary 11, the result is 3 not 192 (shifted)
  356.     If fromBit0to7 < BitCount_Byte Then
  357.         If Length + fromBit0to7 > BitCount_Byte Then Length = BitCount_Byte - fromBit0to7
  358.         GetMidBits_Byte = ((theValue And &HFF) \ mPO2lut(fromBit0to7)) And (mPO2lut(Length) - 1&)
  359.     End If
  360. End Function
  361. Public Function HighByte(theValue As Variant) As Byte
  362.     ' return the last 8 bits (1 byte) of the passed value
  363.     Select Case (VarType(theValue) And Not vbArray)
  364.     Case vbInteger
  365.         ' note. can also call: GetByte_FromInteger(theValue, 1)
  366.         HighByte = (theValue And &HFF00&) \ &H100
  367.     Case vbLong
  368.         ' note. can also call: GetByte_FromLong(theValue, 3)
  369.         If (theValue And MaskHighBit_Long) Then
  370.             HighByte = (theValue And &H7FFFFFFF) \ &H1000000 Or MaskHighBit_Byte
  371.         Else
  372.             HighByte = theValue \ &H1000000
  373.         End If
  374.     Case vbByte
  375.         HighByte = theValue
  376.     End Select
  377. End Function
  378. Public Function LowByte(theValue As Variant) As Byte
  379.     ' returns the 1st 8 bits (1byte) of the passed value
  380.     Select Case (VarType(theValue) And Not vbArray)
  381.     Case vbInteger
  382.         ' note. can also call: GetByte_FromInteger(theValue, 0)
  383.         LowByte = (theValue And &HFF&)
  384.     Case vbLong
  385.         ' note. can also call: GetByte_FromLong(theValue, 0)
  386.         LowByte = (theValue And &HFF&)
  387.     Case vbByte
  388.         LowByte = theValue
  389.     End Select
  390. End Function
  391. Public Function HighWord(ByVal theValue As Long) As Integer
  392.     ' returns the last 16 bits (2 bytes) of the passed value
  393.     HighWord = (theValue And &HFFFF0000) \ &H10000
  394. End Function
  395. Public Function LowWord(ByVal theValue As Long) As Integer
  396.     ' returns the 1st 16 bits (2 bytes) of the passed value
  397.     If theValue And &H8000& Then
  398.       LowWord = theValue Or &HFFFF0000
  399.     Else
  400.       LowWord = theValue And &HFFFF&
  401.     End If
  402. End Function
  403.  
  404. Public Sub GetRGBA(ByVal fromValue As Long, ByRef Red As Byte, ByRef Green As Byte, ByRef Blue As Byte, ByRef Alpha As Byte)
  405.     If (fromValue And MaskHighBit_Long) Then
  406.         Alpha = (fromValue And Not MaskHighBit_Long) \ &H1000000 Or &H80
  407.     Else
  408.         Alpha = (fromValue And &HFF000000) \ &H1000000
  409.     End If
  410.     Blue = (fromValue And &HFF0000) \ &H10000
  411.     Green = (fromValue And &HFF00&) \ &H100
  412.     Red = (fromValue And &HFF)
  413.     
  414. End Sub
  415. Public Function GetByte_FromLong(ByVal theValue As Long, ByVal Position0to3 As Byte) As Byte
  416.     ' Function returns a byte from a long, from its zero-based Index
  417.     ' Passing a Byte returns the entire byte
  418.     ' Valid Positions: Integer=0,1: Long=0,1,2,3
  419.     If Position0to3 = 3 Then
  420.         If (theValue And MaskHighBit_Long) Then
  421.             GetByte_FromLong = (theValue And &H7FFFFFFF) \ &H1000000 Or MaskHighBit_Byte
  422.         Else
  423.             GetByte_FromLong = theValue \ &H1000000
  424.         End If
  425.     ElseIf Position0to3 < 3 Then
  426.         GetByte_FromLong = ((theValue And &HFFFFFF) \ mPO2lut(Position0to3 * BitCount_Byte)) And &HFF
  427.     End If
  428. End Function
  429. Public Function GetByte_FromInteger(ByVal theValue As Integer, ByVal Position0to1 As Byte) As Byte
  430.     ' Function returns a byte from an integer, from its zero-based Index
  431.     ' Passing a Byte returns the entire byte
  432.     ' Valid Positions: Integer=0,1: Long=0,1,2,3
  433.     If Position0to1 = 0 Then
  434.         GetByte_FromInteger = (theValue And &HFF&)
  435.     Else
  436.         GetByte_FromInteger = (theValue And &HFF00&) \ &H100
  437.     End If
  438. End Function
  439.  
  440. Public Function SetByte_FromLong(ByRef destValue As Long, ByVal ByteValue As Byte, ByVal Position0to3 As Byte) As Boolean
  441.     ' function sets one of the 4 bytes in the passed Long variable
  442.     ' Position0to3 is from right to left
  443.     If Position0to3 = 3& Then
  444.         If (ByteValue And MaskHighBit_Byte) Then
  445.             destValue = (destValue And &HFFFFFF) Or (ByteValue And &H7F) * mPO2lut(24) Or MaskHighBit_Long
  446.         Else
  447.             destValue = (destValue And &HFFFFFF) Or ByteValue * mPO2lut(24)
  448.         End If
  449.         SetByte_FromLong = True
  450.     ElseIf Position0to3 < 3& Then
  451.         destValue = (destValue Xor (&HFF& * (mPO2lut(Position0to3 * BitCount_Byte)))) Or ByteValue * mPO2lut(Position0to3 * BitCount_Byte)
  452.         SetByte_FromLong = True
  453.     End If
  454. End Function
  455. Public Function SetByte_FromInteger(ByRef destValue As Integer, ByVal ByteValue As Byte, ByVal Position0to1 As Byte) As Boolean
  456.     ' function sets one of the 2 bytes in the passed Integer variable
  457.     ' Position0to3 is from right to left
  458.     If Position0to1 = 1& Then
  459.         If (ByteValue And MaskHighBit_Byte) Then
  460.             destValue = (destValue And &HFF&) Or (ByteValue And &H7F) * mPO2lut(BitCount_Byte) Or MaskHighBit_Int
  461.         Else
  462.             destValue = (destValue And &HFF&) Or ByteValue * mPO2lut(BitCount_Byte)
  463.         End If
  464.         SetByte_FromInteger = True
  465.     ElseIf Position0to1 = 0& Then
  466.         If (destValue And MaskHighBit_Int) Then
  467.             destValue = (destValue And &H7F00&) Or ByteValue Or MaskHighBit_Int
  468.         Else
  469.             destValue = (destValue And &HFF00&) Or ByteValue
  470.         End If
  471.         SetByte_FromInteger = True
  472.     End If
  473. End Function
  474.  
  475. Public Function ShiftBitsLeft_Long(ByRef theValue As Long, Optional ByVal Iterations = 1&, _
  476.                                 Optional ByVal WrapOption As BitShiftWrapEnum = bitShift_Truncate, _
  477.                                 Optional ByVal FillMethod As FillTypeConstants = fillArithmetic_HighBit) As Boolean
  478.                                 
  479.     ' function modifies passed Long by shifting the bits n times to the left
  480.     ' Equivalent to C++:  <<n
  481.     ' Wrapping: when 11001001 is shifted left 1 and wrapped: 10010011
  482.     Dim tValue As Long, tWrap As Long
  483.     If Iterations < 1& Then
  484.         ShiftBitsLeft_Long = (Iterations = 1&)
  485.         Exit Function
  486.     End If
  487.     If WrapOption = bitShift_Wrap Then
  488.         Iterations = Iterations Mod BitCount_Long
  489.         If (Iterations And 31) Then ' else nothing to do
  490.             ' we will cache the bits from the bit just left of the bit being shifted to the high bit
  491.             ' this cache will then wrap to the far right
  492.             If Iterations = 1& Then ' prevent overflow
  493.                 If (theValue And MaskHighBit_Long) Then tWrap = Iterations
  494.             ElseIf (theValue And MaskHighBit_Long) Then
  495.                 tWrap = ((theValue And &H7FFFFFFF) \ mPO2lut(BitCount_Long - Iterations)) Or mPO2lut(Iterations - 1&)
  496.             Else
  497.                 tWrap = (theValue \ mPO2lut(BitCount_Long - Iterations))
  498.             End If
  499.             ' now we need to shift right bits the left & append the wrap over
  500.             tValue = (theValue And (mPO2lut(BitCount_Long - Iterations - 1&) - 1&)) * mPO2lut(Iterations) Or tWrap
  501.             ' if the bit being shifted is now the high bit, set that here
  502.             If (theValue And mPO2lut(BitCount_Long - Iterations - 1&)) Then theValue = tValue Or MaskHighBit_Long Else theValue = tValue
  503.         End If
  504.     Else
  505.         If FillMethod = fillArithmetic_HighBit Then
  506.             FillMethod = fillZeros_Logical
  507.         Else
  508.             FillMethod = &HFFFFFFFF
  509.         End If
  510.         If Iterations \ BitCount_Long Then  ' all bits shifted out
  511.             theValue = FillMethod
  512.         Else
  513.             tWrap = BitCount_Long - Iterations - 1&
  514.             tValue = (theValue And (mPO2lut(tWrap) - 1&)) * mPO2lut(Iterations) Or (FillMethod And (mPO2lut(Iterations) - 1))
  515.             If (theValue And mPO2lut(tWrap)) Then theValue = tValue Or MaskHighBit_Long Else theValue = tValue
  516.         End If
  517.     End If
  518.     ShiftBitsLeft_Long = True
  519. End Function
  520.  
  521. Public Function ShiftBitsLeft_Integer(ByRef theValue As Integer, Optional ByVal Iterations = 1&, _
  522.                                 Optional ByVal WrapOption As BitShiftWrapEnum = bitShift_Truncate, _
  523.                                 Optional ByVal FillMethod As FillTypeConstants = fillArithmetic_HighBit) As Boolean
  524.                                 
  525.     ' function modifies passed Integer by shifting the bits n times to the left
  526.     ' Equivalent to C++:  <<n
  527.     ' Wrapping: when 11001001 is shifted left 1 and wrapped: 10010011
  528.     Dim tValue As Integer, tWrap As Integer
  529.     If Iterations < 1& Then
  530.         ShiftBitsLeft_Integer = (Iterations = 1&)
  531.         Exit Function
  532.     End If
  533.     If WrapOption = bitShift_Wrap Then
  534.         Iterations = Iterations Mod BitCount_Int
  535.         If (Iterations And 15) Then ' else nothing to do
  536.             ' we will cache the bits from the bit just left of the bit being shifted to the high bit
  537.             ' this cache will then wrap to the far right
  538.             If (theValue And MaskHighBit_Int) Then
  539.                 tWrap = ((theValue And &H7FFF) \ mPO2lut(BitCount_Int - Iterations)) Or mPO2lut(Iterations - 1&)
  540.             Else
  541.                 tWrap = (theValue \ mPO2lut(BitCount_Int - Iterations))
  542.             End If
  543.             ' now we need to shift right bits the left & append the wrap over
  544.             tValue = (theValue And (mPO2lut(BitCount_Int - Iterations - 1&) - 1&)) * mPO2lut(Iterations) Or tWrap
  545.             ' if the bit being shifted is now the high bit, set that here
  546.             If (theValue And mPO2lut(BitCount_Int - Iterations - 1&)) Then theValue = tValue Or MaskHighBit_Int Else theValue = tValue
  547.         End If
  548.     Else
  549.         If FillMethod = fillArithmetic_HighBit Then
  550.             FillMethod = fillZeros_Logical
  551.         Else
  552.             If FillMethod = fillOnes_Logical Then FillMethod = &HFFFF
  553.         End If
  554.         If Iterations \ BitCount_Int Then  ' all bits shifted out
  555.             theValue = FillMethod
  556.         Else
  557.             tWrap = BitCount_Int - Iterations - 1
  558.             tValue = (theValue And (mPO2lut(tWrap) - 1&)) * mPO2lut(Iterations) Or (FillMethod And (mPO2lut(Iterations) - 1))
  559.             If (theValue And mPO2lut(tWrap)) Then theValue = tValue Or MaskHighBit_Int Else theValue = tValue
  560.         End If
  561.     End If
  562.     ShiftBitsLeft_Integer = True
  563. End Function
  564.  
  565. Public Function ShiftBitsLeft_Byte(ByRef theValue As Byte, Optional ByVal Iterations = 1&, _
  566.                                 Optional ByVal WrapOption As BitShiftWrapEnum = bitShift_Truncate, _
  567.                                 Optional ByVal FillMethod As FillTypeConstants = fillArithmetic_HighBit) As Boolean
  568.                                 
  569.     ' function modifies passed Byte by shifting the bits n times to the left
  570.     ' Equivalent to C++:  <<n
  571.     ' Wrapping: when 11001001 is shifted left 1 and wrapped: 10010011
  572.     Dim tValue As Byte, tWrap As Byte
  573.     If Iterations < 1& Then
  574.         ShiftBitsLeft_Byte = (Iterations = 1&)
  575.         Exit Function
  576.     End If
  577.     If WrapOption = bitShift_Wrap Then
  578.         Iterations = Iterations Mod BitCount_Byte
  579.         If (Iterations And 7) Then ' else nothing to do
  580.             ' we will cache the bits from the bit just left of the bit being shifted to the high bit
  581.             ' this cache will then wrap to the far right
  582.             If (theValue And MaskHighBit_Byte) Then
  583.                 tWrap = (theValue \ mPO2lut(BitCount_Byte - Iterations)) Or mPO2lut(Iterations - 1&)
  584.             Else
  585.                 tWrap = (theValue \ mPO2lut(BitCount_Byte - Iterations))
  586.             End If
  587.             ' now we need to shift right bits the left & append the wrap over
  588.             tValue = (theValue And (mPO2lut(BitCount_Byte - Iterations - 1&) - 1&)) * mPO2lut(Iterations) Or tWrap
  589.             ' if the bit being shifted is now the high bit, set that here
  590.             If (theValue And mPO2lut(BitCount_Byte - Iterations - 1&)) Then theValue = tValue Or MaskHighBit_Byte Else theValue = tValue
  591.         End If
  592.     Else
  593.         If FillMethod = fillArithmetic_HighBit Then
  594.             FillMethod = fillZeros_Logical
  595.         Else
  596.             If FillMethod = fillOnes_Logical Then FillMethod = &HFF
  597.         End If
  598.         If Iterations \ BitCount_Byte Then  ' all bits shifted out
  599.             theValue = FillMethod
  600.         Else
  601.             tWrap = BitCount_Byte - Iterations - 1
  602.             tValue = (theValue And (mPO2lut(tWrap) - 1&)) * mPO2lut(Iterations) Or (FillMethod And (mPO2lut(Iterations) - 1))
  603.             If (theValue And mPO2lut(tWrap)) Then theValue = tValue Or MaskHighBit_Byte Else theValue = tValue
  604.         End If
  605.     End If
  606.     ShiftBitsLeft_Byte = True
  607.  
  608. End Function
  609.  
  610. Public Function ShiftBitsRight_Byte(theValue As Byte, Optional ByVal Iterations As Long = 1&, _
  611.                                 Optional ByVal WrapOption As BitShiftWrapEnum = bitShift_Truncate, _
  612.                                 Optional ByVal FillMethod As FillTypeConstants = fillArithmetic_HighBit) As Boolean
  613.                                 
  614.     ' function modifies passed Byte by shifting the bits n times to the right
  615.     ' Equivalent to C++:  >>n
  616.     Dim tValue As Byte, tWrap As Byte
  617.     
  618.     If Iterations < 1& Then
  619.         ShiftBitsRight_Byte = (Iterations = 1&)
  620.         Exit Function
  621.     End If
  622.     If WrapOption = bitShift_Wrap Then
  623.         Iterations = Iterations Mod BitCount_Byte
  624.         If (Iterations And 7) Then
  625.             ' we will cache the bits from the bit just right of the bit being shifted to the lowest bit
  626.             ' this cache will then wrap to the far left
  627.             If ((theValue And mPO2lut(Iterations - 1&))) Then
  628.                 tWrap = (theValue And (mPO2lut(Iterations - 1&) - 1&)) * mPO2lut(BitCount_Byte - Iterations) Or MaskHighBit_Byte
  629.             Else
  630.                 tWrap = (theValue And (mPO2lut(Iterations) - 1&)) * mPO2lut(BitCount_Byte - Iterations)
  631.             End If
  632.             ' we then shift the non-wrap bytes to the right
  633.             tValue = (theValue \ mPO2lut(Iterations)) Or tWrap
  634.             If (theValue And MaskHighBit_Byte) Then theValue = tValue Or mPO2lut(BitCount_Byte - Iterations - 1&) Else theValue = tValue
  635.         End If
  636.     Else
  637.         If Iterations \ BitCount_Byte Then ' all bits were shifted out of the value
  638.             If FillMethod = fillOnes_Logical Then theValue = &HFF Else theValue = 0
  639.         Else
  640.             If FillMethod = fillOnes_Logical Then
  641.                 tValue = theValue \ mPO2lut(Iterations) Or (&HFF Xor (mPO2lut(BitCount_Byte - Iterations) - 1&))
  642.             Else
  643.                 tValue = theValue \ mPO2lut(Iterations)
  644.             End If
  645.             If (theValue And MaskHighBit_Byte) Then theValue = tValue Or mPO2lut(BitCount_Byte - Iterations - 1&) Else theValue = tValue
  646.         End If
  647.     End If
  648.     ShiftBitsRight_Byte = True
  649. End Function
  650.  
  651. Public Function ShiftBitsRight_Integer(theValue As Integer, Optional ByVal Iterations As Long = 1&, _
  652.                                 Optional ByVal WrapOption As BitShiftWrapEnum = bitShift_Truncate, _
  653.                                 Optional ByVal FillMethod As FillTypeConstants = fillArithmetic_HighBit) As Boolean
  654.                                 
  655.     ' function modifies passed Integer by shifting the bits n times to the right
  656.     ' Equivalent to C++:  >>n
  657.     Dim tValue As Integer, tWrap As Integer
  658.     
  659.     ' Note per MSDN documentation: http://msdn.microsoft.com/en-us/library/b6ex274z(VS.71).aspx
  660.     ' When shifting right, by default, any new bits coming in from the left are 0 if value is positive, else 1
  661.     ' This makes sense: shifting right is equivalent of dividing by a positive number and
  662.     '   when dividing a negative by positive, the result is negative (high bit is set)
  663.     '   when dividing a positive by positive, the result is positive (high bit is not set)
  664.     ' The FillMethod passed can override this behavior
  665.     
  666.     If Iterations < 1& Then
  667.         ShiftBitsRight_Integer = (Iterations = 0&)
  668.         Exit Function
  669.     End If
  670.     If WrapOption = bitShift_Wrap Then
  671.         Iterations = Iterations Mod BitCount_Int
  672.         If (Iterations And 15) Then
  673.             ' we will cache the bits from the bit just right of the bit being shifted to the lowest bit
  674.             ' this cache will then wrap to the far left
  675.             If (theValue And mPO2lut(Iterations - 1&)) Then
  676.                 tWrap = (theValue And (mPO2lut(Iterations - 1&) - 1&)) * mPO2lut(BitCount_Int - Iterations) Or MaskHighBit_Int
  677.             Else
  678.                 tWrap = (theValue And (mPO2lut(Iterations) - 1&)) * mPO2lut(BitCount_Int - Iterations)
  679.             End If
  680.             ' we then shift the non-wrap bytes to the right
  681.             tValue = ((theValue And &HFFFF&) \ mPO2lut(Iterations)) Or tWrap
  682.             If (theValue And MaskHighBit_Int) Then theValue = tValue Or mPO2lut(BitCount_Int - Iterations - 1&) Else theValue = tValue
  683.         End If
  684.     Else
  685.         If Iterations \ BitCount_Int Then ' all bits shifted out
  686.             If FillMethod = fillOnes_Logical Then theValue = &HFFFF Else theValue = &H0
  687.         Else
  688.             If FillMethod = fillArithmetic_HighBit Then
  689.                 theValue = theValue \ mPO2lut(Iterations)
  690.             Else
  691.                 If FillMethod = fillOnes_Logical Then
  692.                     tValue = ((theValue And Not MaskHighBit_Int) \ mPO2lut(Iterations)) Or (&HFFFF Xor (mPO2lut(BitCount_Int - Iterations) - 1))
  693.                 Else
  694.                     tValue = ((theValue And Not MaskHighBit_Int) \ mPO2lut(Iterations))
  695.                 End If
  696.                 If (theValue And MaskHighBit_Int) Then theValue = tValue Or mPO2lut(BitCount_Int - Iterations - 1) Else theValue = tValue
  697.             End If
  698.         End If
  699.     End If
  700.     ShiftBitsRight_Integer = True
  701. End Function
  702.  
  703. Public Function ShiftBitsRight_Long(theValue As Long, Optional ByVal Iterations As Long = 1&, _
  704.                                 Optional ByVal WrapOption As BitShiftWrapEnum = bitShift_Truncate, _
  705.                                 Optional ByVal FillMethod As FillTypeConstants = fillArithmetic_HighBit) As Boolean
  706.                                 
  707.     ' function modifies passed Long by shifting the bits n times to the right
  708.     ' Equivalent to C++:  >>n
  709.     
  710.     ' Note per MSDN documentation: http://msdn.microsoft.com/en-us/library/b6ex274z(VS.71).aspx
  711.     ' When shifting right, by default, any new bits coming in from the left are 0 if value is positive, else 1
  712.     ' This makes sense: shifting right is equivalent of dividing by a positive number and
  713.     '   when dividing a negative by positive, the result is negative (high bit is set)
  714.     '   when dividing a positive by positive, the result is positive (high bit is not set)
  715.     ' The FillMethod passed can override this behavior
  716.     
  717.     Dim tValue As Long, tWrap As Long
  718.     If Iterations < 1& Then
  719.         ShiftBitsRight_Long = (Iterations = 0&)
  720.         Exit Function
  721.     End If
  722.     If WrapOption = bitShift_Wrap Then
  723.         Iterations = Iterations Mod BitCount_Long
  724.         If (Iterations And 31&) Then
  725.             ' we will cache the bits from the bit just right of the bit being shifted to the lowest bit
  726.             ' this cache will then wrap to the far left
  727.             If (theValue And mPO2lut(Iterations - 1&)) Then
  728.                 tWrap = (theValue And (mPO2lut(Iterations - 1&) - 1&)) * mPO2lut(BitCount_Long - Iterations) Or MaskHighBit_Long
  729.             Else
  730.                 tWrap = (theValue And (mPO2lut(Iterations) - 1&)) * mPO2lut(BitCount_Long - Iterations)
  731.             End If
  732.             ' we then shift the non-wrap bytes to the right
  733.             If Iterations = 31& Then
  734.                 tValue = tWrap
  735.             Else
  736.                 tValue = ((theValue And &H7FFFFFFF) \ mPO2lut(Iterations)) Or tWrap
  737.             End If
  738.             If (theValue And MaskHighBit_Long) Then theValue = tValue Or mPO2lut(BitCount_Long - Iterations - 1&) Else theValue = tValue
  739.         End If
  740.     Else
  741.         If Iterations \ BitCount_Long Then ' all bits are shifted out
  742.             If FillMethod = fillOnes_Logical Then theValue = &HFFFFFFFF Else theValue = &H0&
  743.         Else
  744.             If FillMethod = fillArithmetic_HighBit Then
  745.                 theValue = theValue \ mPO2lut(Iterations)
  746.             Else
  747.                 If FillMethod = fillOnes_Logical Then
  748.                     tValue = ((theValue And Not MaskHighBit_Long) \ mPO2lut(Iterations)) Or (&HFFFFFFFF Xor (mPO2lut(BitCount_Long - Iterations) - 1))
  749.                 Else
  750.                     tValue = ((theValue And Not MaskHighBit_Long) \ mPO2lut(Iterations))
  751.                 End If
  752.                 If (theValue And MaskHighBit_Long) Then theValue = tValue Or mPO2lut(BitCount_Long - Iterations - 1) Else theValue = tValue
  753.             End If
  754.         End If
  755.     End If
  756.     ShiftBitsRight_Long = True
  757. End Function
  758.  
  759. Public Function BytesToBitString(theValue As Variant) As String
  760.     ' Function converts byte, integer, long to a bit string
  761.     ' String length is equal to bit count of the passed variable
  762.     Dim b As Integer, bitLen As Long, tValue As Long, HighBitMask As Long
  763.     Const bitOn As String = "1"
  764.     Const bitOff As String = "0"
  765.     
  766.     If GetVarTypeProperties(theValue, bitLen, HighBitMask) = 0& Then Exit Function
  767.     
  768.     tValue = (theValue And Not HighBitMask)
  769.     BytesToBitString = String$(bitLen, bitOff)
  770.     For b = 0 To bitLen - 2
  771.         If ((tValue \ mPO2lut(b)) And 1) Then Mid$(BytesToBitString, bitLen - b, 1) = bitOn
  772.     Next
  773.     If (theValue And HighBitMask) Then Mid$(BytesToBitString, 1, 1) = bitOn
  774. End Function
  775.  
  776. Public Function ByteArrayToBitString(theArray() As Byte) As String
  777.     ' String length is equal to array size
  778.     Dim b As Integer, c As Long, cPos As Long
  779.     Const bitOn As String = "1"
  780.     Const bitOff As String = "0"
  781.     
  782.     b = Abs(UBound(theArray) - LBound(theArray)) + 1
  783.     ByteArrayToBitString = String$(b * BitCount_Byte, bitOff)
  784.     
  785.     For b = UBound(theArray) To LBound(theArray) Step -1
  786.         For c = 0 To BitCount_Byte - 1
  787.             If (theArray(b) \ mPO2lut(c) And 1) Then Mid$(ByteArrayToBitString, cPos + BitCount_Byte - c, 1) = bitOn
  788.         Next
  789.         cPos = cPos + BitCount_Byte
  790.     Next
  791.  
  792. End Function
  793.  
  794. Public Function StringToBytes(ByVal theBitString As String) As Variant
  795.     ' Function converts bit string to a byte, integer or long
  796.     ' The size of the string determines the variable type returned
  797.     
  798.     Dim rtnByte As Byte, rtnInteger As Integer, rtnLong As Long
  799.     Dim b As Long, bitLen As Long, strLen As Long, strStart As Long
  800.     Const bitOn As String = "1"
  801.     
  802.     strLen = Len(theBitString)
  803.     Select Case strLen
  804.         Case 0
  805.         Case Is < 9 ' allow some flexibility
  806.             bitLen = BitCount_Byte: strStart = 1&
  807.             If bitLen > strLen Then b = strLen + 1& Else b = bitLen
  808.         Case Is < 17 ' allow some flexibility
  809.             bitLen = BitCount_Int: strStart = 1&
  810.             If bitLen > strLen Then b = strLen + 1& Else b = bitLen
  811.         Case Is < 33 ' allow some flexibility
  812.             bitLen = BitCount_Long: strStart = 1&
  813.             If bitLen > strLen Then b = strLen + 1 Else b = bitLen
  814.         Case Else ' > 33, only use the first 32 characters
  815.             bitLen = BitCount_Long: strStart = strLen - 31&: b = bitLen
  816.     End Select
  817.     
  818.     If strLen Then
  819.         For b = 0 To b - 2& ' extract bits from string, right to left
  820.             If Mid$(theBitString, strLen - b, 1) = bitOn Then rtnLong = rtnLong Or mPO2lut(b)
  821.         Next
  822.         ' now set the high bit and the return variant type
  823.         Select Case bitLen
  824.         Case BitCount_Long ' long
  825.             If strLen >= bitLen Then
  826.                 If Mid$(theBitString, strStart, 1) = bitOn Then rtnLong = rtnLong Or MaskHighBit_Long
  827.             End If
  828.             StringToBytes = rtnLong
  829.         Case BitCount_Int ' integer
  830.             rtnInteger = rtnLong
  831.             If strLen >= bitLen Then
  832.                 If Mid$(theBitString, strStart, 1) = bitOn Then rtnInteger = rtnLong Or MaskHighBit_Int
  833.             End If
  834.             StringToBytes = rtnInteger
  835.         Case Else ' byte
  836.             rtnByte = rtnLong
  837.             If strLen >= bitLen Then
  838.                 If Mid$(theBitString, strStart, 1) = bitOn Then rtnByte = rtnLong Or MaskHighBit_Byte
  839.             End If
  840.             StringToBytes = rtnByte
  841.         End Select
  842.     Else
  843.         theBitString = rtnLong
  844.     End If
  845. End Function
  846.  
  847. Public Function CreateBitMask(ByVal fromBit0to31 As Byte, ByVal MaskLength0to31 As Byte) As Long
  848.     ' returns a bit mask
  849.     Dim theMask As Long, bBit As Byte
  850.     If fromBit0to31 < BitCount_Long Then
  851.         If fromBit0to31 + MaskLength0to31 > BitCount_Long Then MaskLength0to31 = BitCount_Long - fromBit0to31
  852.         ' overflow check
  853.         If fromBit0to31 + MaskLength0to31 = BitCount_Long Then
  854.             If fromBit0to31 <> 31& Then                         ' else only setting the high bit
  855.                 For bBit = fromBit0to31 To BitCount_Long - 2&   ' create mask, append high bit mask afterwards
  856.                     theMask = theMask Or mPO2lut(bBit)
  857.                 Next
  858.             End If
  859.             theMask = theMask Or MaskHighBit_Long
  860.         Else ' no overflow potential, create mask
  861.             For bBit = fromBit0to31 To fromBit0to31 + MaskLength0to31 - 1&
  862.                 theMask = theMask Or mPO2lut(bBit)
  863.             Next
  864.         End If
  865.         CreateBitMask = theMask
  866.     End If
  867.  
  868. End Function
  869.  
  870. Public Function SwapEndian_Long(ByVal theValue As Long) As Long
  871.     ' funtion swaps the byte order for longs
  872.     ' i.e., &H12345678 becomes &H78563412
  873.     ' what is endian?  http://en.wikipedia.org/wiki/Endianness
  874.     SwapEndian_Long = _
  875.       (((theValue And &HFF000000) \ &H1000000) And &HFF&) Or _
  876.       ((theValue And &HFF0000) \ &H100&) Or _
  877.       ((theValue And &HFF00&) * &H100&) Or _
  878.       ((theValue And &H7F&) * &H1000000)
  879.     If (theValue And MaskHighBit_Byte) Then SwapEndian_Long = SwapEndian_Long Or MaskHighBit_Long
  880. End Function
  881. Public Function SwapEndian_Integer(ByVal theValue As Integer) As Integer
  882.     ' funtion swaps the byte order for integers
  883.     ' i.e., &H1234 becomes &H3412
  884.     ' what is endian?  http://en.wikipedia.org/wiki/Endianness
  885.     SwapEndian_Integer = _
  886.       (((theValue And &HFF00) \ &H100) And &HFF&) Or _
  887.       ((theValue And &H7F&) * &H100&)
  888.     If (theValue And MaskHighBit_Byte) Then SwapEndian_Integer = SwapEndian_Integer Or MaskHighBit_Int
  889. End Function
  890.  
  891. Public Function GetVarTypeProperties(theValue As Variant, Optional ByRef BitLength As Long, Optional ByRef HighBitMask As Long) As Long
  892.     ' helper function to determine passed variable type and the high bit associated with it
  893.     ' the return value will be the byte length of the variable: 1, 2, 4.
  894.     ' If return value is zero, the variable type is not handled by this class
  895.     Select Case (VarType(theValue) And Not vbArray)
  896.         Case vbLong:
  897.             BitLength = BitCount_Long
  898.             HighBitMask = MaskHighBit_Long
  899.         Case vbInteger
  900.             BitLength = BitCount_Int
  901.             HighBitMask = MaskHighBit_Int
  902.         Case vbByte
  903.             BitLength = BitCount_Byte
  904.             HighBitMask = MaskHighBit_Byte
  905.         Case Else
  906.             BitLength = 0&
  907.             HighBitMask = 0&
  908.     End Select
  909.     GetVarTypeProperties = BitLength \ BitCount_Byte
  910. End Function
  911.  
  912. Public Function CRC32_String(theString As String, Optional ByVal CurrentCRC32Value As Long = &HFFFFFFFF, _
  913.                                 Optional StringType As StringTypeConstants = crcANSI) As Long
  914.     
  915.     ' CurrentCRC32Value can be passed if using CRC32 on multiple strings or
  916.     ' portions of strings (i.e., loading a file)
  917.     '  Open myFile For Input As #1
  918.     '  Do Until EOF(1)
  919.     '     Line Input #1, someText
  920.     '     crc32 = classname.CRC32_String(someText, crc32, crcANSI)
  921.     '  Loop
  922.     '  Close #1
  923.     
  924.     If CRC32LUTbuilt = False Then CreateCRC32LookupTable
  925.     
  926.     Dim i As Long, iStep As Long
  927.     Dim iLookup As Long
  928.     Dim tSA As SafeArray, Buffer() As Byte
  929.  
  930.     If Not theString = vbNullString Then
  931.         ' use an array overlay for faster results
  932.         ' by doing so, don't have read the string into an array :: StrConv()
  933.         With tSA
  934.             .cbElements = 1
  935.             .cDims = 1
  936.             .pvData = StrPtr(theString)
  937.             .rgSABound(0).cElements = LenB(theString) ' can use Len(theString)*2
  938.             .rgSABound(0).lLbound = 1
  939.         End With
  940.         CopyMemory ByVal VarPtrArray(Buffer), VarPtr(tSA), 4&
  941.         If StringType = crcUnicode Then iStep = 1 Else iStep = 2
  942.         
  943.         For i = 1 To tSA.rgSABound(0).cElements Step iStep
  944.             iLookup = (CurrentCRC32Value And &HFF) Xor Buffer(i)
  945.             CurrentCRC32Value = ((CurrentCRC32Value And &HFFFFFF00) \ &H100) And &HFFFFFF
  946.             CurrentCRC32Value = CurrentCRC32Value Xor CRC32LUT(iLookup)
  947.         Next i
  948.         CopyMemory ByVal VarPtrArray(Buffer), 0&, 4&
  949.         
  950.         CRC32_String = Not (CurrentCRC32Value)
  951.     End If
  952.     
  953.     
  954. End Function
  955.  
  956. Public Function CRC32_LongArray(theArray() As Long, Optional ByVal CurrentCRC32Value As Long = &HFFFFFFFF) As Long
  957.     
  958.     ' CurrentCRC32Value can be passed if using CRC32 on multiple arrays
  959.     ' 1 or 2 dimensional arrays only, are supported
  960.     ' Max supported single array elements are (2^31-1)\4 (536870911)
  961.     
  962.     Dim tSA As SafeArray, Buffer() As Byte
  963.     Dim Looper As Long
  964.     
  965.     ' we will overlay the array with another array to guarantee LBound=0 & byte vs Integer representation
  966.     On Error GoTo ExitRoutine
  967.     tSA.cDims = ArrayProps(VarPtrArray(theArray))
  968.     If (tSA.cDims = 1 Or tSA.cDims = 2) Then ' 1 or 2 dimensional array
  969.         With tSA
  970.             .cbElements = 1
  971.             If tSA.cDims = 2 Then
  972.                 .rgSABound(0).cElements = (Abs(UBound(theArray, 2) - LBound(theArray, 2)) + 1) * 4&
  973.                 .rgSABound(1).cElements = Abs(UBound(theArray, 1) - LBound(theArray, 1)) + 1
  974.                 .pvData = VarPtr(theArray(LBound(theArray, 1), LBound(theArray, 2)))
  975.             Else
  976.                 .rgSABound(0).cElements = (Abs(UBound(theArray) - LBound(theArray)) + 1) * 4&
  977.                 .pvData = VarPtr(theArray(LBound(theArray)))
  978.             End If
  979.         End With
  980.         CopyMemory ByVal VarPtrArray(Buffer), VarPtr(tSA), 4&
  981.         CRC32_LongArray = CRCArray(Buffer, CurrentCRC32Value, (tSA.cDims = 2))
  982.         CopyMemory ByVal VarPtrArray(Buffer), 0&, 4&
  983.         tSA.pvData = 0&
  984.     End If
  985. ExitRoutine:
  986.     If Err Then Err.Clear
  987.     ' only potential error is > 536870911 elements in one of the dimensions
  988.     If tSA.pvData Then CopyMemory ByVal VarPtrArray(Buffer), 0&, 4&
  989.  
  990. End Function
  991.  
  992. Public Function CRC32_IntegerArray(theArray() As Integer, Optional ByVal CurrentCRC32Value As Long = &HFFFFFFFF) As Long
  993.     
  994.     ' CurrentCRC32Value can be passed if using CRC32 on multiple arrays
  995.     ' 1 or 2 dimensional arrays only, are supported
  996.     ' Max supported single array elements are (2^31-1)\2 (1073741823)
  997.     
  998.     Dim tSA As SafeArray, Buffer() As Byte
  999.     Dim Looper As Long
  1000.     
  1001.     ' we will overlay the array with another array to guarantee LBound=0 & byte vs Integer representation
  1002.     On Error GoTo ExitRoutine
  1003.     tSA.cDims = ArrayProps(VarPtrArray(theArray))
  1004.     If (tSA.cDims = 1 Or tSA.cDims = 2) Then ' 1 or 2 dimensional array
  1005.         With tSA
  1006.             .cbElements = 1
  1007.             If tSA.cDims = 2 Then
  1008.                 .rgSABound(0).cElements = (Abs(UBound(theArray, 2) - LBound(theArray, 2)) + 1) * 2&
  1009.                 .rgSABound(1).cElements = Abs(UBound(theArray, 1) - LBound(theArray, 1)) + 1
  1010.                 .pvData = VarPtr(theArray(LBound(theArray, 1), LBound(theArray, 2)))
  1011.             Else
  1012.                 .rgSABound(0).cElements = (Abs(UBound(theArray) - LBound(theArray)) + 1) * 2&
  1013.                 .pvData = VarPtr(theArray(LBound(theArray)))
  1014.             End If
  1015.         End With
  1016.         CopyMemory ByVal VarPtrArray(Buffer), VarPtr(tSA), 4&
  1017.         CRC32_IntegerArray = CRCArray(Buffer, CurrentCRC32Value, (tSA.cDims = 2))
  1018.         CopyMemory ByVal VarPtrArray(Buffer), 0&, 4&
  1019.         tSA.pvData = 0&
  1020.     End If
  1021. ExitRoutine:
  1022.     If Err Then Err.Clear
  1023.     ' only potential error is > 1073741823 elements in one of the dimensions
  1024.     If tSA.pvData Then CopyMemory ByVal VarPtrArray(Buffer), 0&, 4&
  1025. End Function
  1026.  
  1027. Public Function CRC32_ByteArray(theArray() As Byte, Optional ByVal CurrentCRC32Value As Long = &HFFFFFFFF) As Long
  1028.     
  1029.     ' CurrentCRC32Value can be passed if using CRC32 on multiple arrays
  1030.     ' 1 or 2 dimensional arrays only, are supported
  1031.     ' Binary arrays are best used when an entire file is loaded into memory
  1032.     Dim tSA As SafeArray, Buffer() As Byte
  1033.     
  1034.     ' we will overlay the array with another array to guarantee LBound=0 if needed
  1035.     tSA.cDims = ArrayProps(VarPtrArray(theArray))
  1036.     If tSA.cDims = 1 Then
  1037.         If LBound(theArray) = 0 Then
  1038.             CRC32_ByteArray = CRCArray(theArray, CurrentCRC32Value, False)
  1039.         Else
  1040.             With tSA
  1041.                 .cbElements = 1
  1042.                 .pvData = VarPtr(theArray(LBound(theArray)))
  1043.                 .rgSABound(0).cElements = Abs(UBound(theArray) - LBound(theArray)) + 1
  1044.             End With
  1045.             CopyMemory ByVal VarPtrArray(Buffer), VarPtr(tSA), 4&
  1046.             CRC32_ByteArray = CRCArray(Buffer, CurrentCRC32Value, False)
  1047.             CopyMemory ByVal VarPtrArray(Buffer), 0&, 4&
  1048.         End If
  1049.     ElseIf tSA.cDims = 2 Then
  1050.         If LBound(theArray, 2) = 0 And LBound(theArray, 1) = 0 Then
  1051.             CRC32_ByteArray = CRCArray(theArray, CurrentCRC32Value, True)
  1052.         Else
  1053.             With tSA
  1054.                 .cbElements = 1
  1055.                 .pvData = VarPtr(theArray(LBound(theArray, 1), LBound(theArray, 2)))
  1056.                 .rgSABound(0).cElements = Abs(UBound(theArray, 2) - LBound(theArray, 2)) + 1
  1057.                 .rgSABound(1).cElements = Abs(UBound(theArray, 1) - LBound(theArray, 1)) + 1
  1058.             End With
  1059.             CopyMemory ByVal VarPtrArray(Buffer), VarPtr(tSA), 4&
  1060.             CRC32_ByteArray = CRCArray(Buffer, CurrentCRC32Value, True)
  1061.             CopyMemory ByVal VarPtrArray(Buffer), 0&, 4&
  1062.         End If
  1063.     End If
  1064.     
  1065. End Function
  1066.  
  1067. Private Function CRCArray(theArray() As Byte, CurrentCRC32Value As Long, b2DArray As Boolean) As Long
  1068.  
  1069.     ' helper function which process byte, integer, long arrays
  1070.     ' Note: The function cannot be passed a null array. This is
  1071.     '   checked before this function is called
  1072.     
  1073.     If CRC32LUTbuilt = False Then CreateCRC32LookupTable
  1074.     
  1075.     Dim i As Long, j As Long, lb As Long, ub As Long
  1076.     Dim iLookup As Long
  1077.     
  1078.     If b2DArray Then
  1079.         lb = LBound(theArray, 1): ub = UBound(theArray, 1)
  1080.         For i = LBound(theArray, 2) To UBound(theArray, 2)
  1081.             For j = lb To ub
  1082.                 iLookup = (CurrentCRC32Value And &HFF) Xor theArray(j, i)
  1083.                 CurrentCRC32Value = ((CurrentCRC32Value And &HFFFFFF00) \ &H100) And &HFFFFFF
  1084.                 CurrentCRC32Value = CurrentCRC32Value Xor CRC32LUT(iLookup)
  1085.             Next j
  1086.         Next i
  1087.     Else    ' single dimensional array
  1088.         For i = LBound(theArray) To UBound(theArray)
  1089.             iLookup = (CurrentCRC32Value And &HFF) Xor theArray(i)
  1090.             CurrentCRC32Value = ((CurrentCRC32Value And &HFFFFFF00) \ &H100) And &HFFFFFF
  1091.             CurrentCRC32Value = CurrentCRC32Value Xor CRC32LUT(iLookup)
  1092.         Next i
  1093.     End If
  1094.     CRCArray = Not (CurrentCRC32Value)
  1095.  
  1096. End Function
  1097.  
  1098. Public Sub CreateCRC32LookupTable(Optional ByVal CRCpolynomial As Long = &HEDB88320)
  1099.     ' Optional function call. If you want to use your own Polynomial, then
  1100.     ' call this before calling any of the CRC32_xxxx functions
  1101.     
  1102.     ' &HEDB88320 is the official polynomial used by CRC32 in PKZip.
  1103.     ' Often the polynomial is shown reversed (04C11DB7).
  1104.     Dim i As Long, j As Long
  1105.  
  1106.     ReDim CRC32LUT(0 To 255)
  1107.     Dim dwCrc As Long
  1108.  
  1109.     For i = 0 To 255
  1110.         dwCrc = i
  1111.         For j = 8 To 1 Step -1
  1112.             If (dwCrc And 1) > 0 Then
  1113.                 dwCrc = ((dwCrc And &HFFFFFFFE) \ 2) And &H7FFFFFFF
  1114.                 dwCrc = dwCrc Xor CRCpolynomial
  1115.             Else
  1116.                 dwCrc = ((dwCrc And &HFFFFFFFE) \ 2) And &H7FFFFFFF
  1117.             End If
  1118.         Next j
  1119.         CRC32LUT(i) = dwCrc
  1120.     Next i
  1121.     CRC32LUTbuilt = True
  1122. End Sub
  1123.  
  1124. Public Sub DestroyCRC32LookupTable()
  1125.     ' can be called if you want to free up memory else the
  1126.     ' 256 element array is only destroyed when the class is destroyed
  1127.     Erase CRC32LUT
  1128.     CRC32LUTbuilt = False
  1129. End Sub
  1130.  
  1131. Public Function ShiftBitsLeft_ByteArray(theArray() As Byte, ByVal Iterations As Long, _
  1132.                                 Optional ByVal WrapOption As BitShiftWrapEnum = bitShift_Truncate, _
  1133.                                 Optional ByVal FillMethod As FillTypeConstants = fillArithmetic_HighBit) As Boolean
  1134.  
  1135.     ' Function shift an entire array of bytes and is very quick. Only supports single dimensional arrays
  1136.     ' If you need to do shifting for crypto reasons or shifting Doubles, Singles, etc, this can be for you.
  1137.     ' Simply put whatever you want into a byte array and pass it to this function (CopyMemory)
  1138.     
  1139.     ' by using a CarryOver value, we can literally shift thousands of bits and not be
  1140.     ' limited to just 32.  Additionally, there is no chance of overflows
  1141.     ' What is a carryover value?
  1142.     '   The carryover is the value that will fall off when shifting
  1143.     '   Then when we shift into the next byte, we cache that's byte carryover
  1144.     '       then add the previous carryover to the new byte after done shifting
  1145.     ' Logic:
  1146.     ' Starting: carryover1 set depending on wrap option, shift first byte
  1147.     ' Get next byte's carryover (high bits) & place in carryover2
  1148.     ' Shift next byte, and then add carryover1
  1149.     ' Place carryover2 into the carryover1 & continue to next byte
  1150.     ' As you can see below, we can shift n bits in n\8 loops
  1151.     
  1152.     ' Looks a bit complicated and it is. Wanted to handle iterations and wrapping
  1153.     ' as fast as I could, therefore some complicated memory manipulation
  1154.     
  1155.     Dim b As Long, carryFlag As Byte, carryFlag2 As Long
  1156.     Dim carryShift As Long, preserveMask As Long, preserveShift As Long
  1157.     Dim ub As Long, Offset8 As Long
  1158.     Dim tSA As SafeArray, theBytes() As Byte, Buffer() As Byte
  1159.     
  1160.     If Iterations < 1& Then 'check for invalid parameter
  1161.         ShiftBitsLeft_ByteArray = (Iterations = 0&)
  1162.         Exit Function
  1163.     End If
  1164.     If ArrayProps(VarPtrArray(theArray)) <> 1& Then Exit Function ' supports 1D arrays only
  1165.     
  1166.     ' set up masks and offset
  1167.     On Error GoTo ExitRoutine   ' error? If bit count calc throws an overflow error
  1168.     ub = Abs(UBound(theArray) - LBound(theArray)) ' calc UBound based off a zero-bound array
  1169.     b = (ub + 1) * BitCount_Byte                  ' calc total bits in the array
  1170.     On Error GoTo 0             ' stop error checking
  1171.     If Iterations >= b Then
  1172.         If WrapOption = bitShift_Truncate Then
  1173.             ' if shifting completely out of the array, then return a zeroized array
  1174.             If FillMethod = fillArithmetic_HighBit Then FillMethod = fillZeros_Logical
  1175.             FillMemory theArray(LBound(theArray)), ub + 1&, FillMethod * &HFF
  1176.             ShiftBitsLeft_ByteArray = True
  1177.             Exit Function
  1178.         End If
  1179.     End If
  1180.     Iterations = Iterations Mod b       ' get actual iterations
  1181.     If Iterations = 0& Then             ' can happen if user passed TotalBits*WholeNumber
  1182.         ShiftBitsLeft_ByteArray = True
  1183.         Exit Function
  1184.     End If
  1185.     Offset8 = Iterations \ BitCount_Byte  ' which byte will contain the 1st shifted bit?
  1186.     Iterations = Iterations Mod BitCount_Byte ' how many iterations within the byte are we going to do?
  1187.     ' calculate which bits will be shifted into the next byte & also the shift factor
  1188.     ' toBeShifted = (currentByte \ carryShift)
  1189.     carryShift = mPO2lut(BitCount_Byte - Iterations)
  1190.     ' calculate which far right bits will be kept and then shifted to the far left
  1191.     ' toBeKept = (currentByte And preserveMask) * preserveShift
  1192.     preserveMask = mPO2lut(BitCount_Byte - Iterations) - 1
  1193.     preserveShift = mPO2lut(Iterations)
  1194.     
  1195.     ' normalize array to single dimension, zero-lbound
  1196.     With tSA
  1197.         .cbElements = 1
  1198.         .cDims = 1
  1199.         .pvData = VarPtr(theArray(LBound(theArray)))
  1200.         .rgSABound(0).cElements = ub + 1&
  1201.     End With
  1202.     CopyMemory ByVal VarPtrArray(theBytes), VarPtr(tSA), 4&
  1203.     
  1204.     If WrapOption = bitShift_Wrap Then
  1205.         If Offset8 Then ' we will be BYTE wrapping from UBound() to LBound()
  1206.             ' use about 1/2 the array vs copying entire array (potential that array can be very large)
  1207.             If Offset8 < ub \ 2& + 1& Then  ' 3 steps to shift bytes
  1208.                 carryFlag = Offset8 - 1: ReDim Buffer(0 To carryFlag) ' determine how many bytes to cache
  1209.                 CopyMemory Buffer(0), theBytes(ub - carryFlag), carryFlag + 1& ' cache 0 to offset8
  1210.                 CopyMemory theBytes(Offset8), theBytes(0), ub - Offset8 + 1& ' move 0 to offset8
  1211.                 CopyMemory theBytes(0), Buffer(0), carryFlag + 1 ' move cache to 0
  1212.             Else                    ' 4 steps to shift bytes
  1213.                 carryFlag = ub - Offset8: ReDim Buffer(0 To carryFlag) ' determine how many bytes to cache
  1214.                 CopyMemory Buffer(0), theBytes(Offset8), carryFlag + 1& ' cache from offset8 to UBound
  1215.                 CopyMemory theBytes(Offset8), theBytes(0), carryFlag + 1& ' slide right side to bytes vacated by caching
  1216.                 CopyMemory theBytes(0), theBytes(carryFlag + 1&), ub - (carryFlag * 2 + 1&)
  1217.                 CopyMemory theBytes(ub - (carryFlag * 2& + 1&)), Buffer(0), carryFlag + 1& ' now place the cached bytes in the middle
  1218.             End If
  1219.             Offset8 = 0& ' loop will now start from LBound
  1220.         End If
  1221.         carryFlag = theBytes(ub) \ carryShift 'get carryover for last byte in array
  1222.     
  1223.     Else
  1224.         If FillMethod = fillArithmetic_HighBit Then FillMethod = fillZeros_Logical
  1225.         FillMethod = FillMethod * &HFF
  1226.         If Offset8 Then   ' do we need to shift any byes before we start?
  1227.             CopyMemory theBytes(Offset8), theBytes(0), (ub - Offset8 + 1&) ' shift 0 to the offset8 position
  1228.             FillMemory theBytes(0), Offset8, FillMethod ' zero out the far right bytes
  1229.         End If
  1230.         carryFlag = FillMethod \ carryShift
  1231.     End If
  1232.     If Iterations Then ' here is where we do the shifting from bit to bit, byte to byte
  1233.         For b = Offset8 To ub
  1234.             ' calculate the bits to be carried over to next byte
  1235.             carryFlag2 = theBytes(b) \ carryShift
  1236.             ' shift the preserve bits to the far left & append the previous byte's carryover
  1237.             theBytes(b) = (theBytes(b) And preserveMask) * preserveShift Or carryFlag
  1238.             ' set new carryover
  1239.             carryFlag = carryFlag2
  1240.         Next
  1241.     End If
  1242.     
  1243.     CopyMemory ByVal VarPtrArray(theBytes), 0&, 4&
  1244.     ShiftBitsLeft_ByteArray = True
  1245. ExitRoutine:
  1246. End Function
  1247.  
  1248.  
  1249. Public Function ShiftBitsRight_ByteArray(theArray() As Byte, ByVal Iterations As Long, _
  1250.                                 Optional ByVal WrapOption As BitShiftWrapEnum = bitShift_Truncate, _
  1251.                                 Optional ByVal FillMethod As FillTypeConstants = fillArithmetic_HighBit) As Boolean
  1252.  
  1253.     ' Function shift an entire array of bytes and is very quick. Only supports single dimensional arrays
  1254.     ' If you need to do shifting for crypto reasons or shifting Doubles, Singles, etc, this can be for you.
  1255.     ' Simply put whatever you want shifted into a byte array and pass it to this function
  1256.  
  1257.     Dim b As Long, carryFlag As Byte, carryFlag2 As Long
  1258.     Dim carryMask As Long, carryShift As Long
  1259.     Dim preserveMask As Long, preserveShift As Long
  1260.     Dim ub As Long, Offset8 As Long
  1261.     
  1262.     Dim tSA As SafeArray, theBytes() As Byte, Buffer() As Byte
  1263.     
  1264.     If Iterations < 1& Then 'check for invalid parameter
  1265.         ShiftBitsRight_ByteArray = (Iterations = 0&)
  1266.         Exit Function
  1267.     End If
  1268.     If ArrayProps(VarPtrArray(theArray)) <> 1& Then Exit Function ' supports 1D arrays only
  1269.     
  1270.     ' set up masks and offset
  1271.     On Error GoTo ExitRoutine   ' error? If bit count calc throws an overflow error
  1272.     ub = Abs(UBound(theArray) - LBound(theArray)) ' calc UBound based off a zero-bound array
  1273.     b = (ub + 1) * BitCount_Byte                  ' calc total bits in the array
  1274.     On Error GoTo 0             ' stop error checking
  1275.     If Iterations >= b Then
  1276.         If WrapOption = bitShift_Truncate Then
  1277.             ' if shifting completely out of the array, then return a zeroized array
  1278.             If FillMethod = fillArithmetic_HighBit Then FillMethod = fillZeros_Logical
  1279.             FillMemory theArray(LBound(theArray)), ub + 1&, FillMethod * &HFF
  1280.             ShiftBitsRight_ByteArray = True
  1281.             Exit Function
  1282.         End If
  1283.     End If
  1284.     Iterations = Iterations Mod b       ' get actual iterations
  1285.     If Iterations = 0& Then             ' can happen if user passed TotalBits*WholeNumber
  1286.         ShiftBitsRight_ByteArray = True
  1287.         Exit Function
  1288.     End If
  1289.     Offset8 = Iterations \ BitCount_Byte  ' which byte will contain the 1st shifted bit?
  1290.     Iterations = Iterations Mod BitCount_Byte ' how many iterations within the byte are we going to do?
  1291.     ' calculate which bits will be shifted into the next byte & also the shift factor
  1292.     ' toBeShifted = (currentByte And carryMask) \ carryShift
  1293.     carryMask = mPO2lut(Iterations) - 1
  1294.     carryShift = mPO2lut(BitCount_Byte - Iterations)
  1295.  
  1296.     ' calculate which far right bits will be kept and then shifted to the far left
  1297.     ' toBeKept = (currentByte And preserveMask) * preserveShift
  1298.     preserveShift = mPO2lut(Iterations)
  1299.     
  1300.     ' normalize array to single dimension, zero-lbound
  1301.     With tSA
  1302.         .cbElements = 1
  1303.         .cDims = 1
  1304.         .pvData = VarPtr(theArray(LBound(theArray)))
  1305.         .rgSABound(0).cElements = ub + 1&
  1306.     End With
  1307.     CopyMemory ByVal VarPtrArray(theBytes), VarPtr(tSA), 4&
  1308.     
  1309.     If WrapOption = bitShift_Wrap Then
  1310.         If Offset8 Then ' we will be BYTE wrapping from UBound() to LBound()
  1311.             ' use about 1/2 the array vs copying entire array (potential that array can be very large)
  1312.             If Offset8 < ub \ 2& + 1& Then ' 3 steps to shift bytes
  1313.                 carryFlag = Offset8 - 1: ReDim Buffer(0 To carryFlag) ' determine how many bytes to cache
  1314.                 CopyMemory Buffer(0), theBytes(ub - carryFlag), carryFlag + 1& ' cache 0 to offset8
  1315.                 CopyMemory theBytes(ub - carryFlag), theBytes(0), carryFlag + 1& ' move 0 to offset8
  1316.                 CopyMemory theBytes(0), theBytes(carryFlag + 1), ub - carryFlag * 2 - 1
  1317.                 CopyMemory theBytes(ub - carryFlag * 2 - 1), Buffer(0), carryFlag + 1  ' move cache to 0
  1318.             Else                    ' 4 steps to shift bytes
  1319.                 carryFlag = ub - Offset8: ReDim Buffer(0 To carryFlag) ' determine how many bytes to cache
  1320.                 CopyMemory Buffer(0), theBytes(ub - carryFlag), carryFlag + 1& ' cache from offset8 to UBound
  1321.                 CopyMemory theBytes(carryFlag + 1), theBytes(0), ub - carryFlag  ' slide right side to bytes vacated by caching
  1322.                 CopyMemory theBytes(0), Buffer(0), carryFlag + 1& ' now place the cached bytes in the middle
  1323.             End If
  1324.             Offset8 = 0& ' loop will now start from LBound
  1325.         End If
  1326.         carryFlag = (theBytes(0) And carryMask) * carryShift 'get carryover for last byte in array
  1327.     
  1328.     Else
  1329.         If FillMethod = fillArithmetic_HighBit Then
  1330.             If theBytes(ub) And MaskHighBit_Byte Then FillMethod = fillOnes_Logical Else FillMethod = fillZeros_Logical
  1331.         End If
  1332.         FillMethod = FillMethod * &HFF
  1333.         Offset8 = Iterations \ BitCount_Byte        ' which byte will the 1st bit be shifted to?
  1334.         If Offset8 Then                             ' do we need to shift any byes before we start?
  1335.             CopyMemory theBytes(0), theBytes(Offset8), (ub - Offset8 + 1) ' shift 0 to the offset8 position
  1336.             FillMemory theBytes(ub - Offset8 + 1), Offset8, FillMethod  ' zero out the far right bytes
  1337.         End If
  1338.         carryFlag = (FillMethod And carryMask) * carryShift
  1339.     End If
  1340.     If Iterations Then                      ' if the iterations were already completed, bug out
  1341.         For b = ub - Offset8 To 0 Step -1
  1342.             ' calculate the bits to be carried over to next byte
  1343.             carryFlag2 = (theBytes(b) And carryMask) * carryShift
  1344.             ' shift the preserve bits to the far left & append the previous byte's carryover
  1345.             theBytes(b) = (theBytes(b) \ preserveShift) Or carryFlag
  1346.             ' set new carryover
  1347.             carryFlag = carryFlag2
  1348.         Next
  1349.     End If
  1350.     
  1351.     CopyMemory ByVal VarPtrArray(theBytes), 0&, 4&
  1352.     ShiftBitsRight_ByteArray = True
  1353. ExitRoutine:
  1354. End Function
  1355.  
  1356.  
  1357. Private Function ArrayProps(ByVal arrayPtr As Long) As Long
  1358.  
  1359.     Dim tSA As SafeArray
  1360.     ' help function. Validates passed array is initialized and has 1 or 2 dimensions
  1361.     If arrayPtr Then
  1362.         CopyMemory arrayPtr, ByVal arrayPtr, 4&
  1363.         If arrayPtr Then    ' else uninitialized array
  1364.             CopyMemory ByVal VarPtr(tSA), ByVal arrayPtr, 16& ay
  1365.   6& ay
  1366.   6emory ByVal VarPeeeeeem, Bebylized array
  1367.       Tbug out     ' calc turn a ze            E1eeem, Bebylized ar lc tur, 16& ay
  1368. yMemoreu,narray
  1369.       T
  1370.  l
  1371.     DG\n mTruI tS3e        et
  1372.   Bebrn a tTmoreu  E1eeem, Bebylized ar lc tur, 16& ay
  1373. yMemoreu,narray
  1374.       T
  1375.  l
  1376.     DG\n mTruI tS3e 2  E1eeem, Bebyli, Bebyl    T
  1377.  loreu,nn             CurrentCRC32Value = ((CurrentCRC32VauI tS3e tFlag2.ruI tS   ns \ BitCount_Byte  ' which n mTruIalag), thlue =s2Vauv going to do?^sC32VauI tftrinte's carryovng
  1378.     ' Logic:
  1379.     ' StartingBo