Announcement

Collapse

Forum Guidelines

This forum is for finished source code that is working properly. If you have questions about this or any other source code, please post it in one of the Discussion Forums, not here.
See more
See less

zlib wrapper

Collapse
X
  • Filter
  • Time
  • Show
Clear All
new posts

  • zlib wrapper

    Code:
    '
    '  pb_zlib.inc
    '
    '  Declares and Wrappers for PB-DLL and PB-CC 32-bit
    '  using zlib32.dll compression library. This is not a 
    '  full translation of the zlib api, but it is enough 
    '  to perform some basic compression/decompression of 
    '  strings and files.
    '
    '  By Don Dickinson
    '  ddickinson@usinternet.com
    '  dickinson.basicguru.com
    '
    '  Hereby Public Domain. Provided in good faith by the auther
    '  Don Dickinson. Your use or mis-use of this code impies that
    '  you hold the author harmless of all effects and side-effects
    '  of its use.
    '
    '
    '- These might be defined already, but if not, 
    '  I do it here.
    '
    #If Not %Def(%True)
    %True = -1
    %False = 0
    #EndIf
    
    Global g_gzLastError As String
    %DECOMPRESS_BLOCK_SIZE     = 100000
    
    $Z_OPEN_READ               = "rb"
    $Z_OPEN_WRITE              = "wb"
    
    %Z_NO_FLUSH                = 0
    %Z_PARTIAL_FLUSH           = 1
    %Z_SYNC_FLUSH              = 2
    %Z_FULL_FLUSH              = 3
    %Z_FINISH                  = 4
    
    %Z_OK                      = 0
    %Z_STREAM_END              = 1
    %Z_NEED_DICT               = 2
    %Z_ERRNO                   = -1
    %Z_STREAM_ERROR            = -2
    %Z_DATA_ERROR              = -3
    %Z_MEM_ERROR               = -4
    %Z_BUF_ERROR               = -5
    %Z_VERSION_ERROR           = -6
    
    %Z_NO_COMPRESSION          = 0
    %Z_BEST_SPEED              = 1
    %Z_BEST_COMPRESSION        = 9
    %Z_DEFAULT_COMPRESSION     = -1
    
    %Z_FILTERED                = 1
    %Z_HUFFMAN_ONLY            = 2
    %Z_DEFAULT_STRATEGY        = 0
    
    %Z_BINARY                  = 0
    %Z_ASCII                   = 1
    %Z_UNKNOWN                 = 2
    
    %Z_DEFLATED                = 8
    
    Declare Function compress Lib "zlib.dll" Alias "compress" _
            (   compr As Any, comprLen As Long, buf As Any, _
                ByVal buflen As Long ) As Long
    
    Declare Function uncompress Lib "zlib.dll" Alias "uncompress" _
            (   uncompr As Any, uncomprLen As Long, compr As Any, _
                ByVal lcompr As Long ) As Long
    
    Declare Function gzopen Lib "zlib.dll" Alias "gzopen" _
            (   zFile As Asciiz, zMode As Asciiz ) As Long
    
    Declare Function gzread Lib "zlib.dll" Alias "gzread" _
            (   ByVal file As Long, uncompr As Any, _
                ByVal uncomprLen As Long ) As Long
    
    Declare Function gzwrite Lib "zlib.dll" Alias "gzwrite" _
            (   ByVal file As Long, uncompr As Any, _
                ByVal uncomprLen As Long) As Long
    
    Declare Function gzclose Lib "zlib.dll" Alias "gzclose" _
            (   ByVal file As Long ) As Long
    
    '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    '  gzGetLastError
    '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    Function gzGetLastError() As String
       Function = g_gzLastError
    End Function
    
    '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    '  gzCompressFile
    '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    Function gzCompressFile(inFile As String, outFile As String) As Long
    
       Dim hInput As Long
       Dim hOutput As Long
       Dim iReturn As Long
       Dim i As Long
       Dim iBlocks As Long
       Dim iLeft As Long
       Dim sInput As String
    
       '- Initialize the error message
       g_gzLastError = "Success"
    
       '- The input must exist
       If Dir$(inFile) = "" Then
          g_gzLastError = "Input file " + inFile + " not found"
          GoTo gzCompresssFile_Error
       End If
    
       '- The output cannot exist
       If Dir$(outFile) <> "" Then
          g_gzLastError = "Output file: " + outFile + " already exists"
          GoTo gzCompresssFile_Error
       End If
    
       '- Tell zLib to open the output file
       hOutput = gzopen(ByCopy outFile, $Z_OPEN_WRITE)
       If hOutput = 0 Then
          g_gzLastError = "zLib is unable to open output file: " + outFile
          GoTo gzCompresssFile_Error
       End If
    
       '- Use PB to open the input file
       On Error Resume Next
       hInput = FreeFile
       Open inFile For Binary Shared As #hInput
       If Err Then
          hInput = 0
          g_gzLastError = "Unable to open input file: " + inFile + " Error =" + Str$(Err)
          GoTo gzCompresssFile_Error
       ElseIf Lof(hInput) < 1 Then
          g_gzLastError = "Input file: " + inFile + " is zero-length"
          GoTo gzCompresssFile_Error
       End If
    
       #If 0
       '- Get memory for the input buffer
       On Error Resume Next
       sInput = String$(Lof(hInput), 0)
       If Err Then
          g_gzLastError = "Error allocating " + Format$(Lof(hInput)) + " bytes of memory"
          GoTo gzCompresssFile_Error
       End If
    
       '- Fill the decompression (input) buffer with the contents
       '  of the input file.
       '
       Get #hInput,, sInput
       If Err Then
          g_gzLastError = "Error reading from: " + inFile + " Error =" + Str$(Err)
          GoTo gzCompresssFile_Error
       End If
    
       '- Compress the data to the output file
       iReturn = gzwrite(hOutput, ByVal StrPtr(sInput), Len(sInput))
       If iReturn <> Len(sInput) Then
          g_gzLastError= "Error compressing data buffer: " + Format$(iReturn)
          GoTo gzCompresssFile_Error
       End If
       #EndIf
    
       iLeft =  Lof(hInput) Mod %DECOMPRESS_BLOCK_SIZE
       iBlocks = (Lof(hInput) - iLeft) / %DECOMPRESS_BLOCK_SIZE
       sInput = Space$(%DECOMPRESS_BLOCK_SIZE)
       If Err Then
          g_gzLastError = "Error allocating " + Format$(%DECOMPRESS_BLOCK_SIZE) + " bytes of memory"
          GoTo gzCompresssFile_Error
       End If
    
       For i = 1 To iBlocks
          Get #hInput,, sInput
          If Err Then
             g_gzLastError = "Error reading from: " + inFile + " Error =" + Str$(Err)
             GoTo gzCompresssFile_Error
          End If
    
          iReturn = gzwrite(hOutput, ByVal StrPtr(sInput), Len(sInput))
          If iReturn <> Len(sInput) Then
             g_gzLastError= "Error compressing data buffer: " + Format$(iReturn)
             GoTo gzCompresssFile_Error
          End If
       Next i
    
       If iLeft > 0 Then
          sInput = Space$(iLeft)
          If Err Then
             g_gzLastError = "Error allocating " + Format$(iLeft) + " bytes of memory"
             GoTo gzCompresssFile_Error
          End If
    
          Get #hInput,, sInput
          If Err Then
             g_gzLastError = "Error reading from: " + inFile + " Error =" + Str$(Err)
             GoTo gzCompresssFile_Error
          End If
    
          iReturn = gzwrite(hOutput, ByVal StrPtr(sInput), Len(sInput))
          If iReturn <> Len(sInput) Then
             g_gzLastError= "Error compressing data buffer: " + Format$(iReturn)
             GoTo gzCompresssFile_Error
          End If
       End If
    
       '- Clean up and return OK
       '  If we make it this far, then the
       '  compression worked!
       '
       Close #hInput
       gzclose hOutput
       Function = %True
       '============
       Exit Function
       '============
    
    gzCompresssFile_Error:
       If hInput Then Close hInput
       If hOutput Then gzclose hOutput
       Function = %False
    
    End Function
    
    '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    '  gzUncompressFile
    '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    Function gzUncompressFile(compFile As String, outFile As String) As Long
    
       Dim hInput As Long
       Dim hOutput As Long
       Dim iReturn As Long
       Dim iCount As Long
       Dim sOutput As String
    
       '- Initialize the error message
       g_gzLastError = "Success"
    
       '- The input must exist
       If Dir$(compFile) = "" Then
          g_gzLastError = "Compressed file " + compFile + " not found"
          GoTo gzDecompresssFile_Error
       End If
    
       '- The output cannot exist
       If Dir$(outFile) <> "" Then
          g_gzLastError = "Output file: " + outFile + " already exists"
          GoTo gzDecompresssFile_Error
       End If
    
       '- Tell zLib to open the output file
       hInput = gzopen(ByCopy compFile, $Z_OPEN_READ)
       If hInput = 0 Then
          g_gzLastError = "zLib is unable to open compressed file: " + compFile
          GoTo gzDecompresssFile_Error
       End If
    
       '- Use PB to open the output file
       On Error Resume Next
       hOutput = FreeFile
       Open outFile For Binary As #hOutput
       If Err Then
          hOutput = 0
          g_gzLastError = "Unable to open output file: " + compFile + " Error =" + Str$(Err)
          GoTo gzDecompresssFile_Error
       End If
    
       sOutput = String$(%DECOMPRESS_BLOCK_SIZE, 0)
       Do
          iCount = iCount + 1
    
          iReturn = gzread(hInput, ByVal StrPtr(sOutput), %DECOMPRESS_BLOCK_SIZE)
          If iReturn < 1 Then
             Exit Do
          ElseIf iReturn < %DECOMPRESS_BLOCK_SIZE Then
             sOutput = Left$(sOutput, iReturn)
             Put #hOutput,, sOutput
             Exit Do
          Else
             Put #hOutput,, sOutput
          End If
          If Err Then
             g_gzLastError = "Error writing output file: " + outFile + " Error =" + Str$(Err)
             GoTo gzDecompresssFile_Error
          End If
    
       Loop
    
       '- Clean up and return OK
       '  If we make it this far, then the
       '  compression worked!
       '
       Close #hOutput
       gzclose hInput
       Function = %True
       '============
       Exit Function
       '============
    
    gzDecompresssFile_Error:
       If hOutput Then Close hOutput
       If hInput Then gzclose hInput
       Function = %False
    
    End Function
    
    '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    '  gzCompressString
    '  Compresses the string
    '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~   
    Function gzCompressString(ByVal deString As String, compString As String) As Long
    
       Dim iReturn As Long
       Dim iComp As Long
       Dim iDeComp As Long
    
       If Len(deString) < 1  Then
          Function = %False   
       Else
          
          '- Calculate and allocate the compression buffer.
          compString = String$(Len(deString) * 1.2 + 12, 0)
          iComp = Len(compString)
          iDeComp = Len(deString)
    
          '- Compress it
          iReturn = compress(ByVal StrPtr(compString), iComp, ByVal StrPtr(deString), iDeComp)
          If iReturn = %Z_OK Then
             
             '- compString will contain the length of the decompressed buffer
             '  in the first 4 bytes.
             '
             compString = MkL$(iDecomp) + Left$(compString, iComp)
             Function = %True
          Else
             compString = ""
             g_gzLastError = "Error compressing buffer. zLib err =" + Str$(iReturn)
             Function = %False
          End If
       End If
    
    End Function
    
    '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    Function gzDecompressString(ByVal compString As String, deString As String) As Long
    
       Dim iReturn As Long
       Dim iComp As Long
       Dim iDeComp As Long
       
       iComp = Len(compString)
       If iComp < 5 Then
          Function = %False
       Else
          
          '- The first 4 bytes contain the length of the decompressee string
          iDeComp = CvL(Left$(compString, 4))
          iComp = iComp - 4
          compString = mid$(compString, 5)
          
          '- Create the decompression buffer
          deString = Space$(iDeComp)
          iReturn = uncompress(ByVal StrPtr(deString), iDeComp, ByVal StrPtr(compString), iComp)
          if iReturn = %Z_OK then
             Function = %True
          else
             Function = %False
          End If
       end if
       
    End Function
    ------------------
    dickinson.basicguru.com
    Don Dickinson
    www.greatwebdivide.com
Working...
X