all repos — mgba @ 532261af2c689bb1fc1c722c5a58950fbaae8488

mGBA Game Boy Advance Emulator

src/third-party/zlib/old/visual-basic.txt (view raw)

  1See below some functions declarations for Visual Basic.
  2
  3Frequently Asked Question:
  4
  5Q: Each time I use the compress function I get the -5 error (not enough
  6   room in the output buffer).
  7
  8A: 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
 14From: "Jon Caruana" <jon-net@usa.net>
 15Subject: Re: How to port zlib declares to vb?
 16Date: Mon, 28 Oct 1996 18:33:03 -0600
 17
 18Got the answer! (I haven't had time to check this but it's what I got, and
 19looks correct):
 20
 21He has the following routines working:
 22        compress
 23        uncompress
 24        gzopen
 25        gzwrite
 26        gzread
 27        gzclose
 28
 29Declares follow: (Quoted from Carlos Rios <c_rios@sonda.cl>, in Vb4 form)
 30
 31#If Win16 Then   'Use Win16 calls.
 32Declare Function compress Lib "ZLIB.DLL" (ByVal compr As
 33        String, comprLen As Any, ByVal buf As String, ByVal buflen
 34        As Long) As Integer
 35Declare Function uncompress Lib "ZLIB.DLL" (ByVal uncompr
 36        As String, uncomprLen As Any, ByVal compr As String, ByVal
 37        lcompr As Long) As Integer
 38Declare Function gzopen Lib "ZLIB.DLL" (ByVal filePath As
 39        String, ByVal mode As String) As Long
 40Declare Function gzread Lib "ZLIB.DLL" (ByVal file As
 41        Long, ByVal uncompr As String, ByVal uncomprLen As Integer)
 42        As Integer
 43Declare Function gzwrite Lib "ZLIB.DLL" (ByVal file As
 44        Long, ByVal uncompr As String, ByVal uncomprLen As Integer)
 45        As Integer
 46Declare Function gzclose Lib "ZLIB.DLL" (ByVal file As
 47        Long) As Integer
 48#Else
 49Declare Function compress Lib "ZLIB32.DLL"
 50        (ByVal compr As String, comprLen As Any, ByVal buf As
 51        String, ByVal buflen As Long) As Integer
 52Declare Function uncompress Lib "ZLIB32.DLL"
 53        (ByVal uncompr As String, uncomprLen As Any, ByVal compr As
 54        String, ByVal lcompr As Long) As Long
 55Declare Function gzopen Lib "ZLIB32.DLL"
 56        (ByVal file As String, ByVal mode As String) As Long
 57Declare Function gzread Lib "ZLIB32.DLL"
 58        (ByVal file As Long, ByVal uncompr As String, ByVal
 59        uncomprLen As Long) As Long
 60Declare Function gzwrite Lib "ZLIB32.DLL"
 61        (ByVal file As Long, ByVal uncompr As String, ByVal
 62        uncomprLen As Long) As Long
 63Declare Function gzclose Lib "ZLIB32.DLL"
 64        (ByVal file As Long) As Long
 65#End If
 66
 67-Jon Caruana
 68jon-net@usa.net
 69Microsoft Sitebuilder Network Level 1 Member - HTML Writer's Guild Member
 70
 71
 72Here is another example from Michael <michael_borgsys@hotmail.com> that he
 73says conforms to the VB guidelines, and that solves the problem of not
 74knowing 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
 79filename to write to>, [level of compression {1..9}]])
 80'Call subUncompressFile(<path with filename to compress>)
 81
 82Option Explicit
 83Private lngpvtPcnSml As Long 'Stores value for 'lngPercentSmaller'
 84Private Const SUCCESS As Long = 0
 85Private Const strFilExt As String = ".cpr"
 86Private Declare Function lngfncCpr Lib "zlib.dll" Alias "compress2" (ByRef
 87dest As Any, ByRef destLen As Any, ByRef src As Any, ByVal srcLen As Long,
 88ByVal level As Integer) As Long
 89Private Declare Function lngfncUcp Lib "zlib.dll" Alias "uncompress" (ByRef
 90dest As Any, ByRef destLen As Any, ByRef src As Any, ByVal srcLen As Long)
 91As Long
 92
 93Public Sub subCompressFile(ByVal strargOriFilPth As String, Optional ByVal
 94strargCprFilPth 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)) =
108strFilExt, "", strFilExt) 'Add file extension if not exists
109    lngCprSiz = (lngOriSiz * 1.01) + 12 'Compression needs temporary a bit
110more space then original file size
111    ReDim bytaryCpr(lngCprSiz - 1)
112    If lngfncCpr(bytaryCpr(0), lngCprSiz, bytaryOri(0), lngOriSiz, intLvl) =
113SUCCESS 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
126End Sub
127
128Public 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
147Then
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
157End Sub
158Public Property Get lngPercentSmaller() As Long
159    lngPercentSmaller = lngpvtPcnSml
160End Property