Attribute VB_Name = "modCompress"
Option Explicit
Option Compare Binary
Option Base 0


'=============================================================================================================
'
' modCompress Module
' ------------------
'
' Created By   : Kevin Wilson
'                http://www.TheVBZone.com   ( The VB Zone )
'                http://www.TheVBZone.net   ( The VB Zone .net )
'
' Last Update  : January 9, 2004
' Date Created : November 4, 2000
'
' VB Versions  : 5.0 / 6.0
'
' Requires     : ZLIB.DLL (Copyrightİ 1995-1998 Jean-loup Gailly & Mark Adler)
'                         (http://www.info-zip.org/pub/infozip/zlib/)
'
' Description  : This module was made to make it easy to access the power of zLib to compress and decompress
'                files, byte arrays, and strings (which they themselves are a special type of byte array) from
'                within Visual Basic.  Refer to each function for more details on the use of this module.
'
'=============================================================================================================
'
' LEGAL:
'
' You are free to use this code as long as you keep the above heading information intact and unchanged. Credit
' given where credit is due.  Also, it is not required, but it would be appreciated if you would mention
' somewhere in your compiled program that that your program makes use of code written and distributed by
' Kevin Wilson (www.TheVBZone.com).  Feel free to link to this code via your web site or articles.
'
' You may NOT take this code and pass it off as your own.  You may NOT distribute this code on your own server
' or web site.  You may NOT take code created by Kevin Wilson (www.TheVBZone.com) and use it to create products,
' utilities, or applications that directly compete with products, utilities, and applications created by Kevin
' Wilson, TheVBZone.com, or Wilson Media.  You may NOT take this code and sell it for profit without first
' obtaining the written consent of the author Kevin Wilson.
'
' These conditions are subject to change at the discretion of the owner Kevin Wilson at any time without
' warning or notice.  Copyrightİ by Kevin Wilson.  All rights reserved.
'
'=============================================================================================================



' Enumeration - zLib (v1.1.3) Compression Levels
Public Enum ZCompressLevels
   Z_NO_COMPRESSION = 0
   Z_BEST_SPEED = 1
   Z_BEST_COMPRESSION = 9
   Z_DEFAULT_COMPRESSION = (-1)
End Enum

' Constants - zLib (v1.1.3)
Private Const Z_NULL             As Long = 0
Private Const Z_PARTIAL_FLUSH    As Long = 1    ' Obselete - use Z_SYNC_FLUSH instead
Private Const Z_SYNC_FLUSH       As Long = 2
Private Const Z_FULL_FLUSH       As Long = 3
Private Const Z_FINISH           As Long = 4

' Constants - zLib (v1.1.3) Error Values
Private Const Z_OK               As Long = 0    ' No Error
Private Const Z_STREAM_END       As Long = 1    ' Data stream reached the end of the stream
Private Const Z_NEED_DICT        As Long = 2    ' A preset dictionary is needed
Private Const Z_ERRNO            As Long = (-1) ' A file system error has occured
Private Const Z_STREAM_ERROR     As Long = (-2) ' A function parameter is invalid *OR* The stream state was inconsistent
Private Const Z_DATA_ERROR       As Long = (-3) ' Input data was corrupted
Private Const Z_MEM_ERROR        As Long = (-4) ' Not enough memory
Private Const Z_BUF_ERROR        As Long = (-5) ' Not enough room in the output buffer
Private Const Z_VERSION_ERROR    As Long = (-6) ' The zlib library version is incompatible with the version assumed by the caller
Private Const Z_PROCESSING_ERROR As Long = 99

' Constants - zLib (v1.1.3) Compression strategy
Private Const Z_FILTERED         As Long = 1
Private Const Z_HUFFMAN_ONLY     As Long = 2
Private Const Z_DEFAULT_STRATEGY As Long = 0

' Constants - zLib (v1.1.3) Possible values of the data_type field
Private Const Z_BINARY           As Long = 0
Private Const Z_ASCII            As Long = 1
Private Const Z_UNKNOWN          As Long = 2

' Constants - zLib (v1.1.3) The deflate compression method (the only one supported in this version)
Private Const Z_DEFLATED         As Long = 8


'----------------------------------------------------------------------------------------------------------
'int compress2 (
'  Bytef       *dest,
'  uLongf      *destLen,
'  const Bytef *source,
'  uLong       sourceLen,
'  int         level
');
'ŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻ
' Compresses the source buffer into the destination buffer. The "level" parameter has the same meaning as
' in deflateInit. "sourceLen" is the byte length of the source buffer. Upon entry, "destLen" is the total
' size of the destination buffer, which must be at least 0.1% larger than sourceLen plus 12 bytes. Upon
' exit, "destLen" is the actual size of the compressed buffer.
'
' compress2 returns Z_OK if success, Z_MEM_ERROR if there was not enough memory, Z_BUF_ERROR if there was
' not enough room in the output buffer, Z_STREAM_ERROR if the level parameter is invalid.
'__________________________________________________________________________________________________________
Private Declare Function Compress Lib "ZLIB.DLL" Alias "compress2" (ByRef DestinationArray As Byte, ByRef DestLen As Long, ByRef SourceArray As Byte, ByVal SourceLen As Long, ByVal CompressionLevel As Long) As Long
'----------------------------------------------------------------------------------------------------------


'----------------------------------------------------------------------------------------------------------
'int uncompress (
'  Bytef        *dest,
'  uLongf       *destLen,
'  const Bytef  *source,
'  uLong        sourceLen
');
'ŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻ
' Decompresses the source buffer into the destination buffer. "sourceLen" is the byte length of the source
' buffer. Upon entry, "destLen" is the total size of the destination buffer, which must be large enough to
' hold the entire uncompressed data. (The size of the uncompressed data must have been saved previously by
' the compressor and transmitted to the decompressor by some mechanism outside the scope of this
' compression library.) Upon exit, destLen is the actual size of the compressed buffer.
'
' This function can be used to decompress a whole file at once if the input file is mmap'ed.
'
' uncompress returns Z_OK if success, Z_MEM_ERROR if there was not enough memory, Z_BUF_ERROR if there was
' not enough room in the output buffer, or Z_DATA_ERROR if the input data was corrupted.
'__________________________________________________________________________________________________________
Private Declare Function Uncompress Lib "ZLIB.DLL" Alias "uncompress" (ByRef DestinationArray As Byte, ByRef DestLen As Long, ByRef SourceArray As Byte, ByVal SourceLen As Long) As Long
'----------------------------------------------------------------------------------------------------------



'==========================================================================================================
'
' ZCompressByteArray
' ŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻ
' Purpose:
' --------
' This function takes a dynamic byte array (0 based) and compresses it to the specified compression level.
' This function can be used to compress strings, files, and anything else that can be broken down into a
' byte array.
'
' Parameters:             Use:
' ŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻ
' ArrayToCompress         The dynamically created 0-based byte array that is to be compressed.
' Return_Array            Recieves the result of the compression of the array.
' CompressionLevel        Optional. The level of compression that is to be applied to the byte array. The
'                         higher the compression, the longer it takes to compress the array.
' TagOriginalSize         Optional. If TRUE, the size of the original byte array is appended to the end of
'                         the resulting byte array.  This is highly recommended because it frees you from
'                         the worry of having to store the size of the original array... which is needed to
'                         decompress the resulting array.  If this parameter is set to TRUE, you *MUST* use
'                         the "ZDecompressByteArray" function with the "OriginalSize" parameter set to the
'                         default value of -1 to correctly decompress the array... otherwise the resulting
'                         array will be considered a "corrupt" compression and any attempt to decompress
'                         it will error out.
' Return_ErrorNum         Optional. If an error occurs, this returns the number of the error that occured.
' Return_ErrorSrc         Optional. If an error occurs, this returns the source of the error that occured.
' Return_ErrorDesc        Optional. If an error occurs, this returns the description of the error that occured.
'
' Return:
' -------
' Returns TRUE if the compression was successful.
' Returns FALSE if an error occured during compression.
'
'==========================================================================================================
Public Function ZCompressByteArray(ByRef ArrayToCompress() As Byte, _
                                   ByRef Return_Array() As Byte, _
                                   Optional ByVal CompressionLevel As ZCompressLevels = Z_BEST_COMPRESSION, _
                                   Optional ByVal TagOriginalSize As Boolean = True, _
                                   Optional ByRef Return_ErrorNum As Long = 0, _
                                   Optional ByRef Return_ErrorSrc As String = "", _
                                   Optional ByRef Return_ErrorDesc As String = "") As Boolean
On Error GoTo ErrorTrap
   
   Dim OrigSize  As String
   Dim ArrayLenS As Long
   Dim ArrayLenD As Long
   Dim CharCount As Long
   Dim MyCounter As Long
   
   ' Set default values
   Erase Return_Array
   Return_ErrorNum = 0
   Return_ErrorSrc = ""
   Return_ErrorDesc = ""
   
   ' Validate parameters
   Select Case CompressionLevel
      Case Z_BEST_COMPRESSION, Z_BEST_SPEED, Z_DEFAULT_COMPRESSION, Z_NO_COMPRESSION
         'DO NOTHING
      Case Else
         CompressionLevel = Z_BEST_COMPRESSION
   End Select
   
   ' Get the size of the source array
   ArrayLenS = UBound(ArrayToCompress) + 1
   If ArrayLenS = 0 Then
      ZCompressByteArray = True
      Exit Function
   End If
   
   ' Calculate the size of the desitnation buffer - (SourceLen * 0.001) + 12
   ArrayLenD = ArrayLenS + ((ArrayLenS * 0.001) + 15) ' Extra 3 bytes on the buffer avoids errors
   
   ' Clear the return array
   ReDim Return_Array(ArrayLenD) As Byte
   
   ' Call the API to compress the byte array
   Return_ErrorNum = Compress(Return_Array(0), ArrayLenD, ArrayToCompress(0), ArrayLenS, CompressionLevel)
   If Return_ErrorNum <> Z_OK Then
      Call Err.Raise(Return_ErrorNum, "ZCompressByteArray >> ZLIB.Compress()", GetErrorDescription(Return_ErrorNum))
   End If
   
   ' Redimention the resulting array to fit it's content
   If TagOriginalSize = False Then
      ReDim Preserve Return_Array(ArrayLenD - 1) As Byte
      
   ' Append the original size of the byte array to then end of the byte array.  This is used in the "ZDecompressByteArray" function to automatically get the original size of the array (MAX = 2.1GB : 2,147,483,647 bytes)
   Else
      If ArrayLenS > 2147483647 Then
         ReDim Preserve Return_Array(ArrayLenD - 1) As Byte
         Exit Function
      End If
      
      ' Get the tag to append to the end of the byte array
      OrigSize = CStr(ArrayLenS)
      OrigSize = OrigSize & String(11 - Len(OrigSize), vbNullChar)
      OrigSize = String(5, vbNullChar) & OrigSize
      
      ' Redimention the size of the return array to it's compressed size, plus 16 bytes which contains the original size of the byte array.
      ' TAG Format = <5 x NULL> <ORIG SIZE> <(10 - Len(<ORIG SIZE>)) x NULL> <1 x NULL TERMINATOR>
      ReDim Preserve Return_Array(ArrayLenD + 15) As Byte
      
      ' Add the original size to the end
      For MyCounter = ArrayLenD To ArrayLenD + 15
         CharCount = CharCount + 1
         Return_Array(MyCounter) = Asc(Mid(OrigSize, CharCount, 1))
      Next
   End If
   
   ZCompressByteArray = True
   Exit Function
   
ErrorTrap:
   
   Return_ErrorNum = Err.Number
   Return_ErrorSrc = Err.Source
   Return_ErrorDesc = Err.Description
   Err.Clear
   ZCompressByteArray = False
   
End Function

'==========================================================================================================
'
' ZDecompressByteArray
' ŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻ
' Purpose:
' --------
' This function takes a dynamic byte array (0 based) that was previously compressed using ZLIB.DLL and
' decompresses it back to it's original state.  This function can be used to decompress strings, files,
' and anything else that can be broken down into a byte array.
'
' Parameters:             Use:
' ŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻ
' ArrayToDecompress       The dynamically created 0-based byte array that was previously compressed with ZLIB.DLL
' Return_Array            Recieves the result of the decompression of the array.
' OriginalSize            Optional. If this parameter is set to anything but the default value of -1, it is
'                         assumed to be the size of the original byte array before it was compressed.  If the
'                         "ZCompressByteArray" function with the "TagOriginalSize" parameter set to TRUE is
'                         used to compress the array, this parameter must be left at the default value of -1
'                         or the specified array to decompressed will be considered "corrupted" and an error
'                         will occur.
' Return_ErrorNum         Optional. If an error occurs, this returns the number of the error that occured.
' Return_ErrorSrc         Optional. If an error occurs, this returns the source of the error that occured.
' Return_ErrorDesc        Optional. If an error occurs, this returns the description of the error that occured.
'
' Return:
' -------
' Returns TRUE if the compression was successful.
' Returns FALSE if an error occured during compression.
'
'==========================================================================================================
Public Function ZDecompressByteArray(ByRef ArrayToDecompress() As Byte, _
                                     ByRef Return_Array() As Byte, _
                                     Optional ByVal OriginalSize As Long = -1, _
                                     Optional ByRef Return_ErrorNum As Long = 0, _
                                     Optional ByRef Return_ErrorSrc As String = "", _
                                     Optional ByRef Return_ErrorDesc As String = "") As Boolean
On Error GoTo ErrorTrap
   
   Dim TestTag   As String
   Dim OrigSize  As String
   Dim ArrayLenS As Long
   Dim ArrayLenD As Long
   Dim MyCounter As Long
   
   ' Set default values
   Erase Return_Array
   Return_ErrorNum = 0
   Return_ErrorSrc = ""
   Return_ErrorDesc = ""
   
   ' Get the size of the source array
   ArrayLenS = UBound(ArrayToDecompress) + 1
   If ArrayLenS = 0 Then
      ZDecompressByteArray = True
      Exit Function
   End If
   
   ' Get the original array size from the value the user specified
   If OriginalSize <> -1 Then
      ArrayLenD = OriginalSize
      
   ' Get the original array size from the TAG value appended to the array by the "ZCompressByteArray" function
   Else
      For MyCounter = (ArrayLenS - 16) To ArrayLenS - 1
         TestTag = TestTag & Chr(CLng(ArrayToDecompress(MyCounter)))
      Next
      If Left(TestTag, 5) <> String(5, vbNullChar) Then
         Call Err.Raise(Z_PROCESSING_ERROR, "ZDecompressByteArray", "Compressed file appears to be invalid or corrupted")
      Else
         ' Get the original size from the tag value
         OrigSize = Right(TestTag, Len(TestTag) - 5)
         OrigSize = Left(OrigSize, InStr(OrigSize, vbNullChar) - 1)
         If IsNumeric(OrigSize) = False Then
            Call Err.Raise(Z_PROCESSING_ERROR, "ZDecompressByteArray", "Compressed file appears to be invalid or corrupted")
         Else
            ArrayLenD = CLng(OrigSize)
         End If
         
         ' Redimention the array to cut off the tag
         ReDim Preserve ArrayToDecompress(ArrayLenS - 17) As Byte
         ArrayLenS = ArrayLenS - 16
      End If
   End If
   
   ' Clear the return array
   ReDim Return_Array(ArrayLenD - 1) As Byte
   
   ' Decompress the byte array
   Return_ErrorNum = Uncompress(Return_Array(0), ArrayLenD, ArrayToDecompress(0), ArrayLenS)
   If Return_ErrorNum <> Z_OK Then
      Call Err.Raise(Return_ErrorNum, "ZCompressByteArray >> ZLIB.Uncompress()", GetErrorDescription(Return_ErrorNum))
   End If
   
   ZDecompressByteArray = True
   Exit Function
   
ErrorTrap:
   
   Return_ErrorNum = Err.Number
   Return_ErrorSrc = Err.Source
   Return_ErrorDesc = Err.Description
   Err.Clear
   ZDecompressByteArray = False
   
End Function

'==========================================================================================================
'
' ZCompressString
' ŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻ
' Purpose:
' --------
' This function takes the specified string, compresses it down to the specified compression level, and
' returns the resulting string.
'
' NOTE: The resulting string will more than likely NOT be a printable string.
'
' Parameters:             Use:
' ŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻ
' StringToCompress        The string that is to be compressed.
' Return_String           Recieves the result of the compression of the string.
' CompressionLevel        Optional. The level of compression that is to be applied to the byte array.
'                         The higher the compression, the longer it takes to compress the array.
' TagOriginalSize         Optional. If TRUE, the size of the original string is appended to the end of the
'                         resulting string.  This is highly recommended because it frees you from the worry
'                         of having to store the size of the original string... which is needed to
'                         decompress the resulting string. If this parameter is set to TRUE, you *MUST* use
'                         the "ZDecompressString" function with the "OriginalSize" parameter set to the
'                         default value of -1 to correctly decompress the string... otherwise the resulting
'                         string will be considered a "corrupt" compression and any attempt to decompress
'                         it will error out.
' Return_ErrorNum         Optional. If an error occurs, this returns the number of the error that occured.
' Return_ErrorSrc         Optional. If an error occurs, this returns the source of the error that occured.
' Return_ErrorDesc        Optional. If an error occurs, this returns the description of the error that occured.
'
' Return:
' -------
' Returns TRUE if the compression was successful.
' Returns FALSE if an error occured during compression.
'
'==========================================================================================================
Public Function ZCompressString(ByVal StringToCompress As String, _
                                ByRef Return_String As String, _
                                Optional ByVal CompressionLevel As ZCompressLevels = Z_BEST_COMPRESSION, _
                                Optional ByVal TagOriginalSize As Boolean = True, _
                                Optional ByRef Return_ErrorNum As Long = 0, _
                                Optional ByRef Return_ErrorSrc As String = "", _
                                Optional ByRef Return_ErrorDesc As String = "") As Boolean
On Error GoTo ErrorTrap
   
   Dim CompressedArray() As Byte
   Dim StringArray()     As Byte
   
   ' Set default values
   Return_String = ""
   Return_ErrorNum = 0
   Return_ErrorSrc = ""
   Return_ErrorDesc = ""
   
   ' Make sure the parameters passed are valid
   If StringToCompress = "" Then
      ZCompressString = True
      Exit Function
   End If
   
   ' Assign the string to the array
   Call GetByteArrayFromString(StringToCompress, StringArray)
   
   ' Compress the string
   ZCompressString = ZCompressByteArray(StringArray, CompressedArray, CompressionLevel, TagOriginalSize, Return_ErrorNum, Return_ErrorSrc, Return_ErrorDesc)
   If ZCompressString = True Then
      Call GetStringFromByteArray(CompressedArray, Return_String)
   End If
   
   Exit Function
   
ErrorTrap:
   
   Return_ErrorNum = Err.Number
   Return_ErrorSrc = Err.Source
   Return_ErrorDesc = Err.Description
   Err.Clear
   ZCompressString = False
   
End Function

'==========================================================================================================
'
' ZDecompressString
' ŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻ
' Purpose:
' --------
' This function takes a string that was previously compressed using ZLIB.DLL and decompresses it back to
' it's original state.
'
' Parameters:             Use:
' ŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻ
' StringToDecompress      The string that was previously compressed with ZLIB.DLL
' Return_String           Recieves the result of the decompression of the string.
' OriginalSize            Optional. If this parameter is set to anything but the default value of -1, it
'                         is assumed to be the size of the original string before it was compressed.  If
'                         the "ZCompressByteArray" function with the "TagOriginalSize" parameter set to
'                         TRUE is used to compress the string, this parameter must be left at the default
'                         value of -1 or the specified string to decompressed will be considered "corrupted"
'                         and an error will occur.
' Return_ErrorNum         Optional. If an error occurs, this returns the number of the error that occured.
' Return_ErrorSrc         Optional. If an error occurs, this returns the source of the error that occured.
' Return_ErrorDesc        Optional. If an error occurs, this returns the description of the error that occured.
'
' Return:
' -------
' Returns TRUE if the compression was successful.
' Returns FALSE if an error occured during compression.
'
'==========================================================================================================
Public Function ZDecompressString(ByVal StringToDecompress As String, _
                                  ByRef Return_String As String, _
                                  Optional ByVal OriginalSize As Long = -1, _
                                  Optional ByRef Return_ErrorNum As Long = 0, _
                                  Optional ByRef Return_ErrorSrc As String = "", _
                                  Optional ByRef Return_ErrorDesc As String = "") As Boolean
On Error GoTo ErrorTrap
   
   Dim DecompressedArray() As Byte
   Dim StringArray()       As Byte
   
   ' Set default values
   Return_String = ""
   Return_ErrorNum = 0
   Return_ErrorSrc = ""
   Return_ErrorDesc = ""
   
   ' Make sure the parameters passed are valid
   If StringToDecompress = "" Then
      ZDecompressString = True
      Exit Function
   End If
   
   ' Assign the string to the array
   Call GetByteArrayFromString(StringToDecompress, StringArray)
   
   ' Compress the string
   ZDecompressString = ZDecompressByteArray(StringArray, DecompressedArray, OriginalSize, Return_ErrorNum, Return_ErrorSrc, Return_ErrorDesc)
   If ZDecompressString = True Then
      Call GetStringFromByteArray(DecompressedArray, Return_String)
   End If
   
   Exit Function
   
ErrorTrap:
   
   Return_ErrorNum = Err.Number
   Return_ErrorSrc = Err.Source
   Return_ErrorDesc = Err.Description
   Err.Clear
   ZDecompressString = False
   
End Function

'==========================================================================================================
'
' ZCompressFile
' ŻŻŻŻŻŻŻŻŻŻŻŻŻ
' Purpose:
' --------
' This function takes the specified file, compresses it down to the specified compression level, and writes
' out the resulting compressed file to the specified output file.
'
' Parameters:             Use:
' ŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻ
' FileToCompress          Valid path to the file to compress.
' OutputFile              The path of the file to write the results of the compression to.
' CompressionLevel        Optional. The level of compression that is to be applied to the file.  The higher
'                         the compression, the longer it takes to compress the file.
' OverwriteFile           Optional. If set to FALSE and the specified output file exists, it is deleted and
'                         the new compressed file is writen out in it's place.  If set to TRUE and the
'                         specified output file exists, this function fails.
' Return_ErrorNum         Optional. If an error occurs, this returns the number of the error that occured.
' Return_ErrorSrc         Optional. If an error occurs, this returns the source of the error that occured.
' Return_ErrorDesc        Optional. If an error occurs, this returns the description of the error that occured.
'
' Return:
' -------
' Returns TRUE if the compression was successful.
' Returns FALSE if an error occured during compression.
'
'==========================================================================================================
Public Function ZCompressFile(ByVal FileToCompress As String, _
                              ByVal OutputFile As String, _
                              Optional ByVal CompressionLevel As ZCompressLevels = Z_BEST_COMPRESSION, _
                              Optional ByVal OverwriteFile As Boolean = True, _
                              Optional ByRef Return_ErrorNum As Long = 0, _
                              Optional ByRef Return_ErrorSrc As String = "", _
                              Optional ByRef Return_ErrorDesc As String = "") As Boolean
On Error GoTo ErrorTrap
   
   Dim CompressedBuffer() As Byte
   Dim FileBuffer()       As Byte
   Dim intFileLen         As Long
   
   ' Set default values
   Return_ErrorNum = 0
   Return_ErrorSrc = ""
   Return_ErrorDesc = ""
   
   ' Validate parameters
   If FileToCompress = "" Then
      Call Err.Raise(Z_PROCESSING_ERROR, "ZCompressFile", "No file specified to compress")
   ElseIf OutputFile = "" Then
      Call Err.Raise(Z_PROCESSING_ERROR, "ZCompressFile", "No output file specified to compress to")
   ElseIf UCase(Trim(FileToCompress)) = UCase(Trim(OutputFile)) Then
      Call Err.Raise(Z_PROCESSING_ERROR, "ZCompressFile", "Input and output files are the same")
   ElseIf Dir(FileToCompress, vbArchive Or vbHidden Or vbNormal Or vbReadOnly Or vbSystem) = "" Then
      Call Err.Raise(Z_PROCESSING_ERROR, "ZCompressFile", "File Not Found")
   ElseIf Dir(OutputFile, vbArchive Or vbHidden Or vbNormal Or vbReadOnly Or vbSystem) <> "" And OverwriteFile = False Then
      Call Err.Raise(Z_PROCESSING_ERROR, "ZCompressFile", "File Already Exists")
   End If
   
   ' Get how big the file is in bytes
   intFileLen = FileLen(FileToCompress)
   If intFileLen < 1 Then
      Call Err.Raise(Z_PROCESSING_ERROR, "ZCompressFile", "File Contains No Data")
   End If
   
   ' Delete the file in case it already exists
   If Dir(OutputFile, vbArchive Or vbHidden Or vbNormal Or vbReadOnly Or vbSystem) <> "" Then Kill OutputFile
   
   ' Read in the file in as BINARY (byte array)
   If LoadFromBinaryFile(FileToCompress, FileBuffer, , Return_ErrorNum, Return_ErrorSrc, Return_ErrorDesc) = False Then
      Call Err.Raise(Return_ErrorNum, "ZCompressFile >> LoadFromBinaryFile  [" & Return_ErrorSrc & "]", Return_ErrorDesc)
   End If
   
   ' Compress the bytes that make up the file
   If ZCompressByteArray(FileBuffer, CompressedBuffer, CompressionLevel, True, Return_ErrorNum, Return_ErrorSrc, Return_ErrorDesc) = True Then
      
      ' Write out the compressed file
      If SaveToBinaryFile(OutputFile, CompressedBuffer, Return_ErrorNum, Return_ErrorSrc, Return_ErrorDesc) = False Then
         Call Err.Raise(Return_ErrorNum, "ZCompressFile >> SaveToBinaryFile  [" & Return_ErrorSrc & "]", Return_ErrorDesc)
      Else
         ZCompressFile = True
      End If
   End If
   
   ' Clean up
   Erase CompressedBuffer
   Erase FileBuffer
   Exit Function
   
ErrorTrap:
   
   Return_ErrorNum = Err.Number
   Return_ErrorSrc = Err.Source
   Return_ErrorDesc = Err.Description
   Err.Clear
   
   ' Clean up
   Erase CompressedBuffer
   Erase FileBuffer
   ZCompressFile = False
   
End Function

'==========================================================================================================
'
' ZDecompressFile
' ŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻ
' Purpose:
' --------
' This function takes the specified file that was previously compressed using ZLIB.DLL and decompresses it
' back to it's original state.
'
' Parameters:             Use:
' ŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻ
' FileToDecompress        The file that was previously compressed with ZLIB.DLL
' OutputFile              The path of the file to write the results of the decompression to.
' OverwriteFile           Optional. If set to FALSE and the specified output file exists, it is deleted
'                         and the new compressed file is writen out in it's place.  If set to TRUE and the
'                         specified output file exists, this function fails.
' Return_ErrorNum         Optional. If an error occurs, this returns the number of the error that occured.
' Return_ErrorSrc         Optional. If an error occurs, this returns the source of the error that occured.
' Return_ErrorDesc        Optional. If an error occurs, this returns the description of the error that occured.
'
' Return:
' -------
' Returns TRUE if the compression was successful.
' Returns FALSE if an error occured during compression.
'
'==========================================================================================================
Public Function ZDecompressFile(ByVal FileToDecompress As String, _
                                ByVal OutputFile As String, _
                                Optional ByVal OverwriteFile As Boolean = True, _
                                Optional ByRef Return_ErrorNum As Long = 0, _
                                Optional ByRef Return_ErrorSrc As String = "", _
                                Optional ByRef Return_ErrorDesc As String = "") As Boolean
On Error GoTo ErrorTrap
   
   Dim DecompressedBuffer() As Byte
   Dim FileBuffer()         As Byte
   Dim intFileLen           As Long
   
   ' Set default values
   Return_ErrorNum = 0
   Return_ErrorSrc = ""
   Return_ErrorDesc = ""
   
   ' Validate parameters
   If FileToDecompress = "" Then
      Call Err.Raise(Z_PROCESSING_ERROR, "ZDecompressFile", "No file specified to compress")
   ElseIf OutputFile = "" Then
      Call Err.Raise(Z_PROCESSING_ERROR, "ZDecompressFile", "No output file specified to compress to")
   ElseIf UCase(Trim(FileToDecompress)) = UCase(Trim(OutputFile)) Then
      Call Err.Raise(Z_PROCESSING_ERROR, "ZDecompressFile", "Input and output files are the same")
   ElseIf Dir(FileToDecompress, vbArchive Or vbHidden Or vbNormal Or vbReadOnly Or vbSystem) = "" Then
      Call Err.Raise(Z_PROCESSING_ERROR, "ZDecompressFile", "File Not Found")
   ElseIf Dir(OutputFile, vbArchive Or vbHidden Or vbNormal Or vbReadOnly Or vbSystem) <> "" And OverwriteFile = False Then
      Call Err.Raise(Z_PROCESSING_ERROR, "ZDecompressFile", "File Already Exists")
   End If
   
   ' Get how big the file is in bytes
   intFileLen = FileLen(FileToDecompress)
   If intFileLen < 1 Then
      Call Err.Raise(Z_PROCESSING_ERROR, "ZDecompressFile", "File Contains No Data")
   End If
   
   ' Delete the file in case it already exists
   If Dir(OutputFile, vbArchive Or vbHidden Or vbNormal Or vbReadOnly Or vbSystem) <> "" Then Kill OutputFile
   
   ' Read in the file in as BINARY (byte array)
   If LoadFromBinaryFile(FileToDecompress, FileBuffer, , Return_ErrorNum, Return_ErrorSrc, Return_ErrorDesc) = False Then
      Call Err.Raise(Return_ErrorNum, "ZDecompressFile >> LoadFromBinaryFile  [" & Return_ErrorSrc & "]", Return_ErrorDesc)
   End If
   
   ' Compress the bytes that make up the file
   If ZDecompressByteArray(FileBuffer, DecompressedBuffer, , Return_ErrorNum, Return_ErrorSrc, Return_ErrorDesc) = True Then
      
      ' Write out the compressed file
      If SaveToBinaryFile(OutputFile, DecompressedBuffer, Return_ErrorNum, Return_ErrorSrc, Return_ErrorDesc) = False Then
         Call Err.Raise(Return_ErrorNum, "ZDecompressFile >> SaveToBinaryFile  [" & Return_ErrorSrc & "]", Return_ErrorDesc)
      Else
         ZDecompressFile = True
      End If
   End If
   
   ' Clean up
   Erase DecompressedBuffer
   Erase FileBuffer
   Exit Function
   
ErrorTrap:
   
   Return_ErrorNum = Err.Number
   Return_ErrorSrc = Err.Source
   Return_ErrorDesc = Err.Description
   Err.Clear
   
   ' Clean up
   Erase DecompressedBuffer
   Erase FileBuffer
   ZDecompressFile = False
   
End Function

' This returns the description for any error messages returned from the ZLIB.DLL library
Public Function GetErrorDescription(ByVal lngErrorCode As Long) As String
   
   Select Case lngErrorCode
      Case Z_OK:               GetErrorDescription = ""  ' No Error
      Case Z_STREAM_END:       GetErrorDescription = "Data stream reached the end of the stream"
      Case Z_NEED_DICT:        GetErrorDescription = "A preset dictionary is needed"
      Case Z_ERRNO:            GetErrorDescription = "A file system error has occured"
      Case Z_STREAM_ERROR:     GetErrorDescription = "A function parameter is invalid *OR* The stream state was inconsistent"
      Case Z_DATA_ERROR:       GetErrorDescription = "Input data was corrupted"
      Case Z_MEM_ERROR:        GetErrorDescription = "Not enough memory"
      Case Z_BUF_ERROR:        GetErrorDescription = "Not enough room in the output buffer"
      Case Z_VERSION_ERROR:    GetErrorDescription = "The zlib library version is incompatible with the version assumed by the caller"
      Case Z_PROCESSING_ERROR: GetErrorDescription = "A processing error occured"
      Case Else:               GetErrorDescription = "An unknown error occured"
   End Select
   
End Function

' ByteArray parameter is expected to be 0-based and contain at least 1 element
Public Sub GetStringFromByteArray(ByRef ArrayToConvert() As Byte, ByRef Return_Value As String)
   
   Return_Value = StrConv(ArrayToConvert, vbUnicode)
   
End Sub

' This function returns a 0-based array that represents the string passed in
Public Sub GetByteArrayFromString(ByRef StringToConvert As String, ByRef Return_Value() As Byte)
   
   Return_Value = StrConv(StringToConvert, vbFromUnicode)
   
End Sub

' This loads a file and returns it's contents as a byte array
Private Function LoadFromBinaryFile(ByVal strFilePath As String, _
                                    ByRef Return_ByteArray() As Byte, _
                                    Optional ByRef Return_FileLength As Long = 0, _
                                    Optional ByRef Return_ErrNum As Long = 0, _
                                    Optional ByRef Return_ErrSrc As String = "", _
                                    Optional ByRef Return_ErrDesc As String = "") As Boolean
On Error GoTo ErrorTrap
   
   Dim blnOpen    As Boolean
   Dim intFileNum As Integer
   
   ' Set the default values
   Erase Return_ByteArray
   Return_FileLength = 0
   Return_ErrNum = 0
   Return_ErrSrc = ""
   Return_ErrDesc = ""
   
   ' Make sure the file exists
   If Dir(strFilePath, vbArchive Or vbHidden Or vbNormal Or vbReadOnly Or vbSystem) = "" Then Call Err.Raise(Z_PROCESSING_ERROR, "", "File Not Found")
   
   ' Get the size of th file
   Return_FileLength = FileLen(strFilePath)
   
   ' If the file contains no data, exit
   If Return_FileLength < 1 Then
      LoadFromBinaryFile = True
      Exit Function
   End If
   
   ' Resize the return array
   ReDim Return_ByteArray(0 To Return_FileLength - 1) As Byte
   
   ' Open the file and get it's contents
   intFileNum = FreeFile
   blnOpen = True
   Open strFilePath For Binary Access Read As #intFileNum
      Get #intFileNum, , Return_ByteArray
   Close #intFileNum
   blnOpen = False
   
   LoadFromBinaryFile = True
   Exit Function
   
ErrorTrap:
   
   Return_ErrNum = Err.Number
   Return_ErrSrc = Err.Source
   Return_ErrDesc = Err.Description
   Err.Clear
   On Error Resume Next
   If blnOpen = True Then Close #intFileNum
   
End Function

' This function takes the passed in byte array and saves it directly to file as bynary data
Private Function SaveToBinaryFile(ByVal strFilePath As String, _
                                  ByRef ByteArrayToSave() As Byte, _
                                  Optional ByRef Return_ErrNum As Long = 0, _
                                  Optional ByRef Return_ErrSrc As String = "", _
                                  Optional ByRef Return_ErrDesc As String = "") As Boolean
On Error GoTo ErrorTrap
   
   Dim blnOpen    As Boolean
   Dim intFileNum As Integer
   Dim intFileLen As Long
   
   ' Set the default values
   Return_ErrNum = 0
   Return_ErrSrc = ""
   Return_ErrDesc = ""
   
   ' Make sure the file exists
   If Dir(strFilePath, vbArchive Or vbHidden Or vbNormal Or vbReadOnly Or vbSystem) <> "" Then Call Err.Raise(Z_PROCESSING_ERROR, "", "File Already Exists")
   
   ' Open the file as a FileStream objecft
   intFileNum = FreeFile
   blnOpen = True
   Open strFilePath For Binary Access Write Lock Read Write As #intFileNum
      Put #intFileNum, , ByteArrayToSave
   Close #intFileNum
   blnOpen = False
   
   SaveToBinaryFile = True
   Exit Function
   
ErrorTrap:
   
   Return_ErrNum = Err.Number
   Return_ErrSrc = Err.Source
   Return_ErrDesc = Err.Description
   Err.Clear
   On Error Resume Next
   If blnOpen = True Then Close #intFileNum
   
End Function








































'''
'''
'''
'''Option Explicit
'''
'''
''''=============================================================================================================
''''
'''' modCompress Module
'''' ------------------
''''
'''' Created By  : Kevin Wilson
''''               http://www.TheVBZone.com   ( The VB Zone )
''''               http://www.TheVBZone.net   ( The VB Zone .net )
''''
'''' Last Update : November 4, 2000
''''
'''' VB Versions : 5.0 / 6.0
''''
'''' Requires    : ZLIB.DLL (Copyrightİ 1995-1998 Jean-loup Gailly & Mark Adler)
''''                        (http://www.info-zip.org/pub/infozip/zlib/)
''''
'''' Description : This module was made to make it easy to access the power of zLib to compress and decompress
''''               files, byte arrays, and strings (which they themselves are a special type of byte array) from
''''               within Visual Basic 5 or 6.  Refer to each function for more details on the use of this module.
''''
''''=============================================================================================================
''''
'''' LEGAL:
''''
'''' You are free to use this code as long as you keep the above heading information intact and unchanged. Credit
'''' given where credit is due.  Also, it is not required, but it would be appreciated if you would mention
'''' somewhere in your compiled program that that your program makes use of code written and distributed by
'''' Kevin Wilson (www.TheVBZone.com).  Feel free to link to this code via your web site or articles.
''''
'''' You may NOT take this code and pass it off as your own.  You may NOT distribute this code on your own server
'''' or web site.  You may NOT take code created by Kevin Wilson (www.TheVBZone.com) and use it to create products,
'''' utilities, or applications that directly compete with products, utilities, and applications created by Kevin
'''' Wilson, TheVBZone.com, or Wilson Media.  You may NOT take this code and sell it for profit without first
'''' obtaining the written consent of the author Kevin Wilson.
''''
'''' These conditions are subject to change at the discretion of the owner Kevin Wilson at any time without
'''' warning or notice.  Copyrightİ by Kevin Wilson.  All rights reserved.
''''
''''=============================================================================================================
'''
'''
'''
'''' Enumeration - zLib (v1.1.3) Compression Levels
'''Public Enum ZCompressLevels
'''  Z_NO_COMPRESSION = 0
'''  Z_BEST_SPEED = 1
'''  Z_BEST_COMPRESSION = 9
'''  Z_DEFAULT_COMPRESSION = (-1)
'''End Enum
'''
'''' Constants - zLib (v1.1.3)
'''Private Const Z_NULL             As Long = 0
'''Private Const Z_PARTIAL_FLUSH    As Long = 1 ' Obselete - use Z_SYNC_FLUSH instead
'''Private Const Z_SYNC_FLUSH       As Long = 2
'''Private Const Z_FULL_FLUSH       As Long = 3
'''Private Const Z_FINISH           As Long = 4
'''
'''' Constants - zLib (v1.1.3) Error Values
'''Private Const Z_OK               As Long = 0               ' No Error
'''Private Const Z_STREAM_END       As Long = 1       ' Data stream reached the end of the stream
'''Private Const Z_NEED_DICT        As Long = 2        ' A preset dictionary is needed
'''Private Const Z_ERRNO            As Long = (-1)         ' A file system error has occured
'''Private Const Z_STREAM_ERROR     As Long = (-2)  ' A function parameter is invalid *OR* The stream state was inconsistent
'''Private Const Z_DATA_ERROR       As Long = (-3)    ' Input data was corrupted
'''Private Const Z_MEM_ERROR        As Long = (-4)     ' Not enough memory
'''Private Const Z_BUF_ERROR        As Long = (-5)     ' Not enough room in the output buffer
'''Private Const Z_VERSION_ERROR    As Long = (-6) ' The zlib library version is incompatible with the version assumed by the caller
'''Private Const Z_PROCESSING_ERROR As Long = 99
'''
'''' Constants - zLib (v1.1.3) Compression strategy
'''Private Const Z_FILTERED         As Long = 1
'''Private Const Z_HUFFMAN_ONLY     As Long = 2
'''Private Const Z_DEFAULT_STRATEGY As Long = 0
'''
'''' Constants - zLib (v1.1.3) Possible values of the data_type field
'''Private Const Z_BINARY           As Long = 0
'''Private Const Z_ASCII            As Long = 1
'''Private Const Z_UNKNOWN          As Long = 2
'''
'''' Constants - zLib (v1.1.3) The deflate compression method (the only one supported in this version)
'''Private Const Z_DEFLATED         As Long = 8
'''
''''----------------------------------------------------------------------------------------------------------
''''int compress2 (
''''  Bytef       *dest,
''''  uLongf      *destLen,
''''  const Bytef *source,
''''  uLong       sourceLen,
''''  int         level
'''');
''''ŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻ
'''' Compresses the source buffer into the destination buffer. The "level" parameter has the same meaning as
'''' in deflateInit. "sourceLen" is the byte length of the source buffer. Upon entry, "destLen" is the total
'''' size of the destination buffer, which must be at least 0.1% larger than sourceLen plus 12 bytes. Upon
'''' exit, "destLen" is the actual size of the compressed buffer.
''''
'''' compress2 returns Z_OK if success, Z_MEM_ERROR if there was not enough memory, Z_BUF_ERROR if there was
'''' not enough room in the output buffer, Z_STREAM_ERROR if the level parameter is invalid.
''''__________________________________________________________________________________________________________
'''Private Declare Function Compress Lib "ZLIB.DLL" Alias "compress2" (ByRef DestinationArray As Byte, ByRef DestLen As Long, ByRef SourceArray As Byte, ByVal SourceLen As Long, ByVal CompressionLevel As Long) As Long
''''----------------------------------------------------------------------------------------------------------
'''
''''----------------------------------------------------------------------------------------------------------
''''int uncompress (
''''  Bytef        *dest,
''''  uLongf       *destLen,
''''  const Bytef  *source,
''''  uLong        sourceLen
'''');
''''ŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻ
'''' Decompresses the source buffer into the destination buffer. "sourceLen" is the byte length of the source
'''' buffer. Upon entry, "destLen" is the total size of the destination buffer, which must be large enough to
'''' hold the entire uncompressed data. (The size of the uncompressed data must have been saved previously by
'''' the compressor and transmitted to the decompressor by some mechanism outside the scope of this
'''' compression library.) Upon exit, destLen is the actual size of the compressed buffer.
''''
'''' This function can be used to decompress a whole file at once if the input file is mmap'ed.
''''
'''' uncompress returns Z_OK if success, Z_MEM_ERROR if there was not enough memory, Z_BUF_ERROR if there was
'''' not enough room in the output buffer, or Z_DATA_ERROR if the input data was corrupted.
''''__________________________________________________________________________________________________________
'''Private Declare Function Uncompress Lib "ZLIB.DLL" Alias "uncompress" (ByRef DestinationArray As Byte, ByRef DestLen As Long, ByRef SourceArray As Byte, ByVal SourceLen As Long) As Long
''''----------------------------------------------------------------------------------------------------------
'''
'''
'''
''''==========================================================================================================
''''
'''' ZCompressByteArray
'''' ŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻ
'''' Purpose:
'''' --------
'''' This function takes a dynamic byte array (0 based) and compresses it to the specified compression level.
'''' This function can be used to compress strings, files, and anything else that can be broken down into a
'''' byte array.
''''
'''' Parameters:             Use:
'''' ŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻ
'''' ArrayToCompress         The dynamically created 0-based byte array that is to be compressed.
'''' Return_Array            Recieves the result of the compression of the array.
'''' CompressionLevel        Optional. The level of compression that is to be applied to the byte array. The
''''                         higher the compression, the longer it takes to compress the array.
'''' Return_ErrorCode        Optional. If an error occurs, this returns the error code.
'''' TagOriginalSize         Optional. If TRUE, the size of the original byte array is appended to the end of
''''                         the resulting byte array.  This is highly recommended because it frees you from
''''                         the worry of having to store the size of the original array... which is needed to
''''                         decompress the resulting array.  If this parameter is set to TRUE, you *MUST* use
''''                         the "ZDecompressByteArray" function with the "OriginalSize" parameter set to the
''''                         default value of -1 to correctly decompress the array... otherwise the resulting
''''                         array will be considered a "corrupt" compression and any attempt to decompress
''''                         it will error out.
''''
'''' Return:
'''' -------
'''' Returns TRUE if the compression was successful.
'''' Returns FALSE if an error occured during compression.  See error codes for the meaning of the returned error code in the "Return_ErrorCode" parameter
''''
''''==========================================================================================================
'''Public Function ZCompressByteArray(ByRef ArrayToCompress() As Byte, _
'''                                   ByRef Return_Array() As Byte, _
'''                                   Optional ByVal CompressionLevel As ZCompressLevels = Z_BEST_COMPRESSION, _
'''                                   Optional ByRef Return_ErrorCode As Long = 0, _
'''                                   Optional ByVal TagOriginalSize As Boolean = True, _
'''                                   Optional ByVal ShowErrorMsg As Boolean = False) As Boolean
'''On Error GoTo ErrorTrap
'''
'''   Dim OrigSize  As String
'''   Dim ArrayLenS As Long
'''   Dim ArrayLenD As Long
'''   Dim CharCount As Long
'''   Dim MyCounter As Long
'''
'''   ' Set default values
'''   Erase Return_Array
'''   Return_ErrorCode = 0
'''
'''   ' Get the size of the source array
'''   ArrayLenS = UBound(ArrayToCompress) + 1
'''   If ArrayLenS = 0 Then
'''     ZCompressByteArray = True
'''     Exit Function
'''   End If
'''
'''   ' Calculate the size of the desitnation buffer - (SourceLen * 0.001) + 12)
'''   ArrayLenD = ArrayLenS + ((ArrayLenS * 0.001) + 15) ' Extra 3 bytes added on for some extra padding (avoids errors)
'''
'''   ' Clear the return array
'''   ReDim Return_Array(ArrayLenD) As Byte
'''
'''   ' Call the API to compress the byte array
'''   Return_ErrorCode = Compress(Return_Array(0), ArrayLenD, ArrayToCompress(0), ArrayLenS, CompressionLevel)
'''   ZCompressByteArray = CBool(Return_ErrorCode = Z_OK)
'''
'''   ' Redimention the resulting array to fit it's content
'''   If TagOriginalSize = False Then
'''      ReDim Preserve Return_Array(ArrayLenD - 1) As Byte
'''
'''   ' Append the original size of the byte array to then end of the byte array.
'''   ' This is used in the "ZDecompressByteArray" function to automatically get the
'''   ' original size of the array (MAX = 2.1GB : 2,147,483,647 bytes).
'''   Else
'''      If ArrayLenS > 2147483647 Then
'''         ReDim Preserve Return_Array(ArrayLenD - 1) As Byte
'''         Exit Function
'''      End If
'''
'''      ' Get the tag to append to the end of the byte array
'''      OrigSize = CStr(ArrayLenS)
'''      OrigSize = OrigSize & String(11 - Len(OrigSize), vbNullChar)
'''      OrigSize = String(5, vbNullChar) & OrigSize
'''
'''      ' Redimention the size of the return array to it's compressed size, plus
'''      ' 16 bytes which contains the original size of the byte array.
'''      ' TAG Format = <5 x NULL> <ORIG SIZE> <(10 - Len(<ORIG SIZE>)) x NULL> <1 x NULL TERMINATOR>
'''      ReDim Preserve Return_Array(ArrayLenD + 16) As Byte
'''
'''      ' Add the original size to the end
'''      For MyCounter = ArrayLenD To ArrayLenD + 16
'''         CharCount = CharCount + 1
'''         Return_Array(MyCounter) = Asc(Right(Left(OrigSize, CharCount), 1))
'''      Next
'''   End If
'''
'''   Exit Function
'''
'''ErrorTrap:
'''
'''   MsgBox Err.Source & " caused the following error :" & Chr(13) & Chr(13) & "Error Number = " & CStr(Err.Number) & Chr(13) & "Error Description = " & Err.Description, vbOKOnly + vbExclamation, "  Error  -  " & Err.Description
'''   Return_ErrorCode = Err.Number
'''   Err.Clear
'''
'''End Function
'''
''''==========================================================================================================
''''
'''' ZDecompressByteArray
'''' ŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻ
'''' Purpose:
'''' --------
'''' This function takes a dynamic byte array (0 based) that was previously compressed using ZLIB.DLL and
'''' decompresses it back to it's original state.  This function can be used to decompress strings, files,
'''' and anything else that can be broken down into a byte array.
''''
'''' Parameters:             Use:
'''' ŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻ
'''' ArrayToDecompress       The dynamically created 0-based byte array that was previously compressed with ZLIB.DLL
'''' Return_Array            Recieves the result of the decompression of the array.
'''' Return_ErrorCode        Optional. If an error occurs, this returns the error code.
'''' OriginalSize            Optional. If this parameter is set to anything but the default value of -1, it is
''''                         assumed to be the size of the original byte array before it was compressed.  If the
''''                         "ZCompressByteArray" function with the "TagOriginalSize" parameter set to TRUE is
''''                         used to compress the array, this parameter must be left at the default value of -1
''''                         or the specified array to decompressed will be considered "corrupted" and an error
''''                         will occur.
''''
'''' Return:
'''' -------
'''' Returns TRUE if the compression was successful.
'''' Returns FALSE if an error occured during compression.  See error codes for the meaning of the returned error code in the "Return_ErrorCode" parameter
''''
''''==========================================================================================================
'''Public Function ZDecompressByteArray(ByRef ArrayToDecompress() As Byte, _
'''                                     ByRef Return_Array() As Byte, _
'''                                     Optional ByRef Return_ErrorCode As Long = 0, _
'''                                     Optional ByVal OriginalSize As Long = -1, _
'''                                     Optional ByVal ShowErrorMsg As Boolean = False) As Boolean
'''On Error GoTo ErrorTrap
'''
'''  Dim TestTag   As String
'''  Dim OrigSize  As String
'''  Dim ArrayLenS As Long
'''  Dim ArrayLenD As Long
'''  Dim MyCounter As Long
'''
'''  Return_ErrorCode = 0
'''
'''  ' Get the size of the source array
'''  ArrayLenS = UBound(ArrayToDecompress) + 1
'''  If ArrayLenS = 0 Then
'''    ZDecompressByteArray = True
'''    Exit Function
'''  End If
'''
'''  ' Get the original array size from the value the user specified
'''  If OriginalSize <> -1 Then
'''    ArrayLenD = OriginalSize
'''
'''  ' Get the original array size from the TAG value appended to the
'''  ' array by the "ZCompressByteArray" function
'''  Else
'''    For MyCounter = (ArrayLenS - 17) To ArrayLenS - 1
'''      TestTag = TestTag & Chr(ArrayToDecompress(MyCounter))
'''    Next
'''    If Left(TestTag, 5) <> String(5, vbNullChar) Then
'''      Return_ErrorCode = -1
'''      Exit Function
'''    Else
'''      ' Get the original size from the tag value
'''      OrigSize = Right(TestTag, Len(TestTag) - 5)
'''      OrigSize = Left(OrigSize, InStr(OrigSize, vbNullChar) - 1)
'''      ArrayLenD = CLng(OrigSize)
'''
'''      ' Redimention the array to cut off the tag
'''      ReDim Preserve ArrayToDecompress(ArrayLenS - 18) As Byte
'''      ArrayLenS = ArrayLenS - 17
'''    End If
'''  End If
'''
'''  ' Clear the return array
'''  Erase Return_Array
'''  ReDim Return_Array(ArrayLenD) As Byte
'''
'''  ' Decompress the byte array
'''  Return_ErrorCode = Uncompress(Return_Array(0), ArrayLenD, ArrayToDecompress(0), ArrayLenS)
'''  If Return_ErrorCode <> Z_OK Then
'''    ZDecompressByteArray = False
'''  Else
'''    ZDecompressByteArray = True
'''  End If
'''
'''  Exit Function
'''
'''ErrorTrap:
'''
'''  If Err.Number = 0 Then      ' No Error
'''    Resume Next
'''  ElseIf Err.Number = 20 Then ' Resume Without Error
'''    Resume Next
'''  Else                        ' Unknown Error
'''    MsgBox Err.Source & " caused the following error :" & Chr(13) & Chr(13) & "Error Number = " & CStr(Err.Number) & Chr(13) & "Error Description = " & Err.Description, vbOKOnly + vbExclamation, "  Error  -  " & Err.Description
'''    Return_ErrorCode = Err.Number
'''    Err.Clear
'''  End If
'''
'''End Function
'''
''''==========================================================================================================
''''
'''' ZCompressString
'''' ŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻ
'''' Purpose:
'''' --------
'''' This function takes the specified string, compresses it down to the specified compression level, and
'''' returns the resulting string.
''''
'''' NOTE: The resulting string will more than likely NOT be a printable string.
''''
'''' Parameters:             Use:
'''' ŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻ
'''' StringToCompress        The string that is to be compressed.
'''' Return_String           Recieves the result of the compression of the string.
'''' CompressionLevel        Optional. The level of compression that is to be applied to the byte array.
''''                         The higher the compression, the longer it takes to compress the array.
'''' Return_ErrorCode        Optional. If an error occurs, this returns the error code.
'''' TagOriginalSize         Optional. If TRUE, the size of the original string is appended to the end of the
''''                         resulting string.  This is highly recommended because it frees you from the worry
''''                         of having to store the size of the original string... which is needed to
''''                         decompress the resulting string. If this parameter is set to TRUE, you *MUST* use
''''                         the "ZDecompressString" function with the "OriginalSize" parameter set to the
''''                         default value of -1 to correctly decompress the string... otherwise the resulting
''''                         string will be considered a "corrupt" compression and any attempt to decompress
''''                         it will error out.
''''
'''' Return:
'''' -------
'''' Returns TRUE if the compression was successful.
'''' Returns FALSE if an error occured during compression.  See error codes for the meaning of the returned error code in the "Return_ErrorCode" parameter
''''
''''==========================================================================================================
'''Public Function ZCompressString(ByVal StringToCompress As String, _
'''                                ByRef Return_String As String, _
'''                                Optional ByVal CompressionLevel As ZCompressLevels = Z_BEST_COMPRESSION, Optional ByRef Return_ErrorCode As Long, _
'''                                Optional ByVal TagOriginalSize As Boolean = True, _
'''                                Optional ByVal ShowErrorMsg As Boolean = False) As Boolean
'''On Error GoTo ErrorTrap
'''
'''  Dim CompressedArray() As Byte
'''  Dim StringArray()     As Byte
'''
'''  Return_ErrorCode = 0
'''
'''  ' Make sure the parameters passed are valid
'''  If StringToCompress = "" Then
'''    ZCompressString = True
'''    Exit Function
'''  End If
'''
'''  ' Clear the return string
'''  Return_String = ""
'''
'''  ' Assign the string to the array
'''  StringArray = StringToCompress
'''
'''  ' Compress the string
'''  ZCompressString = ZCompressByteArray(StringArray, CompressedArray, CompressionLevel, Return_ErrorCode, TagOriginalSize)
'''  If ZCompressString = True Then
'''    Return_String = CompressedArray
'''  End If
'''
'''  Exit Function
'''
'''ErrorTrap:
'''
'''  If Err.Number = 0 Then      ' No Error
'''    Resume Next
'''  ElseIf Err.Number = 20 Then ' Resume Without Error
'''    Resume Next
'''  Else                        ' Unknown Error
'''    MsgBox Err.Source & " caused the following error :" & Chr(13) & Chr(13) & "Error Number = " & CStr(Err.Number) & Chr(13) & "Error Description = " & Err.Description, vbOKOnly + vbExclamation, "  Error  -  " & Err.Description
'''    Return_ErrorCode = Err.Number
'''    Err.Clear
'''  End If
'''
'''End Function
'''
''''==========================================================================================================
''''
'''' ZDecompressString
'''' ŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻ
'''' Purpose:
'''' --------
'''' This function takes a string that was previously compressed using ZLIB.DLL and decompresses it back to
'''' it's original state.
''''
'''' Parameters:             Use:
'''' ŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻ
'''' StringToDecompress      The string that was previously compressed with ZLIB.DLL
'''' Return_String           Recieves the result of the decompression of the string.
'''' Return_ErrorCode        Optional. If an error occurs, this returns the error code.
'''' OriginalSize            Optional. If this parameter is set to anything but the default value of -1, it
''''                         is assumed to be the size of the original string before it was compressed.  If
''''                         the "ZCompressByteArray" function with the "TagOriginalSize" parameter set to
''''                         TRUE is used to compress the string, this parameter must be left at the default
''''                         value of -1 or the specified string to decompressed will be considered "corrupted"
''''                         and an error will occur.
''''
'''' Return:
'''' -------
'''' Returns TRUE if the compression was successful.
'''' Returns FALSE if an error occured during compression.  See error codes for the meaning of the returned error code in the "Return_ErrorCode" parameter
''''
''''==========================================================================================================
'''Public Function ZDecompressString(ByVal StringToDecompress As String, _
'''                                  ByRef Return_String As String, _
'''                                  Optional ByRef Return_ErrorCode As Long, _
'''                                  Optional ByVal OriginalSize As Long = -1, _
'''                                  Optional ByVal ShowErrorMsg As Boolean = False) As Boolean
'''On Error GoTo ErrorTrap
'''
'''  Dim DecompressedArray() As Byte
'''  Dim StringArray()       As Byte
'''
'''  Return_ErrorCode = 0
'''
'''  ' Make sure the parameters passed are valid
'''  If StringToDecompress = "" Then
'''    ZDecompressString = True
'''    Exit Function
'''  End If
'''
'''  ' Clear the return string
'''  Return_String = ""
'''
'''  ' Assign the string to the array
'''  StringArray = StringToDecompress
'''
'''  ' Compress the string
'''  ZDecompressString = ZDecompressByteArray(StringArray, DecompressedArray, Return_ErrorCode, OriginalSize)
'''  If ZDecompressString = True Then
'''    Return_String = DecompressedArray
'''  End If
'''
'''  Exit Function
'''
'''ErrorTrap:
'''
'''  If Err.Number = 0 Then      ' No Error
'''    Resume Next
'''  ElseIf Err.Number = 20 Then ' Resume Without Error
'''    Resume Next
'''  Else                        ' Unknown Error
'''    MsgBox Err.Source & " caused the following error :" & Chr(13) & Chr(13) & "Error Number = " & CStr(Err.Number) & Chr(13) & "Error Description = " & Err.Description, vbOKOnly + vbExclamation, "  Error  -  " & Err.Description
'''    Return_ErrorCode = Err.Number
'''    Err.Clear
'''  End If
'''
'''End Function
'''
''''==========================================================================================================
''''
'''' ZCompressFile
'''' ŻŻŻŻŻŻŻŻŻŻŻŻŻ
'''' Purpose:
'''' --------
'''' This function takes the specified file, compresses it down to the specified compression level, and writes
'''' out the resulting compressed file to the specified output file.
''''
'''' Parameters:             Use:
'''' ŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻ
'''' FileToCompress          Valid path to the file to compress.
'''' OutputFile              The path of the file to write the results of the compression to.
'''' CompressionLevel        Optional. The level of compression that is to be applied to the file.  The higher
''''                         the compression, the longer it takes to compress the file.
'''' Return_ErrorCode        Optional. If an error occurs, this returns the error code.
'''' OverwriteFile           Optional. If set to FALSE and the specified output file exists, it is deleted and
''''                         the new compressed file is writen out in it's place.  If set to TRUE and the
''''                         specified output file exists, this function fails.
''''
'''' Return:
'''' -------
'''' Returns TRUE if the compression was successful.
'''' Returns FALSE if an error occured during compression.  See error codes for the meaning of the returned error code in the "Return_ErrorCode" parameter
''''
''''==========================================================================================================
'''Public Function ZCompressFile(ByVal FileToCompress As String, _
'''                              ByVal OutputFile As String, _
'''                              Optional ByVal CompressionLevel As ZCompressLevels = Z_BEST_COMPRESSION, Optional ByRef Return_ErrorCode As Long, _
'''                              Optional ByVal OverwriteFile As Boolean = True, _
'''                              Optional ByVal ShowErrorMsg As Boolean = False) As Boolean
'''On Error Resume Next
'''
'''  Dim CompressedBuffer() As Byte
'''  Dim FileBuffer()       As Byte
'''  Dim FileNum            As Long
'''
'''  Return_ErrorCode = 0
'''
'''  ' Make sure the parameters passed are valid
'''  If FileToCompress = "" Or OutputFile = "" Then
'''    Exit Function
'''  ElseIf Dir(FileToCompress) = "" Then
'''    Exit Function
'''  ElseIf Dir(OutputFile) <> "" And OverwriteFile = False Then
'''    Exit Function
'''  End If
'''
'''  ' Delete the file in case it already exists
'''  Kill OutputFile
'''  On Error GoTo ErrorTrap
'''
'''  ' Create a buffer to recieve the file to compress
'''  ReDim FileBuffer(FileLen(FileToCompress) - 1)
'''
'''  ' Read in the file
'''  FileNum = FreeFile
'''  Open FileToCompress For Binary Access Read As #FileNum
'''    Get #FileNum, , FileBuffer()
'''  Close #FileNum
'''
'''  ' Compress the bytes that make up the file
'''  If ZCompressByteArray(FileBuffer, CompressedBuffer, CompressionLevel, Return_ErrorCode, True) = True Then
'''    ' Write out the compressed file
'''    FileNum = FreeFile
'''    Open OutputFile For Binary Access Write As #FileNum
'''      Put #FileNum, , CompressedBuffer()
'''    Close #FileNum
'''    ZCompressFile = True
'''  End If
'''
'''CleanUp:
'''
'''  ' Clean up memory that was used
'''  Erase CompressedBuffer
'''  Erase FileBuffer
'''  Close #FileNum
'''
'''  Exit Function
'''
'''ErrorTrap:
'''
'''  If Err.Number = 0 Then      ' No Error
'''    Resume Next
'''  ElseIf Err.Number = 20 Then ' Resume Without Error
'''    Resume Next
'''  Else                        ' Unknown Error
'''    MsgBox Err.Source & " caused the following error :" & Chr(13) & Chr(13) & "Error Number = " & CStr(Err.Number) & Chr(13) & "Error Description = " & Err.Description, vbOKOnly + vbExclamation, "  Error  -  " & Err.Description
'''    Return_ErrorCode = Err.Number
'''    Err.Clear
'''    Resume CleanUp
'''  End If
'''
'''End Function
'''
''''==========================================================================================================
''''
'''' ZDecompressFile
'''' ŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻ
'''' Purpose:
'''' --------
'''' This function takes the specified file that was previously compressed using ZLIB.DLL and decompresses it
'''' back to it's original state.
''''
'''' Parameters:             Use:
'''' ŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻ
'''' FileToDecompress        The file that was previously compressed with ZLIB.DLL
'''' OutputFile              The path of the file to write the results of the decompression to.
'''' Return_ErrorCode        Optional. If an error occurs, this returns the error code.
'''' OverwriteFile           Optional. If set to FALSE and the specified output file exists, it is deleted
''''                         and the new compressed file is writen out in it's place.  If set to TRUE and the
''''                         specified output file exists, this function fails.
''''
'''' Return:
'''' -------
'''' Returns TRUE if the compression was successful.
'''' Returns FALSE if an error occured during compression.  See error codes for the meaning of the returned error code in the "Return_ErrorCode" parameter
''''
''''==========================================================================================================
'''Public Function ZDecompressFile(ByVal FileToDecompress As String, _
'''                                ByVal OutputFile As String, _
'''                                Optional ByRef Return_ErrorCode As Long, _
'''                                Optional ByVal OverwriteFile As Boolean = True, _
'''                                Optional ByVal ShowErrorMsg As Boolean = False) As Boolean
'''On Error Resume Next
'''
'''  Dim DecompressedBuffer() As Byte
'''  Dim FileBuffer()         As Byte
'''  Dim FileNum              As Long
'''
'''  Return_ErrorCode = 0
'''
'''  ' Make sure the parameters passed are valid
'''  If FileToDecompress = "" Or OutputFile = "" Then
'''    Exit Function
'''  ElseIf Dir(FileToDecompress) = "" Then
'''    Exit Function
'''  ElseIf Dir(OutputFile) <> "" And OverwriteFile = False Then
'''    Exit Function
'''  End If
'''
'''  ' Delete the file in case it already exists
'''  Kill OutputFile
'''  On Error GoTo ErrorTrap
'''
'''  ' Create a buffer to recieve the file to compress
'''  ReDim FileBuffer(FileLen(FileToDecompress) - 1)
'''
'''  ' Read in the file
'''  FileNum = FreeFile
'''  Open FileToDecompress For Binary Access Read As #FileNum
'''    Get #FileNum, , FileBuffer()
'''  Close #FileNum
'''
'''  ' Compress the bytes that make up the file
'''  If ZDecompressByteArray(FileBuffer, DecompressedBuffer, Return_ErrorCode) = True Then
'''    ' Write out the compressed file
'''    FileNum = FreeFile
'''    Open OutputFile For Binary Access Write As #FileNum
'''      Put #FileNum, , DecompressedBuffer()
'''    Close #FileNum
'''    ZDecompressFile = True
'''  End If
'''
'''CleanUp:
'''
'''  ' Clean up memory that was used
'''  Erase DecompressedBuffer
'''  Erase FileBuffer
'''  Close #FileNum
'''
'''  Exit Function
'''
'''ErrorTrap:
'''
'''  If Err.Number = 0 Then      ' No Error
'''    Resume Next
'''  ElseIf Err.Number = 20 Then ' Resume Without Error
'''    Resume Next
'''  Else                        ' Unknown Error
'''    MsgBox Err.Source & " caused the following error :" & Chr(13) & Chr(13) & "Error Number = " & CStr(Err.Number) & Chr(13) & "Error Description = " & Err.Description, vbOKOnly + vbExclamation, "  Error  -  " & Err.Description
'''    Return_ErrorCode = Err.Number
'''    Err.Clear
'''    Resume CleanUp
'''  End If
'''
'''End Function