



Давай тогда уточним. Речь идет про кирпич "Создание объектов по имени класса"? Если да, то тогда я тоже про него.arthur2 писал(а):Ни какой "частности" этого случая в коде нет.Раз это "частный случай", значит нужно понять, в чём, собственно, его частность. Если в этом частном случае утечек нет, то с чего они вдруг будут в не частном случае? Собственно, я ж для того и вопрос задаю.




Правда, тогда так и не договорил. И сейчас что-то тоже долго подогревает интригу.Хакер писал(а):ger_kar писал(а):Разница только в том,
Нет, разница в другом, касательно того аспекта, какой подметил Артур.


Public Declare Sub SaMap Lib "*" _
      (Ary() As Any, ByVal pMemory As Long, Optional ByVal newSize As Long = &HFFFFFFFF)
Private Sub m_SaMap(ByRef pSA As Long, ByVal pMemory As Long,  ByVal newSize As Long = -1)
    'Dim pSA As Long: GetMem4 ppSA, pSA  Теперь эта строка и это действие не нужны
    PutMem4 pSA + 12, ByVal pMemory: PutMem4 pSA + 16, ByVal newSize
End Sub
 







Ну или как вариант - это посмотреть в отладчике и провести эксперименты.arthur2 писал(а):Насчет обнуления адреса - ждем Хакера.


Private Declare Sub SafeArrayAllocDescriptor Lib "oleaut32.dll" _
        (ByVal cDims As Long, ppsaOut As Any)
Private Declare Sub SafeArrayDestroyDescriptor Lib "oleaut32.dll" _
        (pSA As Any)
Private Sub mAryAsPtr _
             (ByVal ppSA As Long _
            , ByVal lnElm As Long _
            , ByVal pMem As Long _
            , Optional ByVal arySize As Long = 1)
       
       Dim pSA As Long
'присылаем всегда неинициированныq массив. Создаем всегда одномерный массив.
       SafeArrayAllocDescriptor 1, ByVal ppSA 'выделяем новый дескриптор массива и память под него
       GetMem4 ppSA, pSA 'получаем дескриптор SAFEARRAY
       PutMem4 pSA + 4, lnElm 'записываем размер элемента массива
       PutMem4 pSA + 12, pMem ' адрес данных
       PutMem4 pSA + 16, arrSyze ' длинну массива
End Sub
Private Sub mAryAsPtrFree(ByVal ppSA As Long)
  Dim pSA As Long
  GetMem4 ppSA, pSA
  SafeArrayDestroyDescriptor ByVal pSA
  PutMem4 ppSA, 0
End Sub

arthur2 писал(а):Какой эксперимент провести, чтобы проверить, освободилась ли память, мне в голову не приходит.
 Запустить цикл и наблюдать. Если память потечет, то это будет заметно невооруженным глазом в том же диспетчере задач.
 Запустить цикл и наблюдать. Если память потечет, то это будет заметно невооруженным глазом в том же диспетчере задач.

Ну продемонстрируй - как запомнить старый адрес и при этом не нагромоздитьger_kar писал(а):Ну и зачем такое нагромождение? Гораздо проще и удобнее запомнить старый адрес, а затем вернуть его обратно.



arthur2 писал(а):Хакер что-то долговато не появляется




Private Declare Sub GetMem4 Lib "msvbvm60" (ByVal lpAddress As Long, dst As Any)
Private Declare Sub PutMem4 Lib "msvbvm60" (ByVal lpAddress As Long, ByVal nv As Long)
Declare Function AryPtr Lib "MSVBVM60.DLL" Alias "VarPtr" (ary() As Any) As Long
Public Type myBigType
  b(&HFF00&) As Byte
End Type
Public exitFl As Boolean
Public Sub test()
Dim s As String * 10
Dim sPtr As Long: sPtr = StrPtr(s)
Dim i As Long
Do
    For i = 0 To 1000
        mTest sPtr
    Next
    
    DoEvents
    If exitFl Then Exit Sub
Loop
End Sub
Private Sub mTest(ByVal ptMem As Long)
Dim m() As myBigType
ReDim m(0)
SaMap AryPtr(m), ptMem
SaUnmap AryPtr(m)
End Sub
Public Sub SaMap(ByVal ppSA As Long, ByVal pMemory As Long, Optional ByVal NewSize As Long = -1)
    Dim pSA As Long: GetMem4 ppSA, pSA:
    PutMem4 pSA + 12, ByVal pMemory: PutMem4 pSA + 16, ByVal NewSize
End Sub
Public Sub SaUnmap(ByVal ppSA As Long)
    Dim pSA As Long: GetMem4 ppSA, pSA
    PutMem4 pSA + 12, ByVal 0: PutMem4 pSA + 16, ByVal 0
End Sub



Private Sub mTest(ByVal ptMem As Long)
Dim m() As myBigType
ReDim m(0)
Dim oldAdr As Long
oldAdr = SaMap(AryPtr(m), ptMem)
SaUnmap AryPtr(m), oldAdr
End Sub
Public Function SaMap(ByVal ppSA As Long, ByVal pMemory As Long, Optional ByVal NewSize As Long = -1) As Long
    Dim pSA As Long: GetMem4 ppSA, pSA:
    GetMem4 pSA + 12, SaMap
    PutMem4 pSA + 12, ByVal pMemory: PutMem4 pSA + 16, ByVal NewSize
End Function 
Public Sub SaUnmap(ByVal ppSA As Long, ByVal oldAdr As Long)
    Dim pSA As Long: GetMem4 ppSA, pSA
    PutMem4 pSA + 12, ByVal oldAdr: PutMem4 pSA + 16, ByVal 1
End Sub






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