visual-basic.txt 5.9 KB

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