I've been playing with COM lately and while getting to understand the mechanism of how class methods/properties are called an idea came to mind: what if we can have a global instance of a class that exposes a Factory for creating new instances of that class but the Initializer method is Private. Is that possible? The answer is YES. We can make use of the
Me special variable to find and replace the instance pointer so that we can redirect calls to the desired instance.
Class1 which has the
VB_PredeclaredId set to True:
VERSION 1.0 CLASS BEGIN MultiUse = -1 'True END Attribute VB_Name = "Class1" Attribute VB_GlobalNameSpace = False Attribute VB_Creatable = False Attribute VB_PredeclaredId = True Attribute VB_Exposed = False '@PredeclaredId Option Explicit #If Mac Then #If VBA7 Then Private Declare PtrSafe Function CopyMemory Lib "/usr/lib/libc.dylib" Alias "memmove" (Destination As Any, Source As Any, ByVal Length As LongPtr) As LongPtr #Else Private Declare Function CopyMemory Lib "/usr/lib/libc.dylib" Alias "memmove" (Destination As Any, Source As Any, ByVal Length As Long) As Long #End If #Else 'Windows 'https://msdn.microsoft.com/en-us/library/mt723419(v=vs.85).aspx #If VBA7 Then Private Declare PtrSafe Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As LongPtr) #Else Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long) #End If #End If #If Win64 Then Private Const PTR_SIZE As Long = 8 #Else Private Const PTR_SIZE As Long = 4 #End If Private m_name As String Private m_id As Long Public Function Factory(ByVal newName As String, ByVal newID As Long) As Class1 Dim newClass1 As Class1 Set newClass1 = New Class1 ' #If VBA7 Then Dim mePtr As LongPtr Dim swapAddr As LongPtr #Else Dim mePtr As Long Dim swapAddr As Long #End If ' 'Find the address where the swap must happen 'Note we cannot save ObjPtr(Me) to a variable because ' we could get the position of that variable instead swapAddr = VarPtr(Me) Do swapAddr = swapAddr + PTR_SIZE CopyMemory mePtr, ByVal swapAddr, PTR_SIZE Loop Until mePtr = ObjPtr(Me) 'Debug.Print swapAddr - VarPtr(Me) '56 on x64 and 168 on x32 ' CopyMemory ByVal swapAddr, ObjPtr(newClass1), PTR_SIZE Init newName, newID CopyMemory ByVal swapAddr, mePtr, PTR_SIZE ' Set Factory = newClass1 End Function Private Sub Init(ByVal newName As String, ByVal newID As Long) m_name = newName m_id = newID End Sub Public Property Get Name() As String Name = m_name End Property Public Property Get ID() As Long ID = m_id End Property
Now we could create and use new instances like this:
Sub TestFactory() With Class1.Factory("Test", 4) Debug.Print .Name Debug.Print .ID End With End Sub
even if the
Init method is
I don't really understand why the offset is 56 bytes on x64 and 168 bytes on x32 (at least on my computers). Would be nice if somebody could figure this out so that the loop used in finding the swap address is not needed anymore.
Apparently on x64 it is sufficient to get the swap address like this:
#If Win64 Then swapAddr = VarPtr(Factory) + PTR_SIZE mePtr = ObjPtr(Me) #End If
so no loop would be needed.
I've decided to create a new follow-up question with a new improved code, instead of answering this question because the code here is slower and less safer. Go to: Private VBA Class Initializer called from Factory #2