Использование OCX без регистрации

[jangle]

Возможно ли? Пишу портабельную прогу. Все нативные DLL запускаются из памяти, только OCX остались снаружи.
Можно с ними также как с нативными DLL, обработал импорт и вызвал функцию, без сохранения на диск конечно.

[Хакер]

Можно, но сложно. Про манифест, который за счёт позволяет использовать ActiveX-библиотеки без регистрации, ты, надеюсь, слышал? Дальше придётся делать магию.

И вообще, всё зависит от того, намерен ли ты ActiveX-контролы создавать родным для VB способом или готов пойти на создание вручную. Во втором случае всё упрощается.

[Jack Ferre]

2 jangle
Не поделитесь файликом модуля, с помощью которого можно вызывать функции из длл?

[jangle]

2 jangle
Не поделитесь файликом модуля, с помощью которого можно вызывать функции из длл?

вызов функций DLL загруженной в буфер памяти? Исходник не на VB.

[Jack Ferre]

Если проект на VB, предполагаю, что рядом с exe лежит dll. В таком случае не понимаю смысл пихать в ресурсы dll-ки, если их потом оттуда вытаскивает другая (или вы их скрываете ?).

Я пытался перевести с C++ модуль для загрузки библиотеки из памяти, но как-то не пошло .
В модуле 3 паблик функции:
HMEMORYMODULE MemoryLoadLibrary(const void *);
FARPROC MemoryGetProcAddress(HMEMORYMODULE, const char *);
void MemoryFreeLibrary(HMEMORYMODULE);

Указатель, полученный с помощью MemoryGetProcAddress + MagicPointers от Хакера даст возможность вызывать функции из буфера в памяти без внешних dll.
Имея такую возможность, я бы смог

делать магию

[jangle]

В таком случае не понимаю смысл пихать в ресурсы dll-ки, если их потом оттуда вытаскивает другая (или вы их скрываете ?).

Не в ресурсы. Непосредственно в бинарный код приложения. Зачем? Хорошие художники копируют, великие художники крадут(с)

[The trick]

Можно "обмануть" VB6 и подсунуть ему DLL в памяти, перехватив нужные функции (CLSIDFromProgID чтобы возвратить CLSID, в CoGetClassObject вызывать DLLGetClassObject, также перехват OleRegGetMiscStatus (если хочешь использовать события, то нужно также перехватить RegQueryValue и LoadRegTypeLib (вот проблема будет в ручном парсинге библиотеки типов)).

[Хакер]

(вот проблема будет в ручном парсинге библиотеки типов)

А зачем? Что мешает нормально положить TLB себе в ресурсы?

[The trick]

А зачем? Что мешает нормально положить TLB себе в ресурсы?

Да, действительно. Как-то я сразу не сообразил .
Тогда это вполне реально сделать.
Я делал модуль, в котором можно использовать ActiveX контролы напрямую из библиотеки, хотя в правильности метода я не уверен. В коде прописывается что-то типа

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

Set Ctl = ControlAdd(Path, CLSID, ProgID, Name, Container)

Чтобы не было вопросов - ProgID передается в функцию если например в нужной библиотеке нет tlb, тогда, чтобы потом использовать стандартный Controls.Add формы можно было писать этот псевдо-ProgID.

[VisualFreeBasic]

use api :MemoryGetProcAddress,CoGetClassObject or ole.tlb (classfactroty

[VisualFreeBasic]

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

FORM1:
Dim ExcelApp As Object
Private Sub Command1_Click()
    Set ExcelApp = CreateObject("excel.application")
    Advise ExcelApp
    ExcelApp.Visible = True
    ExcelApp.WorkBooks.Add
End Sub



BASE FILE:

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

Option Explicit

Type CSink
    Interfaces As Long
    RefCount As Long
    EventIID As UUID
End Type

Private IID_IUnknown As UUID
Private IID_IDispatch As UUID

Dim vtable(0 To 6) As Long

Private Function EventSink_QueryInterface(This As CSink, RIID As UUID, lObj As Long) As Long
    On Error GoTo ErrLine
    If IsEqualGUID(RIID, IID_IUnknown) Then
        lObj = VarPtr(This)
        This.RefCount = This.RefCount + 1
    ElseIf IsEqualGUID(RIID, IID_IDispatch) Then
        lObj = VarPtr(This)
        This.RefCount = This.RefCount + 1
    ElseIf IsEqualGUID(RIID, This.EventIID) Then
        lObj = VarPtr(This)
        This.RefCount = This.RefCount + 1
    Else
        lObj = 0
        EventSink_QueryInterface = E_NOINTERFACE
    End If
ErrLine:
End Function

Private Function EventSink_AddRef(This As CSink) As Long
    This.RefCount = This.RefCount + 1
    EventSink_AddRef = This.RefCount
End Function

Private Function EventSink_Release(This As CSink) As Long
    This.RefCount = This.RefCount - 1
    EventSink_Release = This.RefCount
    If This.RefCount = 0 Then GlobalFree VarPtr(This)
End Function

Private Function EventSink_GetTypeInfoCount(This As CSink, pctinfo As Long) As Long
    pctinfo = 0                                                                 ' Not implemented
    EventSink_GetTypeInfoCount = E_NOTIMPL
End Function

Private Function EventSink_GetTypeInfo(This As CSink, ByVal iTInfo As Long, ByVal lcid As Long, ppTInfo As Long) As Long
    ppTInfo = 0
    EventSink_GetTypeInfo = E_NOTIMPL
End Function

Private Function EventSink_GetIDsOfNames(This As CSink, RIID As UUID, rgszNames As Long, ByVal cNames As Long, ByVal lcid As Long, rgDispId As Long) As Long
    EventSink_GetIDsOfNames = E_NOTIMPL
End Function

Private Function EventSink_Invoke(This As CSink, ByVal dispIdMember As Long, RIID As olelib.UUID, ByVal lcid As Long, ByVal wFlags As Integer, ByVal pDispParams As Long, ByVal pVarResult As Long, pExcepInfo As olelib.EXCEPINFO, puArgErr As Long) As Long
    Dim a() As Variant
   
    OnEvent dispIdMember
    EventSink_Invoke = S_OK                                                     ' This method never fails
End Function

Private Function AddrOf(ByVal Add As Long) As Long
    AddrOf = Add
End Function
Private Function OnEvent(ByVal dispIdMember As Long) As Long
    Form1.List1.AddItem "事件ID:" & dispIdMember
End Function
Public Function CreateSink(EventIID As UUID) As Object
    Dim lEventSinkPtr As Long, lOldProt As Long
    vtable(0) = AddrOf(AddressOf EventSink_QueryInterface)
    vtable(1) = AddrOf(AddressOf EventSink_AddRef)
    vtable(2) = AddrOf(AddressOf EventSink_Release)
    vtable(3) = AddrOf(AddressOf EventSink_GetTypeInfoCount)
    vtable(4) = AddrOf(AddressOf EventSink_GetTypeInfo)
    vtable(5) = AddrOf(AddressOf EventSink_GetIDsOfNames)
    vtable(6) = AddrOf(AddressOf EventSink_Invoke)
    Dim EventSink As CSink
    With EventSink
        .Interfaces = VarPtr(vtable(0))
        .RefCount = 1
        .EventIID = EventIID
    End With
    lEventSinkPtr = GlobalAlloc(GPTR, LenB(EventSink))
    If lEventSinkPtr Then
        MoveMemory ByVal lEventSinkPtr, EventSink, LenB(EventSink)
        MoveMemory CreateSink, lEventSinkPtr, 4
        CLSIDFromString IIDSTR_IUnknown, IID_IUnknown
        CLSIDFromString IIDSTR_IDispatch, IID_IDispatch
    Else
        Err.Raise 7, "CreateEventSink"
    End If
End Function

Sub Advise(EventObject As Object, Optional SourceIID As String)
    On Error GoTo ErrLine
    Dim oCPC As IConnectionPointContainer
    Dim oEnm As IEnumConnectionPoints
    Dim oCP As IConnectionPoint
    Dim oUnk As olelib.IUnknown
    Dim tIID As UUID
    Dim lCookie As Long
    Set oCPC = EventObject
    If LenB(SourceIID) = 0 Then
        Set oEnm = oCPC.EnumConnectionPoints
        oEnm.Next 1, oCP
        oCP.GetConnectionInterface tIID
    Else
        CLSIDFromString SourceIID, tIID
        Set oCP = oCPC.FindConnectionPoint(tIID)
    End If
    Set oUnk = CreateSink(tIID)
    lCookie = oCP.Advise(oUnk)
    Exit Sub
Disconnect:
    oCP.Unadvise lCookie
ErrLine:
End Sub