"Fossies" - the Fresh Open Source Software Archive

Member "muscle/zlib/zlib/old/visual-basic.txt" (28 Nov 2019, 6060 Bytes) of package /linux/privat/muscle7.52.zip:


As a special service "Fossies" has tried to format the requested text file into HTML format (style: standard) with prefixed line numbers. Alternatively you can here view or download the uninterpreted source code file. For more information about "visual-basic.txt" see the Fossies "Dox" file reference documentation.

    1 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" <jon-net@usa.net>
   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 <c_rios@sonda.cl>, 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 <michael_borgsys@hotmail.com> 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: <parameter> [optional] {Range of possible values}
   78 'Call subCompressFile(<path with filename to compress> [, <path with
   79 filename to write to>, [level of compression {1..9}]])
   80 'Call subUncompressFile(<path with filename to compress>)
   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