Subversion Repositories scarts

See below some functions declarations for Visual Basic.

Frequently Asked Question:

Q: Each time I use the compress function I get the -5 error (not enough

   room in the output buffer).

A: Make sure that the length of the compressed buffer is passed by

   reference ("as any"), not by value ("as long"). Also check that

   before the call of compress this length is equal to the total size of

   the compressed buffer and not zero.

From: "Jon Caruana" 

Subject: Re: How to port zlib declares to vb?

Date: Mon, 28 Oct 1996 18:33:03 -0600

Got the answer! (I haven't had time to check this but it's what I got, and

looks correct):

He has the following routines working:

        compress

        uncompress

        gzopen

        gzwrite

        gzread

        gzclose

Declares follow: (Quoted from Carlos Rios , in Vb4 form)

#If Win16 Then   'Use Win16 calls.

Declare Function compress Lib "ZLIB.DLL" (ByVal compr As

        String, comprLen As Any, ByVal buf As String, ByVal buflen

        As Long) As Integer

Declare Function uncompress Lib "ZLIB.DLL" (ByVal uncompr

        As String, uncomprLen As Any, ByVal compr As String, ByVal

        lcompr As Long) As Integer

Declare Function gzopen Lib "ZLIB.DLL" (ByVal filePath As

        String, ByVal mode As String) As Long

Declare Function gzread Lib "ZLIB.DLL" (ByVal file As

        Long, ByVal uncompr As String, ByVal uncomprLen As Integer)

        As Integer

Declare Function gzwrite Lib "ZLIB.DLL" (ByVal file As

        Long, ByVal uncompr As String, ByVal uncomprLen As Integer)

        As Integer

Declare Function gzclose Lib "ZLIB.DLL" (ByVal file As

        Long) As Integer

#Else

Declare Function compress Lib "ZLIB32.DLL"

        (ByVal compr As String, comprLen As Any, ByVal buf As

        String, ByVal buflen As Long) As Integer

Declare Function uncompress Lib "ZLIB32.DLL"

        (ByVal uncompr As String, uncomprLen As Any, ByVal compr As

        String, ByVal lcompr As Long) As Long

Declare Function gzopen Lib "ZLIB32.DLL"

        (ByVal file As String, ByVal mode As String) As Long

Declare Function gzread Lib "ZLIB32.DLL"

        (ByVal file As Long, ByVal uncompr As String, ByVal

        uncomprLen As Long) As Long

Declare Function gzwrite Lib "ZLIB32.DLL"

        (ByVal file As Long, ByVal uncompr As String, ByVal

        uncomprLen As Long) As Long

Declare Function gzclose Lib "ZLIB32.DLL"

        (ByVal file As Long) As Long

#End If

-Jon Caruana

jon-net@usa.net

Microsoft Sitebuilder Network Level 1 Member - HTML Writer's Guild Member

Here is another example from Michael  that he

says conforms to the VB guidelines, and that solves the problem of not

knowing the uncompressed size by storing it at the end of the file:

'Calling the functions:

'bracket meaning:  [optional] {Range of possible values}

'Call subCompressFile( [, 

filename to write to>, [level of compression {1..9}]])

'Call subUncompressFile()

Option Explicit

Private lngpvtPcnSml As Long 'Stores value for 'lngPercentSmaller'

Private Const SUCCESS As Long = 0

Private Const strFilExt As String = ".cpr"

Private Declare Function lngfncCpr Lib "zlib.dll" Alias "compress2" (ByRef

dest As Any, ByRef destLen As Any, ByRef src As Any, ByVal srcLen As Long,

ByVal level As Integer) As Long

Private Declare Function lngfncUcp Lib "zlib.dll" Alias "uncompress" (ByRef

dest As Any, ByRef destLen As Any, ByRef src As Any, ByVal srcLen As Long)

As Long

Public Sub subCompressFile(ByVal strargOriFilPth As String, Optional ByVal

strargCprFilPth As String, Optional ByVal intLvl As Integer = 9)

    Dim strCprPth As String

    Dim lngOriSiz As Long

    Dim lngCprSiz As Long

    Dim bytaryOri() As Byte

    Dim bytaryCpr() As Byte

    lngOriSiz = FileLen(strargOriFilPth)

    ReDim bytaryOri(lngOriSiz - 1)

    Open strargOriFilPth For Binary Access Read As #1

        Get #1, , bytaryOri()

    Close #1

    strCprPth = IIf(strargCprFilPth = "", strargOriFilPth, strargCprFilPth)

'Select file path and name

    strCprPth = strCprPth & IIf(Right(strCprPth, Len(strFilExt)) =

strFilExt, "", strFilExt) 'Add file extension if not exists

    lngCprSiz = (lngOriSiz * 1.01) + 12 'Compression needs temporary a bit

more space then original file size

    ReDim bytaryCpr(lngCprSiz - 1)

    If lngfncCpr(bytaryCpr(0), lngCprSiz, bytaryOri(0), lngOriSiz, intLvl) =

SUCCESS Then

        lngpvtPcnSml = (1# - (lngCprSiz / lngOriSiz)) * 100

        ReDim Preserve bytaryCpr(lngCprSiz - 1)

        Open strCprPth For Binary Access Write As #1

            Put #1, , bytaryCpr()

            Put #1, , lngOriSiz 'Add the the original size value to the end

(last 4 bytes)

        Close #1

    Else

        MsgBox "Compression error"

    End If

    Erase bytaryCpr

    Erase bytaryOri

End Sub

Public Sub subUncompressFile(ByVal strargFilPth As String)

    Dim bytaryCpr() As Byte

    Dim bytaryOri() As Byte

    Dim lngOriSiz As Long

    Dim lngCprSiz As Long

    Dim strOriPth As String

    lngCprSiz = FileLen(strargFilPth)

    ReDim bytaryCpr(lngCprSiz - 1)

    Open strargFilPth For Binary Access Read As #1

        Get #1, , bytaryCpr()

    Close #1

    'Read the original file size value:

    lngOriSiz = bytaryCpr(lngCprSiz - 1) * (2 ^ 24) _

              + bytaryCpr(lngCprSiz - 2) * (2 ^ 16) _

              + bytaryCpr(lngCprSiz - 3) * (2 ^ 8) _

              + bytaryCpr(lngCprSiz - 4)

    ReDim Preserve bytaryCpr(lngCprSiz - 5) 'Cut of the original size value

    ReDim bytaryOri(lngOriSiz - 1)

    If lngfncUcp(bytaryOri(0), lngOriSiz, bytaryCpr(0), lngCprSiz) = SUCCESS

Then

        strOriPth = Left(strargFilPth, Len(strargFilPth) - Len(strFilExt))

        Open strOriPth For Binary Access Write As #1

            Put #1, , bytaryOri()

        Close #1

    Else

        MsgBox "Uncompression error"

    End If

    Erase bytaryCpr

    Erase bytaryOri

End Sub

Public Property Get lngPercentSmaller() As Long

    lngPercentSmaller = lngpvtPcnSml

End Property