VB6安全子类化，关闭IDE数据丢失，SetProp写入数据

在 VB6 中使用SetProp保存大段数据（如RectArray数组）时，直接存储可能因数据结构复杂或体积较大导致问题，且 VB6 IDE 强制关闭会丢失数据（因为SetProp的属性是关联到窗口句柄的，窗口销毁后属性也会释放）。以下是具体解决方案：

一、为什么直接存储会有问题？

1. SetProp的限制 ：hData参数只能接收Long类型（32 位整数），无法直接存储数组或结构体，必须通过 "指针" 间接引用数据。
2. 数据持久性问题 ：SetProp存储的是窗口句柄关联的临时属性，窗口关闭（或 IDE 强制关闭导致窗口销毁）后，属性会被系统自动释放，数据丢失是必然的。

二、正确保存大段数据的方法（使用 API 申请内存）

核心思路：用 API 在堆中申请一块内存，将数据复制到内存中，再把内存地址（指针）通过SetProp关联到窗口句柄。步骤如下：

1. 声明必要的 API（内存操作）

' 申请堆内存
Public Declare Function GlobalAlloc Lib "kernel32" (ByVal wFlags As Long, ByVal dwBytes As Long) As Long
' 锁定内存并返回指针（32位系统）
Public Declare Function GlobalLock Lib "kernel32" (ByVal hMem As Long) As Long
' 解锁内存
Public Declare Function GlobalUnlock Lib "kernel32" (ByVal hMem As Long) As Long
' 释放堆内存
Public Declare Function GlobalFree Lib "kernel32" (ByVal hMem As Long) As Long
' 内存复制（用于将数组数据写入申请的内存）
Public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" ( _
    ByVal Destination As Long, _
    ByRef Source As Any, _
    ByVal Length As Long _
)

2. 将数组数据写入堆内存，并通过SetProp保存

Sub SaveRectArrayToProp(ByVal hWnd As Long, ByVal propName As String, arr() As Rect)
    Dim arrSize As Long, hMem As Long, pMem As Long
    Dim elemCount As Long
    
    ' 计算数组元素数量和总字节数（每个Rect占4个Long，共16字节）
    elemCount = UBound(arr) - LBound(arr) + 1
    arrSize = elemCount * LenB(arr(0))  ' LenB返回单个元素的字节数
    
    ' 1. 申请内存（GMEM_FIXED = &H0，表示固定内存，返回值即指针）
    hMem = GlobalAlloc(&H0, arrSize)
    If hMem = 0 Then
        MsgBox "内存申请失败"
        Exit Sub
    End If
    
    ' 2. 锁定内存并获取指针（32位系统中GlobalLock返回的就是可用指针）
    pMem = GlobalLock(hMem)
    If pMem = 0 Then
        GlobalFree hMem  ' 失败则释放内存
        MsgBox "内存锁定失败"
        Exit Sub
    End If
    
    ' 3. 将数组数据复制到内存块（从数组首地址复制到pMem指向的内存）
    CopyMemory pMem, arr(LBound(arr)), arrSize
    
    ' 4. 解锁内存（必须解锁，否则可能导致内存泄漏）
    GlobalUnlock hMem
    
    ' 5. 通过SetProp保存内存指针（hData参数传入内存块的指针hMem）
    If Not SetProp(hWnd, propName, hMem) Then
        GlobalFree hMem  ' 保存失败则释放内存
        MsgBox "SetProp失败"
    End If
End Sub

3. 从SetProp中读取数据（还原数组）

Function LoadRectArrayFromProp(ByVal hWnd As Long, ByVal propName As String) As Rect()
    Dim hMem As Long, pMem As Long, arrSize As Long, elemCount As Long
    Dim tempArr() As Rect, i As Long
    
    ' 1. 获取之前保存的内存指针
    hMem = GetProp(hWnd, propName)  ' 需要声明GetProp API
    If hMem = 0 Then
        Exit Function  ' 未找到属性
    End If
    
    ' 2. 锁定内存获取数据地址
    pMem = GlobalLock(hMem)
    If pMem = 0 Then
        Exit Function
    End If
    
    ' 3. 计算数组大小（假设已知元素数量，或在保存时额外存储长度）
    ' （这里简化处理，实际需提前记录元素数量，例如单独用一个属性保存elemCount）
    elemCount = 10  ' 示例：假设已知10个元素
    arrSize = elemCount * LenB(tempArr(0))
    
    ' 4. 还原数组
    ReDim tempArr(0 To elemCount - 1)
    CopyMemory tempArr(0), ByVal pMem, arrSize  ' 从内存复制到数组
    
    ' 5. 解锁内存
    GlobalUnlock hMem
    
    LoadRectArrayFromProp = tempArr
End Function

需补充声明GetProp：

Public Declare Function GetProp Lib "user32" Alias "GetPropA" (ByVal hWnd As Long, ByVal lpString As String) As Long

4. 释放资源（关键！避免内存泄漏）

当窗口关闭或不再需要数据时，必须释放内存和属性：

Sub ReleaseRectArrayProp(ByVal hWnd As Long, ByVal propName As String)
    Dim hMem As Long
    hMem = GetProp(hWnd, propName)
    If hMem <> 0 Then
        RemoveProp hWnd, propName  ' 移除属性（需声明RemoveProp）
        GlobalFree hMem  ' 释放堆内存
    End If
End Sub

' 声明RemoveProp
Public Declare Function RemoveProp Lib "user32" Alias "RemovePropA" (ByVal hWnd As Long, ByVal lpString As String) As Long

三、解决 "IDE 强制关闭丢失数据" 的问题

SetProp的属性本质是临时的（依赖窗口句柄存在），若要避免意外关闭丢失数据，必须配合持久化存储：

1. 在保存到SetProp的同时，将数据写入文件（如二进制文件）。
2. 程序启动时，从文件读取数据并恢复到内存和SetProp中。

示例（简单二进制存储）：

' 保存到文件
Sub SaveRectArrayToFile(arr() As Rect, filePath As String)
    Dim fNum As Integer, arrSize As Long
    fNum = FreeFile
    Open filePath For Binary As #fNum
        arrSize = (UBound(arr) - LBound(arr) + 1) * LenB(arr(0))
        Put #fNum, , arrSize  ' 先写大小
        Put #fNum, , arr(LBound(arr))  ' 再写数据
    Close #fNum
End Sub

' 从文件读取
Function LoadRectArrayFromFile(filePath As String) As Rect()
    Dim fNum As Integer, arrSize As Long, elemCount As Long
    Dim tempArr() As Rect
    If Not FileExists(filePath) Then Exit Function  ' 需判断文件是否存在
    fNum = FreeFile
    Open filePath For Binary As #fNum
        Get #fNum, , arrSize
        elemCount = arrSize / LenB(tempArr(0))
        ReDim tempArr(0 To elemCount - 1)
        Get #fNum, , tempArr(0)
    Close #fNum
    LoadRectArrayFromFile = tempArr
End Function

总结

1. 用GlobalAlloc申请内存，通过CopyMemory写入数组数据，再用SetProp保存内存指针。
2. 必须手动释放内存和属性（GlobalFree + RemoveProp），避免泄漏。
3. 配合文件持久化，解决 IDE 强制关闭或程序崩溃导致的数据丢失问题。