~zulcss/samba/server-dailies-3.4

« back to all changes in this revision

Viewing changes to lib/zlib/old/visual-basic.txt

  • Committer: Chuck Short
  • Date: 2010-09-28 20:38:39 UTC
  • Revision ID: zulcss@ubuntu.com-20100928203839-pgjulytsi9ue63x1
Initial version

Show diffs side-by-side

added added

removed removed

Lines of Context:
 
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