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