BeeJ
12/5/2011 11:16:00 PM
I can post the subs but not sure how much ... see below
I revisited the previous "fix" that worked.
So again I commented out two Property Let/Get pairs and is started
working again. All this code is error free in that it all runs except
for the subclass aspect.
So I uncommented and went into the subclassing routine and increaed the
vTable search nlimit depth from 32 in steps up to 512. Canton uses a
different search algo. That supposedly probes at class, form and UC.
No luck with that.
Sorry about the line wraps.
<snip beg>
If oCallback Is Nothing Then
' If the user hasn't specified the callback owner
Set oCallback = Me ' IN THE UC
' Then it is me
End If
nAddr = zAddressOf(oCallback, nOrdinal)
' Get the address of the specified ordinal method
If nAddr = 0 Then ' RETURNS ZERO == FAILURE
<snip end>
' ===============================
Private Function zAddressOf(ByVal oCallback As Object, ByVal nOrdinal
As Long) As Long
' Return the address of the specified ordinal method on the
oCallback object, 1 = last private method, 2 = second last private
method, etc
Dim bSub As Byte
'Value we expect to find pointed at by a vTable method entry
Dim bVal As Byte
Dim nAddr As Long
'Address of the vTable
Dim i As Long
'Loop index
Dim j As Long
'Loop limit
RtlMoveMemory VarPtr(nAddr), ObjPtr(oCallback), 4
'Get the address of the callback object's instance
If Not zProbe(nAddr + &H1C, i, bSub) Then
'Probe for a Class method
If Not zProbe(nAddr + &H6F8, i, bSub) Then
'Probe for a Form method
If Not zProbe(nAddr + &H7A4, i, bSub) Then
'Probe for a UserControl method
Exit Function
'Bail...
End If
End If
End If
i = i + 4
'Bump to the next entry
j = i + 1024
'Set a reasonable limit, scan 256 vTable entries
Do While i < j
RtlMoveMemory VarPtr(nAddr), i, 4
'Get the address stored in this vTable entry
If IsBadCodePtr(nAddr) Then
'Is the entry an invalid code address?
RtlMoveMemory VarPtr(zAddressOf), i - (nOrdinal * 4), 4
'Return the specified vTable entry address
Exit Do
'Bad method signature, quit loop
End If
RtlMoveMemory VarPtr(bVal), nAddr, 1
'Get the byte pointed to by the vTable entry
If bVal <> bSub Then
'If the byte doesn't match the expected value...
RtlMoveMemory VarPtr(zAddressOf), i - (nOrdinal * 4), 4
'Return the specified vTable entry address
Exit Do
'Bad method signature, quit loop
End If
i = i + 4
'Next vTable entry
Loop
End Function 'zAddressOf
' ===============================
Private Function zProbe(ByVal nStart As Long, ByRef nMethod As Long,
ByRef bSub As Byte) As Boolean
'Probe at the specified start address for a method signature
Dim bVal As Byte
Dim nAddr As Long
Dim nLimit As Long
Dim nEntry As Long
nAddr = nStart
'Start address
nLimit = nAddr + 32
'Probe eight entries
Do While nAddr < nLimit
'While we've not reached our probe depth
RtlMoveMemory VarPtr(nEntry), nAddr, 4
'Get the vTable entry
If nEntry <> 0 Then
'If not an implemented interface
RtlMoveMemory VarPtr(bVal), nEntry, 1
'Get the value pointed at by the vTable entry
If bVal = &H33 Or bVal = &HE9 Then
'Check for a native or pcode method signature
nMethod = nAddr
'Store the vTable entry
bSub = bVal
'Store the found method signature
zProbe = True
'Indicate success
Exit Function
'Return
End If
End If
nAddr = nAddr + 4
'Next vTable entry
Loop
End Function 'zProbe