OpenCores
URL https://opencores.org/ocsvn/openrisc/openrisc/trunk

Subversion Repositories openrisc

[/] [openrisc/] [trunk/] [gnu-dev/] [or1k-gcc/] [zlib/] [old/] [visual-basic.txt] - Blame information for rev 866

Go to most recent revision | Details | Compare with Previous | View Log

Line No. Rev Author Line
1 745 jeremybenn
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" 
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 , 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  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:  [optional] {Range of possible values}
78
'Call subCompressFile( [, 
79
filename to write to>, [level of compression {1..9}]])
80
'Call subUncompressFile()
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

powered by: WebSVN 2.1.0

© copyright 1999-2024 OpenCores.org, equivalent to Oliscience, all rights reserved. OpenCores®, registered trademark.