子类化 - zAddressOf

'Return the address of the specified ordinal method on the oCallback object, 1 = last private method, 2 = second last private method, etc
Private Function zAddressOf( ByVal oCallback As Object , ByVal nOrdinal As Long ) As Long
' Note: used both in subclassing and hooking routines
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
' \\LaVolpe - Added propertypage offset
If Not zProbe(nAddr + &H710 , i, bSub) Then 'Probe for a PropertyPage method
If Not zProbe(nAddr + &H7A4 , i, bSub) Then 'Probe for a UserControl method
Exit Function 'Bail...
End If
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

'Probe at the specified start address for a method signature
Private Function zProbe( ByVal nStart As Long , ByRef nMethod As Long , ByRef bSub As Byte ) As Boolean
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 Do 'Return
End If
End If

nAddr = nAddr + 4 'Next vTable entry
Loop
End Function