|
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 |