Утечка памяти в функции SysAllocString

Программирование на Visual Basic, главный форум. Обсуждение тем программирования на VB 1—6.
Даже если вы плохо разбираетесь в VB и программировании вообще — тут вам помогут. В разумных пределах, конечно.
Правила форума
Темы, в которых будет сначала написано «что нужно сделать», а затем просьба «помогите», будут закрыты.
Читайте требования к создаваемым темам.
EducatedFool
Начинающий
Начинающий
Аватара пользователя
 
Сообщения: 10
Зарегистрирован: 21.02.2009 (Сб) 10:30
Откуда: Россия, Урал

Утечка памяти в функции SysAllocString

Сообщение EducatedFool » 25.04.2018 (Ср) 17:35

Всем привет
Пожалуйста, помогите побороть утечку памяти в функции 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, но в соседней теме нашёл ответ от Хакер, что это не поможет.
На том мои идеи кончились.
Буду весьма благодарен, если кто поможет написать недостающие пару строк кода

Хакер
Телепат
Телепат
Аватара пользователя
 
Сообщения: 16473
Зарегистрирован: 13.11.2005 (Вс) 2:43
Откуда: Казахстан, Петропавловск

Re: Утечка памяти в функции SysAllocString

Сообщение Хакер » 25.04.2018 (Ср) 20:52

Любые жалобы на утечку памяти охватывают не какой-то код, а всю совокупность задействованных модулей. И в частности это касается модуля gzip.dll — без выкладывания этой библиотеки какой может быть разбирательство, может быть утечка именно в этой библиотеке и нужно искать другую версию?

Вне зависимости от утечки, код довольно-таки гаденький.

Вообще не вижу смысла иметь этот геморрой с SysAllocStringByteLen и PutMem4. Строковый пул — ресурс дефицитный. Он конечно довольно-таки большой, но исчерпан он будет раньше, чем память вообще. И рассчитан он на работу большого числа относительно небольших фрагментов разного размера, который хаотично освобождаются/выделяются. А здесь константный размер — 64K. Который никогда не наращивается. И к тому же нигде нет проверки на то, что вернулся SysAllocStringByteLen. Может она вернула 0? Не знаю, есть ли там проверка в Decompress, если нет — нас ждёт весёлый вылет.

А можно было бы воспользоваться байт-массивом фиксированного размера, объвленного с ключевым словом Static.

Отдельный вопрос:
Код: Выделить всё
GZip = GZip & StrConv(LeftB$(strBuffer, lngOutUsed), vbUnicode)


Во-первых, тут заложена мина. Это совершенно вредная перекодировка. Начиная от того, что никому эта перекодировка на самом деле не нужна, и заканчивая тем, что нет гарантии, что обратная перекодировка (а она где-то будет обязательна) даст результат, идентичный первоначальной строке до перекодировки. Т.е. в зависимости от локали результат сжатия может где-то по пути искажаться.

Во-вторых, даже закрыв глаза на всё это, глупо конвертировать кусочки и затем склеивать их: гораздо эффективнее склеить кусочки, а затем сконвертировать результат склейки одним махом. При конвертации выделяется новая строка из строкового пула, а любые выделения памяти как правило являются медленными и дорогими операциями, а здесь конвертация делается много раз помаленьку. Вдобавок к этому вдвое увеличиваются объём данных, подлежащих конкатенации. Хотя, повторяюсь, конвертация ни к чему хорошему тут. Она вообще не нужна.
—We separate their smiling faces from the rest of their body, Captain.
—That's right! We decapitate them.

EducatedFool
Начинающий
Начинающий
Аватара пользователя
 
Сообщения: 10
Зарегистрирован: 21.02.2009 (Сб) 10:30
Откуда: Россия, Урал

Re: Утечка памяти в функции SysAllocString

Сообщение EducatedFool » 25.04.2018 (Ср) 22:33

Хакер, спасибо за ответ!

Попробовал переделать, — но теперь памяти утекает в 3-4 раза больше, чем в предыдущем варианте
Подскажите, пожалуйста, что я сделал не так?

Код: Выделить всё
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)

Public Property Get GZip(ByteString As String) As String
    Dim lngPos As Long, lngBuffer As Long, lngContext As Long, lngLen As Long
    Dim lngInUsed As Long, lngOutUsed As Long


    Static strBuffer(0 To 65535) As Byte    ' create a buffer of 64 kB
    lngBuffer = StrPtr(strBuffer)

    'lngBuffer = SysAllocStringByteLen(0, 65536)
    'PutMem4 VarPtr(strBuffer), lngBuffer

    InitDecompression    ' initialize GZIP decompression & get handle

    CreateDecompression lngContext, 1
   
    lngPos = StrPtr(ByteString) ' start position & original length
    lngLen = LenB(ByteString)
   
    ' do decompression while success
    Do While 0 = Decompress(lngContext, ByVal lngPos, lngLen, ByVal lngBuffer, 65536, lngInUsed, lngOutUsed)
        ' did we get any data?
        If lngOutUsed Then
            GZip = GZip & LeftB$(strBuffer, lngOutUsed) ' create final output string
        End If
       
        lngLen = lngLen - lngInUsed ' reduce amount of data processed
        If lngLen < 1 Then Exit Do ' exit loop if nothing more to do
        lngPos = lngPos + lngInUsed ' move pointer
    Loop
   
    ResetDecompression lngContext ' we are done, close decompression handle

    Erase strBuffer
End Property

Хакер
Телепат
Телепат
Аватара пользователя
 
Сообщения: 16473
Зарегистрирован: 13.11.2005 (Вс) 2:43
Откуда: Казахстан, Петропавловск

Re: Утечка памяти в функции SysAllocString

Сообщение Хакер » 26.04.2018 (Чт) 7:22

Ещё раз: выкладывай gzip.dll, чтобы я мог погонять и найти утечку.

Код: Выделить всё
    Static strBuffer(0 To 65535) As Byte    ' create a buffer of 64 kB
    lngBuffer = StrPtr(strBuffer)


Бессмыслица. Переменная lngBuffer не нужна. В данном случае вместо массива будет создана строковая копия с его представлением, которая тут же умрёт, а в переменную lngBuffer попадёт указатель на уже несуществующую строку (и чисто по стечению обстоятельств эта область памяти никем не начинает использоваться для других нужд и ничего не падает, но в принципе такой исход возможен). Нужно вместо ByVal lngBuffer передавать strBuffer(0).

Числа 65535 и 65536 хардкодом — это дурной тон. Надо ввести локальную константу.

И вообще, подозреваю, даже не глядя на библиотеку, что в конце процедуры вместо ResetDecompression следовало использовать DestroyDecompression — отсюда и утечка памяти. Правильно ли она объявлена, кстати, под вопросом.
—We separate their smiling faces from the rest of their body, Captain.
—That's right! We decapitate them.

EducatedFool
Начинающий
Начинающий
Аватара пользователя
 
Сообщения: 10
Зарегистрирован: 21.02.2009 (Сб) 10:30
Откуда: Россия, Урал

Re: Утечка памяти в функции SysAllocString

Сообщение EducatedFool » 13.05.2018 (Вс) 1:51

что в конце процедуры вместо ResetDecompression следовало использовать DestroyDecompression — отсюда и утечка памяти.

попробовал добавить DestroyDecompression (и вместо ResetDecompression, и вместе с ней) — разницы нет, такая же утечка

Код и библиотеку взял здесь:
http://www.vbforums.com/showthread.php? ... ost3791670
Файл библиотеки прикрепил к сообщению в архиве

Вообще, думал, что DLL не придется таскать с проектом (проект на VBA), т.к. есть одноимённая библиотека в составе Windows
Но как пользоваться имеющейся в Windows библиотекой gzip.dll — не понял (там, скорее всего, другая библиотека), с ней не работает

PS: готов заплатить за решение в виде кода, не дающее утечки памяти
Вложения
gzip.zip
(18.05 Кб) Скачиваний: 147

Teranas
Бывалый
Бывалый
Аватара пользователя
 
Сообщения: 224
Зарегистрирован: 13.12.2008 (Сб) 4:26
Откуда: Новосибирск

Re: Утечка памяти в функции SysAllocString

Сообщение Teranas » 13.05.2018 (Вс) 11:34

Прежде чем платить, можно просто изучить свой код...
И понять что память выделяемая SysAllocStringByteLen не освобождается в конце процедуры функцией SysFreeString, плюс согласен с замечаниями Хакера, много в этом коде г...
И почитай внимательно это:
SysAllocStringByteLen
Принимает на входе строку ANSI и возвращает содержащую ее BSTR. Не выполняет никаких преобразований ANSI-Unicode.

BSTR SysAllocStringByteLen(
char FAR* psz,
unsigned int len
);
Параметры:

psz - Заканчивающаяся нулем строка, которую нужно скопировать, или NULL, если новая строка должна остаться неинициализированной.
len - Число байт, которые нужно скопировать из psz. После скопированных символов добавляется нулевой символ, т. е. всего выделяется len +1 байт.
Выделяет новую строку длиной в len байт, копирует в нее len байт из исходной строки и затем добавляет к концу нулевой символ. Имеется только в 32-разрядных системах.


Возвращаемое значение:
Указатель на копию строки или NULL, если не хватает памяти.

Комментарии:
Эта функция предназначена для создания BSTR, содержащих двоичные данные. Вы можете использовать BSTR такого типа только в тех случаях, если они не будут транслироваться из ANSI в Unicode или наоборот.
Например, не используйте такие BSTR для обмена информацией между 16- и 32-разрядными приложениями, выполняющимися под управлением 32-разрядной Windows. Слой OLE, обеспечивающий взаимодействие 16—32 (и 32—16), транслирует BSTR и разрушит двоичные данные. Для передачи двоичных данных рекомендуется использовать SAFEARRAY типа VT_UI1, который не транслируется OLE.
Если psz равен NULL, то строка заданной длины выделяется, но не инициализируется. Строка psz может содержать внутри нулевые символы и не обязана заканчиваться таким символом. Для освобождения полученной строки используйте SysFreeString.


Код: Выделить всё
  '*********************************************************************
  Private Declare Sub SysFreeString lib "oleaut32" (ByRef bstr As Long)
  '*********************************************************************

#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
#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
   
    '**************************************
    SysFreeString lngBuffer
    '**************************************
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
С уважением, Андрей.

EducatedFool
Начинающий
Начинающий
Аватара пользователя
 
Сообщения: 10
Зарегистрирован: 21.02.2009 (Сб) 10:30
Откуда: Россия, Урал

Re: Утечка памяти в функции SysAllocString

Сообщение EducatedFool » 22.05.2018 (Вт) 3:53

Андрей, спасибо за участие в теме
Я бы не предлагал заплатить, если бы хоть немного понимал, как это всё работает (я про функции WinAPI и работу с памятью)
Не все тут на форуме специалисты вашего уровня..

Увы, теперь Excel вылетает на строке SysFreeString lngBuffer
(не ошибка вылетает, а Excel аварийно завершает работу)
а вызов Decompress возвращает что-то ненулевое, т.е. условие Do While 0 = Decompress(...) не выполняется ни разу

много в этом коде г...

да кто ж спорит-то
только вы видите это г.., а я не вижу, ибо не умею отличать г от не г

неужели никому из спецов деньги не нужны?
тут 20 строк кода, я готов платить за то, чтобы из кода убрали лишнее, и он работал в VBA без сбоев и утечки памяти
(я, конечно, могу потратить пару месяцев, и вникнуть в механизмы работы со строками и с памятью из VB, - но мне жалко времени столько на один кусок кода, потому, проще заплатить)
Вложения
ExcelMacroFile_and_DLL.zip
Файл Excel с кодом, и DLL - извлекать в одну папку
(44.62 Кб) Скачиваний: 128

Teranas
Бывалый
Бывалый
Аватара пользователя
 
Сообщения: 224
Зарегистрирован: 13.12.2008 (Сб) 4:26
Откуда: Новосибирск

Re: Утечка памяти в функции SysAllocString

Сообщение Teranas » 23.05.2018 (Ср) 5:27

На Office 10-16 не проверял, у меня просто нет таких.
Утечку памяти устранил, код переписал.
Проверил на Office 3, всё работает.
Вложения
gzip_.zip
Переделанный, без течки
(55.4 Кб) Скачиваний: 137
С уважением, Андрей.

EducatedFool
Начинающий
Начинающий
Аватара пользователя
 
Сообщения: 10
Зарегистрирован: 21.02.2009 (Сб) 10:30
Откуда: Россия, Урал

Re: Утечка памяти в функции SysAllocString

Сообщение EducatedFool » 23.05.2018 (Ср) 16:10

Андрей, спасибо большое, всё отлично работает
Написал в ЛС


Вернуться в Visual Basic 1–6

Кто сейчас на конференции

Сейчас этот форум просматривают: AhrefsBot и гости: 9

    TopList  
cron