Готовые решения и полезные коды на Visual Basic 6.0 - VB - Ответ 6551295

Option Explicit
'
' © Кривоус Анатолий Анатольевич (The trick), 2014
' Модифицированно Антихакер32 (CyberForum.ru)
' Класс, для использования DLL и OCX без регистрации
'
Private Const CLSID_TLI As String = "{8B21775E-717D-11CE-AB5B-D41203C10000}"
Dim oTLI As Object, cTLI As GUID, sTLI As String
Dim mObject As Object, mPath$
Const Def_MiscStatus = 131473
Dim CollPaths As New Collection, NumColl&
Dim CollObj As New Collection
 
Private Sub CollAdd(Obj As Object, Path$)
    On Error Resume Next
    If Obj Is Nothing Then Exit Sub
    CollObj.Add Obj, Obj.Name
    CollPaths.Add Path, Path
End Sub
 
Public Function CreateObject_Int(ByVal Path$, Optional Interface) As Object
    'Использование библиотеки без регистрации
    '
    Dim sClsID$, cID As GUID, ProgID$, Item&, bEx As Boolean
    Dim TLI As Object, CC As Object
    Set TLI = oTLI.TypeLibInfoFromFile(Path)
    If IsMissing(Interface) Then
 
        For Each CC In TLI.CoClasses
            bEx = True: Exit For
        Next
    ElseIf IsNumeric(Interface) Then
 
        For Each CC In TLI.CoClasses
            Item = Item + 1: If Item = Interface Then bEx = True: Exit For
        Next
        If CC Is Nothing Then Err.Raise 1, , "Нет в коллекции CoClasses"
    ElseIf InStr(1, Interface, "{") Then
        Interface = Trim(Interface)
 
        For Each CC In TLI.CoClasses
            If Interface = CC.GUID Then bEx = True: Exit For
        Next
    Else: Interface = Trim(Interface)
        For Each CC In TLI.CoClasses
            If StrComp(Interface, CC.Name, 1) = 0 Then bEx = True: Exit For
        Next
    End If
    If bEx Then
        sClsID = CC.GUID
        CLSIDFromString StrPtr(sClsID), cID
        Set CreateObject_Int = CreateObjectEx(Path, cID)
        CollAdd CreateObject_Int, Path
    End If
 
End Function
 
Public Function ControlsAdd_Int(ByVal Path$, Parent As Object, Optional ByVal Interface, Optional _
ByVal Name$, Optional Container As Object, Optional LicensesKey$) As Object
    Dim sClsID$, cID As GUID, ProgID$, i&, Item&, bEx As Boolean
    Dim TLI As Object, CC As Object
    Set TLI = oTLI.TypeLibInfoFromFile(Path)
 
    If IsMissing(Interface) Then
        'Проверяются в коллекции CoClasses только контроллы
        '
        For Each CC In TLI.CoClasses
            If Not (CC.DefaultEventInterface Is Nothing) Then bEx = True: Exit For
        Next
    ElseIf IsNumeric(Interface) Then
 
        For Each CC In TLI.CoClasses
            'Если в Interface стоит номер,
            'то присвоение, по его очередности, в числе контроллов
            '
            If Not (CC.DefaultEventInterface Is Nothing) Then
                Item = Item + 1: If Item = Interface Then bEx = True: Exit For
            End If
        Next
        If CC Is Nothing Then Err.Raise 1, , "Нет в коллекции CoClasses"
    ElseIf InStr(1, Interface, "{") Then
        Interface = Trim(Interface)
 
        For Each CC In TLI.CoClasses
 
            If Not (CC.DefaultEventInterface Is Nothing) Then
                If Interface = CC.GUID Then bEx = True: Exit For
            End If
        Next
    Else: Interface = Trim(Interface)
 
        For Each CC In TLI.CoClasses
 
            If Not (CC.DefaultEventInterface Is Nothing) Then
                If StrComp(Interface, CC.Name, 1) = 0 Then bEx = True: Exit For
            End If
        Next
    End If
 
    If bEx Then
        sClsID = CC.GUID
        ProgID = TLI.Name & "." & CC.Name
 
        If Len(Name) = 0 Then
            Do: i = i + 1
                If Not ObjExists(Parent, CC.Name & i) Then Exit Do
            Loop
            Name = CC.Name & i
        ElseIf ObjExists(Parent, Name) Then
            Err.Raise 1, , "Объект с именем: " & Name & " существует"
        End If
 
        If Not LicensesExists(ProgID) Then
            gLicensesKey = LicensesKey
            CLSIDFromString StrPtr(sClsID), cID
            Set ControlsAdd_Int = ControlsAdd(Path, cID, ProgID, Def_MiscStatus, Parent, Name)
            CollAdd ControlsAdd_Int, Path
        Else
            Set ControlsAdd_Int = Parent.Controls.Add(ProgID, Name, IIf(Container Is Nothing, Parent, Container))
        End If
    End If
End Function
 
Private Function LicensesExists(ProgID$) As Boolean
    On Error Resume Next
 
    If IsError(Licenses(ProgID).LicenseKey) Then
    Else: LicensesExists = True
    End If
End Function
 
Private Function ObjExists(Parent As Object, Name$) As Boolean
    On Error Resume Next
 
    If IsError(Parent.Controls(Name)) Then
    Else: ObjExists = True
    End If
End Function
 
Public Function GetTypeLibInfoFromFile(ByVal Path$) As Object
    Set GetTypeLibInfoFromFile = oTLI.TypeLibInfoFromFile(Path)
End Function
 
Private Sub Class_Initialize()
    sTLI = App.Path & "\TLBINF32.DLL"
    CLSIDFromString StrPtr(CLSID_TLI), cTLI
    Set oTLI = CreateObjectEx(sTLI, cTLI)
End Sub
 
Private Sub Class_Terminate()
    Dim v
    Set oTLI = Nothing
    Call UnloadLibrary(sTLI) 'Выгружаем TLI
    '================
    For Each v In CollObj: Set v = Nothing: Next
    'Выгружаем библиотеки
    For Each v In CollPaths: Call UnloadLibrary(CStr(v)): Next
End Sub