2017-12-15

Navigation

Skip Navigation Links

Hash algorithms

Asymmetric Algorithms

Symmetric Cipher Algorithms

Encoding Algorithms

Compression Algorithms

Pseudo Random Number Algorithms

Steganography

Library Wrappers

String Comparison

Others

Syntax highlighting by Prism
PBCrypto.com Mirror

ZLIB

Algorithm creator(s)

Jean-loup Gailly (zlib compression), Mark Adler (zlib decompression)


PB author(s)

Don Dickinson


Description

ZLIB compression/decompression library PowerBASIC wrapper.


Note

Requires zlib.dll


Source

https://forum.powerbasic.com/forum/user-to-user-discussions/source-code/23662-zlib-wrapper?t=23037


See also


Source Code

Download source code file zlib.bas (Right-click -> "Save as ...")

'  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

Mirror provided by Knuth Konrad