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