home *** CD-ROM | disk | FTP | other *** search
/ Planet Source Code Jumbo …e CD Visual Basic 1 to 7 / 5_2007-2008.ISO / data / Zips / Stream_MP32029381162006.psc / modCustomConstructor.bas < prev   
BASIC Source File  |  2006-11-06  |  4KB  |  124 lines
  1. Attribute VB_Name = "modCustomConstructor"
  2. Option Explicit
  3.  
  4. ' from Paul Catons Sub Classing Code
  5. ' http://pscode.com/vb/scripts/ShowCode.asp?txtCodeId=64867&lngWId=1
  6.  
  7. Private Declare Function CallWindowProcA Lib "user32" ( _
  8.     ByVal lpPrevWndFunc As Long, _
  9.     ByVal hWnd As Long, _
  10.     ByVal Msg As Long, _
  11.     ByVal wParam As Long, _
  12.     ByVal lParam As Long _
  13. ) As Long
  14.  
  15. Private Declare Function IsBadCodePtr Lib "kernel32" ( _
  16.     ByVal lpfn As Long _
  17. ) As Long
  18.  
  19. Private Declare Function VirtualAlloc Lib "kernel32" ( _
  20.     ByVal lpAddress As Long, _
  21.     ByVal dwSize As Long, _
  22.     ByVal flAllocationType As Long, _
  23.     ByVal flProtect As Long _
  24. ) As Long
  25.  
  26. Private Declare Function VirtualFree Lib "kernel32" ( _
  27.     ByVal lpAddress As Long, _
  28.     ByVal dwSize As Long, _
  29.     ByVal dwFreeType As Long _
  30. ) As Long
  31.  
  32. Private Declare Sub RtlMoveMemory Lib "kernel32" ( _
  33.     ByVal Destination As Long, _
  34.     ByVal SOURCE As Long, _
  35.     ByVal length As Long _
  36. )
  37.  
  38. Private Enum VirtualFreeTypes
  39.     MEM_DECOMMIT = &H4000
  40.     MEM_RELEASE = &H8000
  41. End Enum
  42.  
  43. Private Enum VirtualAllocTypes
  44.     MEM_COMMIT = &H1000
  45.     MEM_RESERVE = &H2000
  46.     MEM_RESET = &H8000
  47.     MEM_LARGE_PAGES = &H20000000
  48.     MEM_PHYSICAL = &H100000
  49.     MEM_WRITE_WATCH = &H200000
  50. End Enum
  51.  
  52. Private Enum VirtualAllocPageFlags
  53.     PAGE_EXECUTE = &H10
  54.     PAGE_EXECUTE_READ = &H20
  55.     PAGE_EXECUTE_READWRITE = &H40
  56.     PAGE_EXECUTE_WRITECOPY = &H80
  57.     PAGE_NOACCESS = &H1
  58.     PAGE_READONLY = &H2
  59.     PAGE_READWRITE = &H4
  60.     PAGE_WRITECOPY = &H8
  61.     PAGE_GUARD = &H100
  62.     PAGE_NOCACHE = &H200
  63.     PAGE_WRITECOMBINE = &H400
  64. End Enum
  65.  
  66. ' calls the last method of an interface
  67. Public Sub CallCustomConstructor( _
  68.     obj As Object, _
  69.     ParamArray Params() _
  70. )
  71.  
  72.     CallStd zAddressOf(obj, 1), ObjPtr(obj), Params
  73. End Sub
  74.  
  75. 'Return the address of the specified ordinal method
  76. 'on the oCallback object,
  77. '1 = last private method,
  78. '2 = second last private method, etc
  79. Private Function zAddressOf( _
  80.     ByVal oCallback As Object, _
  81.     ByVal nOrdinal As Long _
  82. ) As Long
  83.  
  84.     Dim bSub  As Byte                                   'Value we expect to find pointed at by a vTable method entry
  85.     Dim bVal  As Byte
  86.     Dim nAddr As Long                                   'Address of the vTable
  87.     Dim i     As Long                                   'Loop index
  88.     Dim j     As Long                                   'Loop limit
  89.  
  90.     RtlMoveMemory VarPtr(nAddr), ObjPtr(oCallback), 4   'Get the address of the callback object's instance
  91.     If Not zProbe(nAddr + &H1C, i, bSub) Then           'Probe for a Class method
  92.         If Not zProbe(nAddr + &H6F8, i, bSub) Then      'Probe for a Form method
  93.             If Not zProbe(nAddr + &H7A4, i, bSub) Then  'Probe for a UserControl method
  94.                 Exit Function                           'Bail...
  95.             End If
  96.         End If
  97.     End If
  98.   
  99.     i = i + 4                                           'Bump to the next entry
  100.     j = i + 1024                                        'Set a reasonable limit, scan 256 vTable entries
  101.  
  102.     Do While i < j
  103.         RtlMoveMemory VarPtr(nAddr), i, 4               'Get the address stored in this vTable entry
  104.  
  105.         If IsBadCodePtr(nAddr) Then                     'Is the entry an invalid code address?
  106.             RtlMoveMemory VarPtr(zAddressOf), i - (nOrdinal * 4), 4     'Return the specified vTable entry address
  107.             Exit Do                                                     'Bad method signature, quit loop
  108.         End If
  109.  
  110.         RtlMoveMemory VarPtr(bVal), nAddr, 1            'Get the byte pointed to by the vTable entry
  111.         If bVal <> bSub Then                            'If the byte doesn't match the expected value...
  112.             RtlMoveMemory VarPtr(zAddressOf), i - (nOrdinal * 4), 4     'Return the specified vTable entry address
  113.             Exit Do                                                     'Bad method signature, quit loop
  114.         End If
  115.  
  116.         i = i + 4                                                       'Next vTable entry
  117.     Loop
  118. End Function
  119.  
  120. 'Probe at the specified start address for a method signature
  121. Private Function zProbe( _
  122.     ByVal nhe specified start add    ByVasobeS           'Nextad
  123.             If Nddr + &H6F8fied sta aEtlC4_
  124.     ByVal nhe specified sta  ByVal nhe spe Not zProbe(HMoveMemorylast pri - (n