我(再次)遇到了 MS Access 的问题。例如,如果 vba 代码中发生错误,Access 有一些特殊的习惯会释放对象引用。我找到了一个非常巧妙的解决方案来解决这个问题,它似乎在大多数情况下都有效,但有时会导致 Access 崩溃。
Public CurrentUser As CUser 'CUser is a class containing Userinformation
Private Const C_USER_STORAGENAME As String = "CURRENTUSER_HANDLEID"
Private Declare PtrSafe Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (destination As Any, source As Any, ByVal length As LongPtr)
Private Const rbHandleProp = C_USER_STORAGENAME
Public Function InitUser() As Integer
Dim lngUserPtr As LongPtr
Set CurrentUser = New CUser 'Cache a copy
CurrentUser.InitializeUser
lngUserPtr = ObjPtr(CurrentUser) 'HandleID
WriteProjProperty rbHandleProp, lngUserPtr 'Write HandleID
End Function
Private Sub WriteProjProperty(key As String, Value As Variant)
On Error Resume Next
CurrentProject.Properties(key).Value = Value
If err.Number = 2455 Then 'No Key!
CurrentProject.Properties.Add key, Value
End If
End Sub
Private Function GetCurrentUser(lngUserPtr As LongPtr) As Object
Dim objUser As Object
CopyMemory objUser, lngUserPtr, 4 'CRASHES HERE SOMETIMES
Set GetCurrentUser = objUser
Set objUser = Nothing
End Function
Public Function ReadProjProperty(key As String) As Variant
On Error Resume Next
ReadProjProperty = CurrentProject.Properties(key).Value
End Function
Property Get msCurrentUser() As CUser
If CurrentUser Is Nothing Then
Set CurrentUser = GetCurrentUser(CLng(ReadProjProperty(rbHandleProp)))
End If
Set msCurrentUser = CurrentUser
End Property
用户对象在启动时初始化一次并保存句柄。用户信息可以通过属性 msCurrentUser 获取。正如我所说,这在大多数情况下都有效,但似乎在某些情况下CopyMemory会失败。任何帮助,将不胜感激。
提前致谢
乔恩