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