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