mirror of
https://github.com/VCMP-SqMod/SqMod.git
synced 2024-11-14 11:47:15 +01:00
161 lines
5.9 KiB
Plaintext
161 lines
5.9 KiB
Plaintext
See below some functions declarations for Visual Basic.
|
|
|
|
Frequently Asked Question:
|
|
|
|
Q: Each time I use the compress function I get the -5 error (not enough
|
|
room in the output buffer).
|
|
|
|
A: Make sure that the length of the compressed buffer is passed by
|
|
reference ("as any"), not by value ("as long"). Also check that
|
|
before the call of compress this length is equal to the total size of
|
|
the compressed buffer and not zero.
|
|
|
|
|
|
From: "Jon Caruana" <jon-net@usa.net>
|
|
Subject: Re: How to port zlib declares to vb?
|
|
Date: Mon, 28 Oct 1996 18:33:03 -0600
|
|
|
|
Got the answer! (I haven't had time to check this but it's what I got, and
|
|
looks correct):
|
|
|
|
He has the following routines working:
|
|
compress
|
|
uncompress
|
|
gzopen
|
|
gzwrite
|
|
gzread
|
|
gzclose
|
|
|
|
Declares follow: (Quoted from Carlos Rios <c_rios@sonda.cl>, in Vb4 form)
|
|
|
|
#If Win16 Then 'Use Win16 calls.
|
|
Declare Function compress Lib "ZLIB.DLL" (ByVal compr As
|
|
String, comprLen As Any, ByVal buf As String, ByVal buflen
|
|
As Long) As Integer
|
|
Declare Function uncompress Lib "ZLIB.DLL" (ByVal uncompr
|
|
As String, uncomprLen As Any, ByVal compr As String, ByVal
|
|
lcompr As Long) As Integer
|
|
Declare Function gzopen Lib "ZLIB.DLL" (ByVal filePath As
|
|
String, ByVal mode As String) As Long
|
|
Declare Function gzread Lib "ZLIB.DLL" (ByVal file As
|
|
Long, ByVal uncompr As String, ByVal uncomprLen As Integer)
|
|
As Integer
|
|
Declare Function gzwrite Lib "ZLIB.DLL" (ByVal file As
|
|
Long, ByVal uncompr As String, ByVal uncomprLen As Integer)
|
|
As Integer
|
|
Declare Function gzclose Lib "ZLIB.DLL" (ByVal file As
|
|
Long) As Integer
|
|
#Else
|
|
Declare Function compress Lib "ZLIB32.DLL"
|
|
(ByVal compr As String, comprLen As Any, ByVal buf As
|
|
String, ByVal buflen As Long) As Integer
|
|
Declare Function uncompress Lib "ZLIB32.DLL"
|
|
(ByVal uncompr As String, uncomprLen As Any, ByVal compr As
|
|
String, ByVal lcompr As Long) As Long
|
|
Declare Function gzopen Lib "ZLIB32.DLL"
|
|
(ByVal file As String, ByVal mode As String) As Long
|
|
Declare Function gzread Lib "ZLIB32.DLL"
|
|
(ByVal file As Long, ByVal uncompr As String, ByVal
|
|
uncomprLen As Long) As Long
|
|
Declare Function gzwrite Lib "ZLIB32.DLL"
|
|
(ByVal file As Long, ByVal uncompr As String, ByVal
|
|
uncomprLen As Long) As Long
|
|
Declare Function gzclose Lib "ZLIB32.DLL"
|
|
(ByVal file As Long) As Long
|
|
#End If
|
|
|
|
-Jon Caruana
|
|
jon-net@usa.net
|
|
Microsoft Sitebuilder Network Level 1 Member - HTML Writer's Guild Member
|
|
|
|
|
|
Here is another example from Michael <michael_borgsys@hotmail.com> that he
|
|
says conforms to the VB guidelines, and that solves the problem of not
|
|
knowing the uncompressed size by storing it at the end of the file:
|
|
|
|
'Calling the functions:
|
|
'bracket meaning: <parameter> [optional] {Range of possible values}
|
|
'Call subCompressFile(<path with filename to compress> [, <path with
|
|
filename to write to>, [level of compression {1..9}]])
|
|
'Call subUncompressFile(<path with filename to compress>)
|
|
|
|
Option Explicit
|
|
Private lngpvtPcnSml As Long 'Stores value for 'lngPercentSmaller'
|
|
Private Const SUCCESS As Long = 0
|
|
Private Const strFilExt As String = ".cpr"
|
|
Private Declare Function lngfncCpr Lib "zlib.dll" Alias "compress2" (ByRef
|
|
dest As Any, ByRef destLen As Any, ByRef src As Any, ByVal srcLen As Long,
|
|
ByVal level As Integer) As Long
|
|
Private Declare Function lngfncUcp Lib "zlib.dll" Alias "uncompress" (ByRef
|
|
dest As Any, ByRef destLen As Any, ByRef src As Any, ByVal srcLen As Long)
|
|
As Long
|
|
|
|
Public Sub subCompressFile(ByVal strargOriFilPth As String, Optional ByVal
|
|
strargCprFilPth As String, Optional ByVal intLvl As Integer = 9)
|
|
Dim strCprPth As String
|
|
Dim lngOriSiz As Long
|
|
Dim lngCprSiz As Long
|
|
Dim bytaryOri() As Byte
|
|
Dim bytaryCpr() As Byte
|
|
lngOriSiz = FileLen(strargOriFilPth)
|
|
ReDim bytaryOri(lngOriSiz - 1)
|
|
Open strargOriFilPth For Binary Access Read As #1
|
|
Get #1, , bytaryOri()
|
|
Close #1
|
|
strCprPth = IIf(strargCprFilPth = "", strargOriFilPth, strargCprFilPth)
|
|
'Select file path and name
|
|
strCprPth = strCprPth & IIf(Right(strCprPth, Len(strFilExt)) =
|
|
strFilExt, "", strFilExt) 'Add file extension if not exists
|
|
lngCprSiz = (lngOriSiz * 1.01) + 12 'Compression needs temporary a bit
|
|
more space then original file size
|
|
ReDim bytaryCpr(lngCprSiz - 1)
|
|
If lngfncCpr(bytaryCpr(0), lngCprSiz, bytaryOri(0), lngOriSiz, intLvl) =
|
|
SUCCESS Then
|
|
lngpvtPcnSml = (1# - (lngCprSiz / lngOriSiz)) * 100
|
|
ReDim Preserve bytaryCpr(lngCprSiz - 1)
|
|
Open strCprPth For Binary Access Write As #1
|
|
Put #1, , bytaryCpr()
|
|
Put #1, , lngOriSiz 'Add the the original size value to the end
|
|
(last 4 bytes)
|
|
Close #1
|
|
Else
|
|
MsgBox "Compression error"
|
|
End If
|
|
Erase bytaryCpr
|
|
Erase bytaryOri
|
|
End Sub
|
|
|
|
Public Sub subUncompressFile(ByVal strargFilPth As String)
|
|
Dim bytaryCpr() As Byte
|
|
Dim bytaryOri() As Byte
|
|
Dim lngOriSiz As Long
|
|
Dim lngCprSiz As Long
|
|
Dim strOriPth As String
|
|
lngCprSiz = FileLen(strargFilPth)
|
|
ReDim bytaryCpr(lngCprSiz - 1)
|
|
Open strargFilPth For Binary Access Read As #1
|
|
Get #1, , bytaryCpr()
|
|
Close #1
|
|
'Read the original file size value:
|
|
lngOriSiz = bytaryCpr(lngCprSiz - 1) * (2 ^ 24) _
|
|
+ bytaryCpr(lngCprSiz - 2) * (2 ^ 16) _
|
|
+ bytaryCpr(lngCprSiz - 3) * (2 ^ 8) _
|
|
+ bytaryCpr(lngCprSiz - 4)
|
|
ReDim Preserve bytaryCpr(lngCprSiz - 5) 'Cut of the original size value
|
|
ReDim bytaryOri(lngOriSiz - 1)
|
|
If lngfncUcp(bytaryOri(0), lngOriSiz, bytaryCpr(0), lngCprSiz) = SUCCESS
|
|
Then
|
|
strOriPth = Left(strargFilPth, Len(strargFilPth) - Len(strFilExt))
|
|
Open strOriPth For Binary Access Write As #1
|
|
Put #1, , bytaryOri()
|
|
Close #1
|
|
Else
|
|
MsgBox "Uncompression error"
|
|
End If
|
|
Erase bytaryCpr
|
|
Erase bytaryOri
|
|
End Sub
|
|
Public Property Get lngPercentSmaller() As Long
|
|
lngPercentSmaller = lngpvtPcnSml
|
|
End Property
|