' ' 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