annotate src/zlib-1.2.8/old/visual-basic.txt @ 43:5ea0608b923f

Current zlib source
author Chris Cannam
date Tue, 18 Oct 2016 14:33:52 +0100
parents
children
rev   line source
Chris@43 1 See below some functions declarations for Visual Basic.
Chris@43 2
Chris@43 3 Frequently Asked Question:
Chris@43 4
Chris@43 5 Q: Each time I use the compress function I get the -5 error (not enough
Chris@43 6 room in the output buffer).
Chris@43 7
Chris@43 8 A: Make sure that the length of the compressed buffer is passed by
Chris@43 9 reference ("as any"), not by value ("as long"). Also check that
Chris@43 10 before the call of compress this length is equal to the total size of
Chris@43 11 the compressed buffer and not zero.
Chris@43 12
Chris@43 13
Chris@43 14 From: "Jon Caruana" <jon-net@usa.net>
Chris@43 15 Subject: Re: How to port zlib declares to vb?
Chris@43 16 Date: Mon, 28 Oct 1996 18:33:03 -0600
Chris@43 17
Chris@43 18 Got the answer! (I haven't had time to check this but it's what I got, and
Chris@43 19 looks correct):
Chris@43 20
Chris@43 21 He has the following routines working:
Chris@43 22 compress
Chris@43 23 uncompress
Chris@43 24 gzopen
Chris@43 25 gzwrite
Chris@43 26 gzread
Chris@43 27 gzclose
Chris@43 28
Chris@43 29 Declares follow: (Quoted from Carlos Rios <c_rios@sonda.cl>, in Vb4 form)
Chris@43 30
Chris@43 31 #If Win16 Then 'Use Win16 calls.
Chris@43 32 Declare Function compress Lib "ZLIB.DLL" (ByVal compr As
Chris@43 33 String, comprLen As Any, ByVal buf As String, ByVal buflen
Chris@43 34 As Long) As Integer
Chris@43 35 Declare Function uncompress Lib "ZLIB.DLL" (ByVal uncompr
Chris@43 36 As String, uncomprLen As Any, ByVal compr As String, ByVal
Chris@43 37 lcompr As Long) As Integer
Chris@43 38 Declare Function gzopen Lib "ZLIB.DLL" (ByVal filePath As
Chris@43 39 String, ByVal mode As String) As Long
Chris@43 40 Declare Function gzread Lib "ZLIB.DLL" (ByVal file As
Chris@43 41 Long, ByVal uncompr As String, ByVal uncomprLen As Integer)
Chris@43 42 As Integer
Chris@43 43 Declare Function gzwrite Lib "ZLIB.DLL" (ByVal file As
Chris@43 44 Long, ByVal uncompr As String, ByVal uncomprLen As Integer)
Chris@43 45 As Integer
Chris@43 46 Declare Function gzclose Lib "ZLIB.DLL" (ByVal file As
Chris@43 47 Long) As Integer
Chris@43 48 #Else
Chris@43 49 Declare Function compress Lib "ZLIB32.DLL"
Chris@43 50 (ByVal compr As String, comprLen As Any, ByVal buf As
Chris@43 51 String, ByVal buflen As Long) As Integer
Chris@43 52 Declare Function uncompress Lib "ZLIB32.DLL"
Chris@43 53 (ByVal uncompr As String, uncomprLen As Any, ByVal compr As
Chris@43 54 String, ByVal lcompr As Long) As Long
Chris@43 55 Declare Function gzopen Lib "ZLIB32.DLL"
Chris@43 56 (ByVal file As String, ByVal mode As String) As Long
Chris@43 57 Declare Function gzread Lib "ZLIB32.DLL"
Chris@43 58 (ByVal file As Long, ByVal uncompr As String, ByVal
Chris@43 59 uncomprLen As Long) As Long
Chris@43 60 Declare Function gzwrite Lib "ZLIB32.DLL"
Chris@43 61 (ByVal file As Long, ByVal uncompr As String, ByVal
Chris@43 62 uncomprLen As Long) As Long
Chris@43 63 Declare Function gzclose Lib "ZLIB32.DLL"
Chris@43 64 (ByVal file As Long) As Long
Chris@43 65 #End If
Chris@43 66
Chris@43 67 -Jon Caruana
Chris@43 68 jon-net@usa.net
Chris@43 69 Microsoft Sitebuilder Network Level 1 Member - HTML Writer's Guild Member
Chris@43 70
Chris@43 71
Chris@43 72 Here is another example from Michael <michael_borgsys@hotmail.com> that he
Chris@43 73 says conforms to the VB guidelines, and that solves the problem of not
Chris@43 74 knowing the uncompressed size by storing it at the end of the file:
Chris@43 75
Chris@43 76 'Calling the functions:
Chris@43 77 'bracket meaning: <parameter> [optional] {Range of possible values}
Chris@43 78 'Call subCompressFile(<path with filename to compress> [, <path with
Chris@43 79 filename to write to>, [level of compression {1..9}]])
Chris@43 80 'Call subUncompressFile(<path with filename to compress>)
Chris@43 81
Chris@43 82 Option Explicit
Chris@43 83 Private lngpvtPcnSml As Long 'Stores value for 'lngPercentSmaller'
Chris@43 84 Private Const SUCCESS As Long = 0
Chris@43 85 Private Const strFilExt As String = ".cpr"
Chris@43 86 Private Declare Function lngfncCpr Lib "zlib.dll" Alias "compress2" (ByRef
Chris@43 87 dest As Any, ByRef destLen As Any, ByRef src As Any, ByVal srcLen As Long,
Chris@43 88 ByVal level As Integer) As Long
Chris@43 89 Private Declare Function lngfncUcp Lib "zlib.dll" Alias "uncompress" (ByRef
Chris@43 90 dest As Any, ByRef destLen As Any, ByRef src As Any, ByVal srcLen As Long)
Chris@43 91 As Long
Chris@43 92
Chris@43 93 Public Sub subCompressFile(ByVal strargOriFilPth As String, Optional ByVal
Chris@43 94 strargCprFilPth As String, Optional ByVal intLvl As Integer = 9)
Chris@43 95 Dim strCprPth As String
Chris@43 96 Dim lngOriSiz As Long
Chris@43 97 Dim lngCprSiz As Long
Chris@43 98 Dim bytaryOri() As Byte
Chris@43 99 Dim bytaryCpr() As Byte
Chris@43 100 lngOriSiz = FileLen(strargOriFilPth)
Chris@43 101 ReDim bytaryOri(lngOriSiz - 1)
Chris@43 102 Open strargOriFilPth For Binary Access Read As #1
Chris@43 103 Get #1, , bytaryOri()
Chris@43 104 Close #1
Chris@43 105 strCprPth = IIf(strargCprFilPth = "", strargOriFilPth, strargCprFilPth)
Chris@43 106 'Select file path and name
Chris@43 107 strCprPth = strCprPth & IIf(Right(strCprPth, Len(strFilExt)) =
Chris@43 108 strFilExt, "", strFilExt) 'Add file extension if not exists
Chris@43 109 lngCprSiz = (lngOriSiz * 1.01) + 12 'Compression needs temporary a bit
Chris@43 110 more space then original file size
Chris@43 111 ReDim bytaryCpr(lngCprSiz - 1)
Chris@43 112 If lngfncCpr(bytaryCpr(0), lngCprSiz, bytaryOri(0), lngOriSiz, intLvl) =
Chris@43 113 SUCCESS Then
Chris@43 114 lngpvtPcnSml = (1# - (lngCprSiz / lngOriSiz)) * 100
Chris@43 115 ReDim Preserve bytaryCpr(lngCprSiz - 1)
Chris@43 116 Open strCprPth For Binary Access Write As #1
Chris@43 117 Put #1, , bytaryCpr()
Chris@43 118 Put #1, , lngOriSiz 'Add the the original size value to the end
Chris@43 119 (last 4 bytes)
Chris@43 120 Close #1
Chris@43 121 Else
Chris@43 122 MsgBox "Compression error"
Chris@43 123 End If
Chris@43 124 Erase bytaryCpr
Chris@43 125 Erase bytaryOri
Chris@43 126 End Sub
Chris@43 127
Chris@43 128 Public Sub subUncompressFile(ByVal strargFilPth As String)
Chris@43 129 Dim bytaryCpr() As Byte
Chris@43 130 Dim bytaryOri() As Byte
Chris@43 131 Dim lngOriSiz As Long
Chris@43 132 Dim lngCprSiz As Long
Chris@43 133 Dim strOriPth As String
Chris@43 134 lngCprSiz = FileLen(strargFilPth)
Chris@43 135 ReDim bytaryCpr(lngCprSiz - 1)
Chris@43 136 Open strargFilPth For Binary Access Read As #1
Chris@43 137 Get #1, , bytaryCpr()
Chris@43 138 Close #1
Chris@43 139 'Read the original file size value:
Chris@43 140 lngOriSiz = bytaryCpr(lngCprSiz - 1) * (2 ^ 24) _
Chris@43 141 + bytaryCpr(lngCprSiz - 2) * (2 ^ 16) _
Chris@43 142 + bytaryCpr(lngCprSiz - 3) * (2 ^ 8) _
Chris@43 143 + bytaryCpr(lngCprSiz - 4)
Chris@43 144 ReDim Preserve bytaryCpr(lngCprSiz - 5) 'Cut of the original size value
Chris@43 145 ReDim bytaryOri(lngOriSiz - 1)
Chris@43 146 If lngfncUcp(bytaryOri(0), lngOriSiz, bytaryCpr(0), lngCprSiz) = SUCCESS
Chris@43 147 Then
Chris@43 148 strOriPth = Left(strargFilPth, Len(strargFilPth) - Len(strFilExt))
Chris@43 149 Open strOriPth For Binary Access Write As #1
Chris@43 150 Put #1, , bytaryOri()
Chris@43 151 Close #1
Chris@43 152 Else
Chris@43 153 MsgBox "Uncompression error"
Chris@43 154 End If
Chris@43 155 Erase bytaryCpr
Chris@43 156 Erase bytaryOri
Chris@43 157 End Sub
Chris@43 158 Public Property Get lngPercentSmaller() As Long
Chris@43 159 lngPercentSmaller = lngpvtPcnSml
Chris@43 160 End Property