+++ /dev/null
-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" <jon-net@usa.net>
-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 <c_rios@sonda.cl>, 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 <michael_borgsys@hotmail.com> 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: <parameter> [optional] {Range of possible values}
-'Call subCompressFile(<path with filename to compress> [, <path with
-filename to write to>, [level of compression {1..9}]])
-'Call subUncompressFile(<path with filename to compress>)
-
-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
git.samba.org / garming / samba-autobuild / .git / blobdiff