Нужен интерфейс с методом write(vStr as Variant)

[Antonariy]

Да тут настоящая вакханалия мысли развернулась

Гы, не удержался-таки )

Это вроде замена имени метода, а не перенаправление вызова... В принципе подойдет, но с интерфейсами как-то красивее. А как это будет выглядеть для двух и более методов? Или метода и свойства? К примеру Public Property Input.

[keks-n]

Antonariy
У меня это будет выглядеть добавлением ещё нескольких имён. В способе с перехватом GetIDsOfNames придётся изменить ещё несколько строк.

[tyomitch]

В принципе подойдет, но с интерфейсами как-то красивее.

VB6 по запросу IDispatch отдаст только главный диспинтерфейс, сколько бы ни было дополнительных.
Т.е. красиво-то красиво, только это тупик

А как это будет выглядеть для двух и более методов? Или метода и свойства? К примеру Public Property Input.

Для двух методов:

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

Option Explicit
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
Private Declare Function VirtualProtect Lib "kernel32" (lpAddress As Any, ByVal dwSize As Long, ByVal flNewProtect As Long, lpflOldProtect As Long) As Long
Private Declare Function lstrcmpiW Lib "kernel32" (ByVal lpString1 As Long, ByVal lpString2 As Long) As Long
Private Const PAGE_EXECUTE_READWRITE = &H40

Public Function Anything() As String
    Anything = "Mary had a little lamb"
End Function

Public Sub Write_(ByVal vStr As Variant)
    MsgBox vStr
End Sub

Public Sub Close_()
    MsgBox "Closed"
End Sub

Private Sub GetIDsOfNamesReplacement(ByVal riid As Long, rgszNames As Long, ByVal cNames As Long, ByVal lcid As Long, ByVal rgDispId As Long)
If 0 = lstrcmpiW(rgszNames, StrPtr("Write")) Then
    ReDim Names(cNames) As Long
    CopyMemory Names(0), rgszNames, cNames * 4
    Names(0) = StrPtr("Write_")
    Call GetIDsOfNamesOriginal(riid, Names(0), cNames, lcid, rgDispId)
ElseIf 0 = lstrcmpiW(rgszNames, StrPtr("Close")) Then
    ReDim Names(cNames) As Long
    CopyMemory Names(0), rgszNames, cNames * 4
    Names(0) = StrPtr("Close_")
    Call GetIDsOfNamesOriginal(riid, Names(0), cNames, lcid, rgDispId)
Else
    Call GetIDsOfNamesOriginal(riid, rgszNames, cNames, lcid, rgDispId)
End If
End Sub

Private Sub GetIDsOfNamesOriginal(ByVal riid As Long, rgszNames As Long, ByVal cNames As Long, ByVal lcid As Long, ByVal rgDispId As Long)
'Never called
End Sub

Private Sub Class_Initialize()
Dim pVTbl As Long, OldProtect As Long
    CopyMemory pVTbl, ByVal ObjPtr(Me), 4
    VirtualProtect ByVal pVTbl, 44, PAGE_EXECUTE_READWRITE, OldProtect
    If OldProtect = PAGE_EXECUTE_READWRITE Then Exit Sub
    CopyMemory ByVal pVTbl + 44, ByVal pVTbl + 20, 4
    CopyMemory ByVal pVTbl + 20, ByVal pVTbl + 40, 4
End Sub


Далее аналогично.

Поскольку это простая подмена имени, то тип метода (свойство, не свойство) ни на что не влияет.

[Antonariy]

VB6 по запросу IDispatch отдаст только главный диспинтерфейс, сколько бы ни было дополнительных.
Т.е. красиво-то красиво, только это тупик

А-а. Мне просто показалось, что

Остаётся только вызов IDispatch::GetIDsOfNames перехватывать, чтобы вызовы метода "Write" перенаправлять на собственный соседний интерфейс.

относится как раз к интерфейсам.

keks-n
Спасибо за ликбез, враппер тоже пригодится.

[tyomitch]

А-а. Мне просто показалось, что

Остаётся только вызов IDispatch::GetIDsOfNames перехватывать, чтобы вызовы метода "Write" перенаправлять на собственный соседний интерфейс.

относится как раз к интерфейсам.

Нет, так тоже можно. Только чем это будет красивее? Кода больше (всё равно патчить VTbl надо), а толку столько же.

[Хакер]

NashRus
Скажи своему экзотическому Mail-провайдеру, чтобы разбанил адрес 194.67.52.99.

[NashRus]

Хакер
хотел что-то скинуть или что ?

[keks-n]

Кстати, есть способ получить IDispatch конкретного интерфейса.
1) Объявляем 3 переменные: a As Object, b As имя_интерфейса, zero As Long
2) Присваиваем к b объект
3) Делаем
Set a=Nothing
CopyMemory a,b,4
zero=0
CopyMemory b,zero,4
Set b=a


В итоге у нас в a лежит IDispatch интерфейса из переменной b и не было потери счётчика ссылок. Естественно, интерфейс из переменной b должен наследоваться от IDispatch

[Хакер]

NashRus
Форум хочет скидывать тебе уведомления об ответах и личных сообщениях. И всякий раз мне приходит письмо, в котором говрится что на starnet.ru забанен VBStreets-овский SMTP-сервер.

[NashRus]

2Хакер,

понятно. думал сейчас кодом разживусь

[tyomitch]

Кстати, есть способ получить IDispatch конкретного интерфейса.

Есть даже более простой: Set b = a.

Проблема в том, что клиент, которому эта ссылка будет передана, вызовет на ней QueryInterface(IID_IDispatch), и получит всё равно главный интерфейс.

[keks-n]

Ясно... А там As Variant, что-ли?