Пожалуйста, помогите побороть утечку памяти в функции GZip
- Код: Выделить всё
#If VBA7 Then ' Office 2010-2016
Public Declare PtrSafe Function InitDecompression Lib "gzip.dll" () As LongPtr
Private Declare PtrSafe Function CreateDecompression Lib "gzip.dll" (ByRef context As LongPtr, ByVal flags As Long) As LongPtr
Private Declare PtrSafe Function Decompress Lib "gzip.dll" (ByVal context As LongPtr, inBytes As Any, ByVal input_size As LongPtr, _
outBytes As Any, ByVal output_size As Long, ByRef input_used As Long, ByRef output_used As Long) As LongPtr
Private Declare PtrSafe Function DestroyDecompression Lib "gzip.dll" (ByRef context As LongPtr) As LongPtr
Private Declare PtrSafe Function ResetDecompression Lib "gzip.dll" (ByVal context As LongPtr) As LongPtr
Private Declare PtrSafe Function SysAllocStringByteLen Lib "oleaut32" (ByVal Ptr As LongPtr, ByVal Length As Long) As LongPtr
Private Declare PtrSafe Sub PutMem4 Lib "msvbvm60" (ByVal Ptr As LongPtr, ByVal Value As LongPtr)
#Else ' Office 2003-2007
Public Declare Function InitDecompression Lib "gzip.dll" () As Long
Private Declare Function CreateDecompression Lib "gzip.dll" (ByRef context As Long, ByVal flags As Long) As Long
Private Declare Function Decompress Lib "gzip.dll" (ByVal context As Long, inBytes As Any, ByVal input_size As Long, _
outBytes As Any, ByVal output_size As Long, ByRef input_used As Long, ByRef output_used As Long) As Long
Private Declare Function DestroyDecompression Lib "gzip.dll" (ByRef context As Long) As Long
Private Declare Function ResetDecompression Lib "gzip.dll" (ByVal context As Long) As Long
Private Declare Function SysAllocStringByteLen Lib "oleaut32" (ByVal Ptr As Long, ByVal Length As Long) As Long
Private Declare Sub PutMem4 Lib "msvbvm60" (ByVal Ptr As Long, ByVal Value As Long)
#End If
Public Property Get GZip(ByteString As String) As String
#If VBA7 Then ' Office 2010-2016
Dim lngPos As LongPtr, lngBuffer As LongPtr, lngContext As LongPtr, lngLen As LongPtr
#Else ' Office 2003-2007
Dim lngPos As Long, lngBuffer As Long, lngContext As Long, lngLen As Long
#End If
Dim lngInUsed As Long, lngOutUsed As Long, strBuffer As String
' create a buffer of 64 kB = this is much faster than Space$(32768)
lngBuffer = SysAllocStringByteLen(0, 65536)
PutMem4 VarPtr(strBuffer), lngBuffer
' initialize GZIP decompression & get handle
InitDecompression
CreateDecompression lngContext, 1
' start position & original length
lngPos = StrPtr(ByteString)
lngLen = LenB(ByteString)
' do decompression while success
Do While 0 = Decompress(lngContext, ByVal lngPos, lngLen, ByVal lngBuffer, LenB(strBuffer), lngInUsed, lngOutUsed)
' did we get any data?
If lngOutUsed Then
' create final output string (note: String = String & String = performance bottleneck)
GZip = GZip & StrConv(LeftB$(strBuffer, lngOutUsed), vbUnicode)
End If
' reduce amount of data processed
lngLen = lngLen - lngInUsed
' exit loop if nothing more to do
If lngLen < 1 Then Exit Do
' move pointer
lngPos = lngPos + lngInUsed
Loop
' we are done, close decompression handle
ResetDecompression lngContext
' что тут добавить, чтобы исключить утечку памяти?
End Property
Private Sub gzip_test() ' утечка памяти по 10 МБ на 1000 вызовов GZip
On Error Resume Next
s$ = "123456789"
For i = 1 To 1000
txt = GZip(s$)
Next
End Sub
Гуглил несколько часов, но решения так и не нашёл (увы, в механизме работы WinAPI функций с памятью вообще не разбираюсь)
Думал применить SysFreeString, но в соседней теме нашёл ответ от Хакер, что это не поможет.
На том мои идеи кончились.
Буду весьма благодарен, если кто поможет написать недостающие пару строк кода
