Quantcast
Channel: VBForums - CodeBank - Visual Basic 6 and earlier
Viewing all articles
Browse latest Browse all 1530

Small Collection of RC6 Helper Methods

$
0
0
In case they are of use to anyone else, I'm posting a few small RC6 helper methods that I use quite frequently alongside my RC6 apps. Nothing earth shaking here, but these methods can help reduce some lines of code and some are useful for things like caching recordsets and collections.

I'll likely add more to this thread as I create them, and I'd also be happy to see any methods you've created in the comments.

Notes:

Rc6CollectionHash - Takes an RC6 cCollection object or cCollection.Content byte array and returns a Hash (SHA256 Lowercase Hex string by default, but Uppercase Hex and ByteArray results are possible via the optional p_HashAlgorithm and p_HashFormat parameters).

Rc6RecordsetHash - Takes an RC6 cRecordset object and returns a Hash (SHA256 Lowercase Hex string by default, but Uppercase Hex and ByteArray results are possible via the optional p_HashAlgorithm and p_HashFormat parameters). Note that the cRecordset object must have been create via an SQL SELECT statement.

LZMADeCompInplace - Takes a byte array that was previously compressed via an LZMAComp method, and swaps it out for decompressed data in-place.

LZMADeCompReturn - Takes a byte array that was previously compressed via an LZMAComp method, and returns the decompressed data as a byte array.

LZMACompInplace - Takes a byte array of data and compresses it using the LZMA algorithm, swapping out the decompressed data for the compressed data in-place.

LZMACompReturn - Takes a byte array of data and compresses it using the LZMA algorithm, returning the compressed data as a byte array.


Code:

Code:

Option Explicit

Public Enum e_HashAlgorithm
  hashalgo_SHA256
  hashalgo_SHA1
  hashalgo_SHA384
  hashalgo_SHA512
  hashalgo_MD5
End Enum

Public Enum e_HashFormat
  hashformat_HexLowerCase
  hashformat_HexUpperCase
  hashformat_ByteArray
End Enum

Public Function Rc6CollectionHash(p_CollectionOrContentBytes As Variant, _
                                  Optional ByVal p_HashAlgorithm As e_HashAlgorithm = hashalgo_SHA256, _
                                  Optional ByVal p_HashFormat As e_HashFormat = hashformat_HexLowerCase) As Variant
  ' Returns a Hash string/byte-array (dependent on the p_HashFormat parameter value)
  ' Defaults to returning a SHA256 lower-case hex string
 
  Const c_SepSize As Long = 12  ' This is the length of the unique sequence that separates RC6 collection items
 
  Dim la_Content() As Byte  ' cCollection content
  Dim la_ZeroMem(65) As Byte ' An empty array for zeroing out unique separator sequences
  Dim la_Sep() As Byte ' The unique separator sequence
  Dim l_HashAsHex As Boolean ' When true, we will return the hash as a Hex string. When false, a Byte Array will be returned
  Dim l_Ubound As Long
  Dim ii As Long
  Dim jj As Long
 
  If IsObject(p_CollectionOrContentBytes) Then
      ' We have a cCollection object, so get the content from the object
      la_Content = p_CollectionOrContentBytes.Content
 
  Else
      If VarType(p_CollectionOrContentBytes) = vbByte Or vbArray Then
        ' We have a byte array (presumanly cCollection content)
        la_Content = p_CollectionOrContentBytes
      Else
        ' We have junk, raise an error
        Err.Raise 5, , "Byte array or cCollection class required."
      End If
  End If
 
  ReDim la_Sep(c_SepSize - 1)
 
  ' The unique separator is stored at the end of the collection content
  ' So we will get it from there
  l_Ubound = UBound(la_Content) - (c_SepSize - 1)
  New_c.MemCopy VarPtr(la_Sep(0)), VarPtr(la_Content(l_Ubound)), c_SepSize
 
  ' Loop through the collection to find the unique identifier
  ' Zero out all unique identifiers so that Collections with exact matching key/value content
  ' will always return the same hash (since the unique separators have been removed).
  For ii = 0 To UBound(la_Content) - 67
      For jj = 0 To c_SepSize - 1
        If la_Content(ii + jj) <> la_Sep(jj) Then
            ' This is not a unique separator, so exit the loop
            Exit For
        End If
      Next jj
     
      If jj = c_SepSize Then
        ' The previous loop ran until the end, so we have found a unique separator.
        ' Zero it out so that it won't be part of our hash calculation
        New_c.MemCopy VarPtr(la_Content(ii)), VarPtr(la_ZeroMem(0)), c_SepSize + 4
       
        ii = ii + c_SepSize + 3 ' Jump over the separator + 4 bytes (we use +3 because we will i+1 at the Next loop point)
      End If
  Next ii
     
  ' Zero out record keeping stuff from the end of the content
  ' that can change between otherwise identical key/value content collections
  ' So that we always generate the same hash for the same key/value content
  New_c.MemCopy VarPtr(la_Content(UBound(la_Content) - 66)), VarPtr(la_ZeroMem(0)), 66
 
  ' Hash the key/value content
  l_HashAsHex = (p_HashFormat <> hashformat_ByteArray)
 
  Select Case p_HashAlgorithm
  Case hashalgo_SHA256
      Rc6CollectionHash = New_c.Crypt.SHA256(la_Content, l_HashAsHex)
     
  Case hashalgo_SHA1
      Rc6CollectionHash = New_c.Crypt.SHA1(la_Content, l_HashAsHex)
 
  Case hashalgo_SHA384
      Rc6CollectionHash = New_c.Crypt.SHA384(la_Content, l_HashAsHex)
 
  Case hashalgo_SHA512
      Rc6CollectionHash = New_c.Crypt.SHA512(la_Content, l_HashAsHex)
 
  Case hashalgo_MD5
      Rc6CollectionHash = New_c.Crypt.MD5(la_Content, l_HashAsHex)
 
  Case Else
      Err.Raise 5, , "Unknown hash type: " & p_HashAlgorithm
  End Select
 
  If p_HashFormat = hashformat_HexUpperCase Then
      Rc6CollectionHash = UCase$(Rc6CollectionHash)
  End If
End Function

Public Function Rc6RecordsetHash(po_Recordset As RC6.cRecordset, _
                                Optional ByVal p_HashAlgorithm As e_HashAlgorithm = hashalgo_SHA256, _
                                Optional ByVal p_HashFormat As e_HashFormat = hashformat_HexLowerCase) As Variant
  Dim la_Sql() As Byte ' SQL statement that produce the recordset
  Dim la_Content() As Byte  ' RS content to hash
  Dim l_HashAsHex As Boolean ' When true, we will return the hash as a Hex string. When false, a Byte Array will be returned
  Dim l_Start As Long  ' Start of hashable array data
  Dim l_Len As Long ' Length of hashable array data
 
  ' Find the SQL statement in the recordset content.
  ' The bytes after the SQL statement will produce identical hashes
  ' for indentical RS content selected by any SQL statement
 
  ' Special thanks to Olaf Schmidt for the idea to search the RS for the SQL statement
  ' and begin hashing from after that point in order to ensure identical RS content produces an identical hash value
 
  la_Sql = po_Recordset.SQL
  If UBound(la_Sql) = -1 Then
      Err.Raise 5, , "This method requires a recordset that was created by an SQL statement."
  End If
 
  la_Content = po_Recordset.Content
 
  l_Start = InStrB(1, la_Content, la_Sql) + UBound(la_Sql) + 1
  l_Len = (UBound(la_Content) + 1) - l_Start + 1
 
  ' Remove everything before and including the SQL statement from the content array
  New_c.MemCopy VarPtr(la_Content(0)), VarPtr(la_Content(l_Start - 1)), l_Len
  ReDim Preserve la_Content(l_Len - 1)
 
  ' Hash the remaing byte array content
  l_HashAsHex = (p_HashFormat <> hashformat_ByteArray)
 
  Select Case p_HashAlgorithm
  Case hashalgo_SHA256
      Rc6RecordsetHash = New_c.Crypt.SHA256(la_Content, l_HashAsHex)
     
  Case hashalgo_SHA1
      Rc6RecordsetHash = New_c.Crypt.SHA1(la_Content, l_HashAsHex)
 
  Case hashalgo_SHA384
      Rc6RecordsetHash = New_c.Crypt.SHA384(la_Content, l_HashAsHex)
 
  Case hashalgo_SHA512
      Rc6RecordsetHash = New_c.Crypt.SHA512(la_Content, l_HashAsHex)
 
  Case hashalgo_MD5
      Rc6RecordsetHash = New_c.Crypt.MD5(la_Content, l_HashAsHex)
 
  Case Else
      Err.Raise 5, , "Unknown hash type: " & p_HashAlgorithm
  End Select
 
  If p_HashFormat = hashformat_HexUpperCase Then
      Rc6RecordsetHash = UCase$(Rc6RecordsetHash)
  End If
End Function

' LZMAComp/Decomp Helpers to make it possible to use less code/dims in certain scenarios.
' The "Inplace" versions overwrite the passed byte array with the resulting compressed/decompressed byte array
' The "Return" versions return an appropriately compressed/decompressed byte array.

Public Sub LZMADeCompInplace(pa_CompressedBytes() As Byte)
  Dim la_DecompressedBytes() As Byte
 
  New_c.Crypt.LZMADeComp pa_CompressedBytes, la_DecompressedBytes
  pa_CompressedBytes = la_DecompressedBytes
End Sub

Public Function LZMADeCompReturn(pa_CompressedBytes() As Byte) As Byte()
  Dim la_DecompressedBytes() As Byte
 
  New_c.Crypt.LZMADeComp pa_CompressedBytes, la_DecompressedBytes
  LZMADeCompReturn = la_DecompressedBytes
End Function

Public Sub LZMACompInplace(pa_UncompressedBytes() As Byte, Optional ByVal Level_0to9 As Long = 4, Optional ByVal DictSizePowerOfTwo As Long = 4194304)
  Dim la_CompressedBytes() As Byte
 
  New_c.Crypt.LZMAComp pa_UncompressedBytes, la_CompressedBytes, Level_0to9, DictSizePowerOfTwo
  pa_UncompressedBytes = la_CompressedBytes
End Sub

Public Function LZMACompReturn(pa_UncompressedBytes() As Byte, Optional ByVal Level_0to9 As Long = 4, Optional ByVal DictSizePowerOfTwo As Long = 4194304) As Byte()
  Dim la_CompressedBytes() As Byte
 
  New_c.Crypt.LZMAComp pa_UncompressedBytes, la_CompressedBytes, Level_0to9, DictSizePowerOfTwo
  LZMACompReturn = la_CompressedBytes
End Function

Enjoy!

Viewing all articles
Browse latest Browse all 1530

Trending Articles



<script src="https://jsc.adskeeper.com/r/s/rssing.com.1596347.js" async> </script>