时间戳

首页 > 解决方案 > HeapFree 崩溃了

excel - HeapFree 崩溃了

问题描述

概括：

我有 VBA 代码，它收集大量信息并将其写入一个或多个工作表。为了提高将大量信息写入工作表的性能，我创建了一个类似于缓冲复制/粘贴流的类：调用者向它发送 CSV 格式的字符串，它在内存中缓冲，直到缓冲区已满；满时，它会粘贴到一张纸中，清除缓冲区并继续。

最初，我使用全局内存，但后来在 MSDN 上看到建议使用堆而不是全局或本地，因为开销较小。所以现在我正在使用堆。

我正在为 64 位 Office 调整一切。完成所有 PtrSafe 的工作后，我就可以运行代码了。但是现在 Excel 在HeapFree()调用时崩溃了。

问题：为什么它会崩溃，我需要改变什么来避免它？


细节：

我想出了以下是重现崩溃的最小化示例：有一个模块，sub我可以为重现和课程运行。这不做缓冲；每次调用.SendText都会将文本放在剪贴板上并粘贴到活动单元格中。

首先是模块。这有以下声明语句

' memory APIs
Public Const HEAP_ZERO_MEMORY = &H8

Declare PtrSafe Function GetProcessHeap Lib "kernel32" () As LongPtr 'returns HANDLE
Declare PtrSafe Function HeapAlloc Lib "kernel32" (ByVal hHeap As LongPtr, ByVal dwFlags As Long, ByVal dwBytes As LongPtr) As LongPtr 'returns HANDLE
Declare PtrSafe Function HeapFree Lib "kernel32" (ByVal hHeap As LongPtr, ByVal dwFlags As Long, lpMem As Any) As Long 'returns BOOL

Declare PtrSafe Function lstrcpy Lib "kernel32" Alias "lstrcpyW" (ByVal lpDestString As Any, ByVal lpSrcString As Any) As LongPtr 'returns HANDLE

' clipboard APIs
Public Const CF_UNICODETEXT = 13

Declare PtrSafe Function OpenClipboard Lib "user32" (ByVal hwnd As LongPtr) As Long 'returns BOOL
Declare PtrSafe Function EmptyClipboard Lib "user32" () As Long 'returns BOOL
Declare PtrSafe Function CloseClipboard Lib "user32" () As Long 'returns BOOL
Declare PtrSafe Function SetClipboardData Lib "user32" (ByVal wFormat As Long, ByVal hMem As LongPtr) As LongPtr   'returns HANDLE

然后sub：

Private Sub TestMemoryBugRepro()
    Dim s As String
    Dim clip As clsHeapBugRepro

    s = Chr(34) & "a" & vbLf & "b" & Chr(34) & ",c" & vbCrLf & "d" & vbTab & ",e" & vbCrLf

    Set clip = New clsHeapBugRepro
    clip.Initialize &H100
    clip.SendText s

    'Crash happens during the following
    Set clip = Nothing
End Sub


现在上课。崩溃发生在调用Class_Terminate()时。HeapFree

Option Explicit

Private m_hHeap As LongPtr 'handle to the process heap
Private m_hMem As LongPtr 'handle to memory
Private m_pMem As LongPtr 'pointer to locked memory
Private m_cbMem As Long 'size of the memory buffer
Private m_BytesWritten As Long '



'**************************************
'  Event procedures

Private Sub Class_Initialize()
    m_hHeap = GetProcessHeap()
End Sub

Private Sub Class_Terminate()
    If m_hMem <> 0 And m_hHeap <> 0 Then
        HeapFree m_hHeap, 0, m_hMem       'CRASH OCCURS HERE
    End If
End Sub


'**************************************
'  Public methods

Public Function Initialize(Optional bufferSize As Long = &H8000) As Boolean
    Initialize = False
    m_BytesWritten = 0

    If m_hHeap <> 0 Then
        m_cbMem = bufferSize
        m_hMem = HeapAlloc(m_hHeap, (HEAP_ZERO_MEMORY), m_cbMem)
    End If
    If m_hMem <> 0 Then Initialize = True
End Function


Public Function SendText(text As String) As Boolean
    Dim nStrLen As Long

    nStrLen = LenB(text) + 2&
    Debug.Assert nStrLen < (m_cbMem + m_BytesWritten)

    m_pMem = m_hMem 'in lieu of locking heap memory
    lstrcpy m_pMem, StrPtr(text)
    m_pMem = 0 'in lieu of unlocking heap memory
    m_BytesWritten = m_BytesWritten + nStrLen

    DoEvents

    OpenClipboard 0&
    EmptyClipboard
    SetClipboardData CF_UNICODETEXT, m_hMem
    CloseClipboard

    ActiveCell.PasteSpecial
    DoEvents

    SendText = True
End Function

标签： excelvbawinapi

解决方案

您如何调用 HeapFree 存在问题，但您真正的问题是您根本不应该使用 HeapAlloc/HeapFree。

HeapAlloc 分配的内存是不可移动的，而SetClipboardData 要求它是可移动的。

另一个考虑是SetClipboardData将内存的所有权转移给系统，这意味着您不应该自己释放它。（一旦所有权转移到系统，应用程序可能不会写入或释放数据。）

因此，我会尝试使用 GlobalAlloc 而不是 HeapAlloc 重写您的逻辑，并且不要在将内存放入剪贴板后尝试释放内存。

HeapFree现在，如果您要使用它，您的调用方式存在问题。HeapFree 想要返回的指针HeapAlloc。

相反，您传递了一个指向该指针的指针，因为您声明了 的第三个参数HeapFree As Any，这意味着ByRef As Any.

要么重新声明参数ByVal As LongPtr/ ByVal As Any，例如：

Declare PtrSafe Function HeapFree Lib "kernel32" (ByVal hHeap As LongPtr, _
                                                  ByVal dwFlags As Long,
                                                  ByVal lpMem As LongPtr) As Long 'returns BOOL

或ByVal在调用时指定：

HeapFree m_hHeap, 0, ByVal m_hMem

推荐阅读