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