Получение списка методов VB-объекта.

[The trick]

Метод возвращает список всех пользовательских публичных методов VB-объекта.

Код: Выделить всё

Option Explicit
Option Base 0

Public Enum PTR
    [_]
End Enum

Private Declare Function GetMem1 Lib "msvbvm60" ( _
                         ByRef Source As Any, _
                         ByRef Dest As Any) As Long
Private Declare Function GetMem4 Lib "msvbvm60" ( _
                         ByRef Source As Any, _
                         ByRef Dest As Any) As Long
Private Declare Function GetMemPtr Lib "msvbvm60" Alias "GetMem4" ( _
                         ByRef Source As Any, _
                         ByRef Dest As Any) As Long
Private Declare Function GetMem2 Lib "msvbvm60" ( _
                         ByRef Source As Any, _
                         ByRef Dest As Any) As Long
Private Declare Function lstrlenA Lib "kernel32" ( _
                         ByRef lpString As Any) As Long
Private Declare Function SysAllocStringByteLen Lib "oleaut32" ( _
                         ByRef psz As Any, _
                         ByVal lSize As Long) As String

' // Get list of VB6 object methods
Public Property Get ListOfMethods( _
                    ByVal cObj As Object) As String()
    Dim sRet()      As String
    Dim lIndex      As Long
    Dim lCount      As Long
    Dim pObjInfo    As PTR
    Dim pPubDesc    As PTR
    Dim pPrivDesc   As PTR
    Dim pMembers    As PTR
    Dim pMethDesc   As PTR
    Dim pVtbl       As PTR
    Dim lMethods    As Long
    Dim pNames      As PTR
    Dim pName       As PTR
    Dim lMethOffset As Long
    Dim lPropCount  As Long
    Dim lFlags      As Long
   
    GetMemPtr ByVal ObjPtr(cObj), pVtbl
    GetMemPtr ByVal pVtbl - 4, pObjInfo
    GetMemPtr ByVal pObjInfo + &H18, pPubDesc
    GetMemPtr ByVal pObjInfo + &HC, pPrivDesc
    GetMemPtr ByVal pPubDesc + &H20, pNames
   
    If pPrivDesc = 0 Then
        Exit Property
    End If
   
    GetMemPtr ByVal pPrivDesc + &H18, pMembers
    GetMem2 ByVal pPubDesc + &H1C, lMethods
   
    If lMethods = 0 Then
        Exit Property
    End If

    For lIndex = 0 To lMethods - 1
       
        GetMemPtr ByVal pMembers, pMethDesc

        If pMethDesc Then
           
            GetMem2 ByVal pMethDesc + 2, lMethOffset
           
            If lMethOffset And 1 Then
               
                lMethOffset = lMethOffset And -2
               
                GetMemPtr ByVal pNames + lIndex * Len(pName), pName
               
                If lCount Then
                    If lCount > UBound(sRet) Then
                        ReDim Preserve sRet(lCount + 10)
                    End If
                Else
                    ReDim sRet(9)
                End If
               
                sRet(lCount) = SysAllocStringByteLen(ByVal pName, lstrlenA(ByVal pName))
               
                lCount = lCount + 1
               
            End If

        End If
       
        pMembers = pMembers + 4
       
    Next
   
    GetMem2 ByVal pPrivDesc + &H10, lPropCount
    GetMemPtr ByVal pPrivDesc + &H20, pMembers
   
    For lIndex = 0 To lPropCount - 1
       
        GetMemPtr ByVal pMembers, pMethDesc
       
        If pMethDesc Then
           
            GetMem2 ByVal pMethDesc + &H10, lFlags
           
            If lFlags And 2 Then
               
                GetMemPtr ByVal pMethDesc, pName
                GetMem2 ByVal pMethDesc + &H12, lMethOffset
               
                If lCount Then
                    If lCount > UBound(sRet) Then
                        ReDim Preserve sRet(lCount + 10)
                    End If
                Else
                    ReDim sRet(9)
                End If
               
                sRet(lCount) = SysAllocStringByteLen(ByVal pName, lstrlenA(ByVal pName))
               
                lCount = lCount + 1
               
            End If
           
        End If
       
        pMembers = pMembers + 4
       
    Next
   
    If lCount Then
        ReDim Preserve sRet(lCount - 1)
    End If
   
    ListOfMethods = sRet
   
End Property