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