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