Results 1 to 40 of 62

Thread: Instantiate internal class object with name in string

Hybrid View

  1. #1
    PowerPoster
    Join Date
    Jan 2020
    Posts
    5,541

    Re: Instantiate internal class object with name in string

    get ALL class name string
    Code:
    Public Declare Function lstrcpynA Lib "kernel32" (ByVal lpString1 As String, ByVal lpString2 As Long, ByVal iMaxLength As Long) As Long
    Private Declare Function lstrlenA Lib "kernel32" (ByVal lpData As Long) As Long
    
    Function GetStrFromPtr(lpszName As Long)
    'GOOD
             Dim STR1 As String, Len1 As Long, R As Long, X As Long
             Len1 = lstrlenA(lpszName)
             STR1 = Space(Len1 + 1)
             R = lstrcpynA(STR1, lpszName, Len1 + 1)
             X = InStr(STR1, Chr(0))
             If X > 0 Then STR1 = Left(STR1, X - 1)
             GetStrFromPtr = STR1
    End Function
    Code:
    Function GetAllClassOnRun() As String()
        ' Only for Executable.
        '
        ' lpObjInfo is a returned argument.
        ' Function returns true if successful.
        Dim ClassList() As String
        Static Modules()        As NameBasedObjectFactory.MODDESCRTBL_ENTRY
        Static bModulesSet      As Boolean
        Dim i                   As Long
        '
        #If ALSO_USERCONTROLS Then
            Const mfBadFlags As Long = mfUserControl
        #Else
            Const mfBadFlags As Long = 0
        #End If
        '
        If Not bModulesSet Then
            ReDim Modules(0)
            If LoadDescriptorsTable(Modules) Then
                bModulesSet = True
            Else
                Exit Function
            End If
        End If
        '
        ' We are looking for a descriptor corresponding to the specified class.
        Dim ID As Long
        ReDim ClassList(UBound(Modules) - LBound(Modules))
        For i = LBound(Modules) To UBound(Modules)
            With Modules(i)
            ClassList(ID) = GetStrByPtr(.lpszName)
            End With
            ID = ID + 1
        Next i
        GetAllClassOnRun = ClassList()
    End Function
    Last edited by xiaoyao; Apr 16th, 2023 at 07:21 AM.

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •  



Click Here to Expand Forum to Full Width