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 LongDim elemCount As Long' 计算数组元素数量和总字节数（每个Rect占4个Long，共16字节）elemCount = UBound(arr) - LBound(arr) + 1arrSize = elemCount * LenB(arr(0))  ' LenB返回单个元素的字节数' 1. 申请内存（GMEM_FIXED = &H0，表示固定内存，返回值即指针）hMem = GlobalAlloc(&H0, arrSize)If hMem = 0 ThenMsgBox "内存申请失败"Exit SubEnd If' 2. 锁定内存并获取指针（32位系统中GlobalLock返回的就是可用指针）pMem = GlobalLock(hMem)If pMem = 0 ThenGlobalFree hMem  ' 失败则释放内存MsgBox "内存锁定失败"Exit SubEnd If' 3. 将数组数据复制到内存块（从数组首地址复制到pMem指向的内存）CopyMemory pMem, arr(LBound(arr)), arrSize' 4. 解锁内存（必须解锁，否则可能导致内存泄漏）GlobalUnlock hMem' 5. 通过SetProp保存内存指针（hData参数传入内存块的指针hMem）If Not SetProp(hWnd, propName, hMem) ThenGlobalFree 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 LongDim tempArr() As Rect, i As Long' 1. 获取之前保存的内存指针hMem = GetProp(hWnd, propName)  ' 需要声明GetProp APIIf hMem = 0 ThenExit Function  ' 未找到属性End If' 2. 锁定内存获取数据地址pMem = GlobalLock(hMem)If pMem = 0 ThenExit FunctionEnd 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 hMemLoadRectArrayFromProp = 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 LonghMem = GetProp(hWnd, propName)If hMem <> 0 ThenRemoveProp 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 LongfNum = FreeFileOpen filePath For Binary As #fNumarrSize = (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 LongDim tempArr() As RectIf Not FileExists(filePath) Then Exit Function  ' 需判断文件是否存在fNum = FreeFileOpen filePath For Binary As #fNumGet #fNum, , arrSizeelemCount = arrSize / LenB(tempArr(0))ReDim tempArr(0 To elemCount - 1)Get #fNum, , tempArr(0)Close #fNumLoadRectArrayFromFile = tempArr
End Function

总结

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