I love VB! (COM/ActiveX как реализовать события?)

Программирование на Visual Basic, главный форум. Обсуждение тем программирования на VB 1—6.
Даже если вы плохо разбираетесь в VB и программировании вообще — тут вам помогут. В разумных пределах, конечно.
Правила форума
Темы, в которых будет сначала написано «что нужно сделать», а затем просьба «помогите», будут закрыты.
Читайте требования к создаваемым темам.
Jack Ferre
Продвинутый пользователь
Продвинутый пользователь
Аватара пользователя
 
Сообщения: 132
Зарегистрирован: 17.02.2014 (Пн) 14:31
Откуда: Казахстан, Костанай

I love VB! (COM/ActiveX как реализовать события?)

Сообщение Jack Ferre » 08.03.2014 (Сб) 12:57

Давно пытаюсь перевести труд alexcon314@Flasher.ru «Пишем свою оболочку для FP под Windows», но застрял на первой статье. Перечитал 100500 форумов. Подобных вопросов мало, но есть. А вот ответы на них всегда сводятся к "Can't in VB"

Сегодня таки перевел. Всё оказалось намного проще, чем на С++ (за это и название темы)
Код: Выделить всё
Call AtlAxWinInit
hwnd = CreateWindowEx(0, "AtlAxWin", FlashProgID, WS_POPUP Or WS_VISIBLE, 0, 0, 400, 300, 0, 0, 0, 0)
Call AtlAxGetControl(hwnd, SWF)

Пример использования:
Код: Выделить всё
SWF.Movie = "D:\path\file.swf"
SWF.SetVariable "VB.sInput", "Test Data String 1234567890"

Работает этот код прекрасно. VB делает всю грязную работу IUnknown > IDispatch > Invoke.
Остается реализовать события, но как я не знаю.

Jack Ferre
Продвинутый пользователь
Продвинутый пользователь
Аватара пользователя
 
Сообщения: 132
Зарегистрирован: 17.02.2014 (Пн) 14:31
Откуда: Казахстан, Костанай

Re: I love VB! (COM/ActiveX как реализовать события?)

Сообщение Jack Ferre » 09.03.2014 (Вс) 6:55

Попробывал создать точку соединения с помощью Atl. Cамописный API:
Код: Выделить всё
Private Declare Function AtlAdvise Lib "atl.dll" (ByVal lpUnkCP As Any, ByVal lpUnk As Any, ByVal lpIID As Long, ByRef lpPDW As Long) As Long

in IUNknown lpUnkCP - у меня сразу IShockwaveFlash (полученый из AtlAxGetControl(hwnd, SWF))
in IUnknown lpUnk - свой интерфейс. У меня класс FlashEvents. Исходя из этого должен подойти
in IID lpIID - FlashIID as GUID полученный с помощью IIDFromString, совпадает с DIID__IShockwaveFlashEvents из Flash.ocx
out lpPDW - хендл, чтобы использовать в AtlUnAdvise

Использование:
Код: Выделить всё
ret = AtlAdvise(SWF, MyEvents, VarPtr(FlashIID), myPDW) 'тут получаю 0x80040200 (CONNECT_E_NOCONNECTION)

AtlAdvise C++
Код: Выделить всё
ATLINLINE ATLAPI AtlAdvise(IUnknown* pUnkCP, IUnknown* pUnk,
                           const IID& iid, LPDWORD pdw)
{
    CComPtr<IConnectionPointContainer> pCPC;
    CComPtr<IConnectionPoint> pCP;

    HRESULT hRes = pUnkCP->QueryInterface(IID_IConnectionPointContainer,
                                              (void**)&pCPC);
    if (SUCCEEDED(hRes))
      hRes = pCPC->FindConnectionPoint(iid, &pCP); // Здесь hRes == 0x80040200
    if (SUCCEEDED(hRes))
      hRes = pCP->Advise(pUnk, pdw);
    return hRes;
}

Что я делаю не так?

Это всё с помощью atl.dll, но ведь VB сам умеет работать с ActiveX. Мб кто расскажет как?

Хакер
Телепат
Телепат
Аватара пользователя
 
Сообщения: 16473
Зарегистрирован: 13.11.2005 (Вс) 2:43
Откуда: Казахстан, Петропавловск

Re: I love VB! (COM/ActiveX как реализовать события?)

Сообщение Хакер » 09.03.2014 (Вс) 15:55

Вопрос можно свести к такому виду, чтобы для понятия проблемы не нужно было идти на чужой форум и разбираться там в чём-то?
—We separate their smiling faces from the rest of their body, Captain.
—That's right! We decapitate them.

Jack Ferre
Продвинутый пользователь
Продвинутый пользователь
Аватара пользователя
 
Сообщения: 132
Зарегистрирован: 17.02.2014 (Пн) 14:31
Откуда: Казахстан, Костанай

COM/ActiveX как реализовать события?

Сообщение Jack Ferre » 09.03.2014 (Вс) 17:36

Я пытаюсь программно создать ActiveX Control (а именно ShockwaveFlash).

Используя CreateObject я получаю объект с методами и свойствами, но толку от него никакого. (1/3 желаемого результата)
Используя AtlAxGetControl lib "atl.dll" я получаю объект и окошко. Уже неплохо. (2/3 желаемого результата)
Остается прикрутить обработчик событий.

Попробывал с помощью AtlAdvise lib "atl.dll"
MSDN писал(а):Creates a connection between an object's connection point and a client's sink.

Получаю ошибку CONNECT_E_NOCONNECTION :(

Вот исходник с комментариями:
AtlAx.rar
требуется Flash.ocx версии 9 и старше.
(5.17 Кб) Скачиваний: 184

Хакер
Телепат
Телепат
Аватара пользователя
 
Сообщения: 16473
Зарегистрирован: 13.11.2005 (Вс) 2:43
Откуда: Казахстан, Петропавловск

Re: I love VB! (COM/ActiveX как реализовать события?)

Сообщение Хакер » 09.03.2014 (Вс) 17:48

ATL пока отложим в сторону.

  • Экземпляр какого COM-класса ты создаёшь с помощью CreateObject?
  • Как понять, что толку от него никакого? Если он бесперспективен, то какой смысл его создавать? Если он не бесперспективен, то опиши суть перспективы? Предпринятие каких шагов дать от бесполезного объекта что-то полезное?
  • Какой объект и какое окно ты получешь с помощью AtlAxGetControl. Ты должен используя её получать «объект по окну», а не «объект и окно». Допустим, ты получаешь ссылку на объект по hWnd. Это какой-то второй объект? Ты в итоге имеешь два объекта? Зачем тогда создавал первый?
  • На события какого объекта нужно подписаться? Откуда есть достоверная информация, что объект выступает источником событий? Что это за объект, какого класса? Где документирован список его событий?

Код читать преднамеренно не хочу, хочу разобраться в сути замысла. Пока ты всё описываешь так, словно другие всю жизни делали со флешем те же вещи, что сейчас намереваешься сделать ты. А между тем, задача должна быть поставлена так, чтобы она была максимально изолирована от флеш-тематики и касалось только COM-а.
—We separate their smiling faces from the rest of their body, Captain.
—That's right! We decapitate them.

Хакер
Телепат
Телепат
Аватара пользователя
 
Сообщения: 16473
Зарегистрирован: 13.11.2005 (Вс) 2:43
Откуда: Казахстан, Петропавловск

Re: I love VB! (COM/ActiveX как реализовать события?)

Сообщение Хакер » 09.03.2014 (Вс) 18:21

Ладно, почитал код, был весьма удивлён степенью извращённости действий.

Зачем-то контрол создаётся в ATL-предоставленном контейнере, потом получается ссылка на контрол, потом в него загружается роль, присваиваются какие-то значения Flash-переменным, и затем цикл прокачки сообщений.

По порядку от низкоуровневого к глобальному:
  • Автора функции StringFromPointer нужно казнить. Это просто ужас.
  • Бессмысленно делать цикл прокачки сообщений на VB: одна из базовых вещей идеологии VB в том, что этот цикл работает в рантайме и VB-программист о нём не думает. Этот цикл сам следит за активными объектами и сам решает, когда ему прекратиться.
  • Не понятна идея с порождением контрола в ALT-окне. Почему бы не использовать нормальный штатный для VB подход с контролами?

Поэтому непонятно, почему бы не сделать вот так? Прикладываю пример.
swf_inst_on_form.zip
(4.26 Кб) Скачиваний: 182

Тут в примере Flash10d.ocx. Надеюсь, не будет проблем поменять на др. версию.
—We separate their smiling faces from the rest of their body, Captain.
—That's right! We decapitate them.

Jack Ferre
Продвинутый пользователь
Продвинутый пользователь
Аватара пользователя
 
Сообщения: 132
Зарегистрирован: 17.02.2014 (Пн) 14:31
Откуда: Казахстан, Костанай

Re: I love VB! (COM/ActiveX как реализовать события?)

Сообщение Jack Ferre » 09.03.2014 (Вс) 19:00

Хакер писал(а):почему бы не сделать вот так?

В таком виде я его (Flash) и использую.
Почему заморачиваюсь с созданием программно:
1. Спортивный интерес.
2. Заметил недавно > зарегистрированный Flash.ocx старше версии 10е(а ему уже 4 года) не дает сохранить VB проект (неведома ошибка)
UPD: 3. (Главное забыл!) Прозрачный фон ActiveX контрола (с серой формой я уже как только не извращался - прозрачнее не становится), но это уже другая тема.

Что это за объект, какого класса?

Класс > ShockwaveFlash.ShockwaveFlash
Интересующий интерфейс > Dispatch IShockwaveFlash; ' которым уже получается пользоваться
Интерфейс событий > Dispatch _IShockwaveFlashEvents; ' IID такой же как у IShockwaveFlash

Бессмысленно делать цикл прокачки сообщений на VB

функция PL_AddItem_Test использовалась мной для измерения скорости передачи строк во Flash. Здесь - только для наглядности. Увидили строку из VB - хорошо, если бы еще событие случилось как в примере swf_inst_on_form.zip было бы просто замечательно.
Последний раз редактировалось Jack Ferre 09.03.2014 (Вс) 19:18, всего редактировалось 1 раз.

Хакер
Телепат
Телепат
Аватара пользователя
 
Сообщения: 16473
Зарегистрирован: 13.11.2005 (Вс) 2:43
Откуда: Казахстан, Петропавловск

Re: I love VB! (COM/ActiveX как реализовать события?)

Сообщение Хакер » 09.03.2014 (Вс) 19:07

Jack Ferre писал(а):В таком виде я его и использую.

Тогда в чём вопрос?

Jack Ferre писал(а):Почему заморачиваюсь с созданием программно:
1. Спортивный интерес.

Окей, но делать это нужно не так.

Jack Ferre писал(а):2. Заметил недавно > зарегистрированный Flash.ocx старше версии 10е(а ему уже 4 года) не дает сохранить VB проект (неведома ошибка)

Это уже другой вопрос. Во-первых, в VB есть по-модульное сохранение. Как с ним обстоят дела? Это может помочь. Во-вторых, надо разобраться, что за ошибка. В-третьих, нужно попробовать запускать VB (runas) от имени администратора. Ну и привести информацию об используемой ОС и о том, установлены ли последние сервис-паки к VB.

Jack Ferre писал(а):Класс > ShockwaveFlash.ShockwaveFlash
Интересуемый интерфейс > Dispatch IShockwaveFlash; ' которым уже получается пользоваться
Интерфейс событий > Dispatch _IShockwaveFlashEvents; ' IID такой же как у IShockwaveFlash

Уже понятно, о чём речь, эти вопросы уже не актуальны.
IID не может быть таким же.
Обработку событий я показал. Надеюсь, руки больше не потянутся к AtlAdvise?

Jack Ferre писал(а):
Бессмысленно делать цикл прокачки сообщений на VB

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


Да причём здесь вообще PL_AddItem_Test? :? Речь о цикле прокачки сообщений. Он в оригинальном коде вот:
Код: Выделить всё
    ' Оконный цикл
    Dim hMsg As MSG
    Do While GetMessage(hMsg, 0, 0, 0)
        TranslateMessage hMsg
        DispatchMessage hMsg
    Loop


________

В конце я вообще нахожусь в полном непонимании ситуации. Проблема есть? Или проблемы нет изначально?
—We separate their smiling faces from the rest of their body, Captain.
—That's right! We decapitate them.

Jack Ferre
Продвинутый пользователь
Продвинутый пользователь
Аватара пользователя
 
Сообщения: 132
Зарегистрирован: 17.02.2014 (Пн) 14:31
Откуда: Казахстан, Костанай

Re: I love VB! (COM/ActiveX как реализовать события?)

Сообщение Jack Ferre » 09.03.2014 (Вс) 19:33

Хакер писал(а):Да причём здесь вообще PL_AddItem_Test? Речь о цикле прокачки сообщений

Извиняюсь, ступил :oops:

Созданное окно "AtlAxWin" сразу же умирает без этого цикла.

Jack Ferre писал(а):UPD: 3. (Главное забыл!) Прозрачный фон ActiveX контрола (с серой формой я уже как только не извращался - прозрачнее не становится), но это уже другая тема.

Сделал правку уже после вашего сообщения.
Хакер писал(а):Надеюсь, руки больше не потянутся к AtlAdvise

Потянутся, ведь остался один маленький шаг - AtlAdvise() == S_OK

Jack Ferre
Продвинутый пользователь
Продвинутый пользователь
Аватара пользователя
 
Сообщения: 132
Зарегистрирован: 17.02.2014 (Пн) 14:31
Откуда: Казахстан, Костанай

Re: I love VB! (COM/ActiveX как реализовать события?)

Сообщение Jack Ferre » 09.03.2014 (Вс) 19:49

Хакер писал(а):IID не может быть таким же.

[code]//Shockwave Flash
Dispatch IShockwaveFlash;
GUID = {D27CDB6C-AE6D-11CF-96B8-444553540000};

//Event interface for Shockwave Flash
Dispatch _IShockwaveFlashEvents;
GUID = {D27CDB6D-AE6D-11CF-96B8-444553540000};

Спасибо за подсказку! Сейчас попробую.

Хакер
Телепат
Телепат
Аватара пользователя
 
Сообщения: 16473
Зарегистрирован: 13.11.2005 (Вс) 2:43
Откуда: Казахстан, Петропавловск

Re: I love VB! (COM/ActiveX как реализовать события?)

Сообщение Хакер » 09.03.2014 (Вс) 19:56

Jack Ferre писал(а):Созданное окно "AtlAxWin" сразу же умирает без этого цикла.

Ещё раз: тебе не нужно создавать это окно. Тебе нужно использовать экземпляр формы, как в моём примере. Или ты согласен с этим, и значит проблема исчерпана и вопрос решён, или скажи что-то против.

Jack Ferre писал(а):Потянутся, ведь остался один маленький шаг - AtlAdvise() == S_OK

Ещё раз, тебе НЕ НУЖНО ВООБЩЕ даже прикасаться к этой функции. Ты видишь в моём примере вызов этой функции? Нет, её там нет. Причём даже если ты по каким-то неведомым (ибо пока ты не назвал достойного повода) причинам хочешь использовать подход с AtlAxWin, тебе всё равно не нужна AtlAdvise.

Теперь нужно объявить переменную
Dim WithEvents swf As ShockwaveFlashObjectsCtl.ShockwaveFlash
И присваивать ей ссылку. И иметь такие же обработчики событий вида Private Sub swf_eventname
—We separate their smiling faces from the rest of their body, Captain.
—That's right! We decapitate them.

Jack Ferre
Продвинутый пользователь
Продвинутый пользователь
Аватара пользователя
 
Сообщения: 132
Зарегистрирован: 17.02.2014 (Пн) 14:31
Откуда: Казахстан, Костанай

Re: I love VB! (COM/ActiveX как реализовать события?)

Сообщение Jack Ferre » 09.03.2014 (Вс) 20:12

Хакер писал(а):Теперь нужно объявить переменную и присваивать ей ссылку

Вчера я придумал так же сделать. Запихал код в класс. Понаписал Event-ов.
Но после Call AtlAxGetControl(hwnd, SWF) переменная SWF остается Nothing :(

UPD: Объявлял так Dim WithEvents swf As ShockwaveFlash, без ShockwaveFlashObjectsCtl. это большая разница?

Jack Ferre
Продвинутый пользователь
Продвинутый пользователь
Аватара пользователя
 
Сообщения: 132
Зарегистрирован: 17.02.2014 (Пн) 14:31
Откуда: Казахстан, Костанай

Re: I love VB! (COM/ActiveX как реализовать события?)

Сообщение Jack Ferre » 09.03.2014 (Вс) 20:52

Flash.cls:
Код: Выделить всё
Private sadSWF As ShockwaveFlashObjectsCtl.ShockwaveFlash
Private WithEvents mySWF As ShockwaveFlashObjectsCtl.ShockwaveFlash

Private Sub Class_Initialize()
    Call AtlAxGetControl(G_HWND, sadSWF)
    Set mySWF = sadSWF   ' > ERROR 459
End Sub

Получаю ошибку 459: Object or class does'n support the set of events :(
А в переменную mySWF ссылка не возвращается.

Хакер
Телепат
Телепат
Аватара пользователя
 
Сообщения: 16473
Зарегистрирован: 13.11.2005 (Вс) 2:43
Откуда: Казахстан, Петропавловск

Re: I love VB! (COM/ActiveX как реализовать события?)

Сообщение Хакер » 09.03.2014 (Вс) 21:41

Ты обоснуешь, зачем тебе нужно создавать контрол не так, как в моём примере, а так, как ты это делаешь в своём? У меня есть версии, но я хочу услышать причину лично от тебя.
—We separate their smiling faces from the rest of their body, Captain.
—That's right! We decapitate them.

Jack Ferre
Продвинутый пользователь
Продвинутый пользователь
Аватара пользователя
 
Сообщения: 132
Зарегистрирован: 17.02.2014 (Пн) 14:31
Откуда: Казахстан, Костанай

Re: I love VB! (COM/ActiveX как реализовать события?)

Сообщение Jack Ferre » 09.03.2014 (Вс) 21:52

Jack Ferre писал(а):
Jack Ferre писал(а):UPD: 3. (Главное забыл!) Прозрачный фон ActiveX контрола (с серой формой я уже как только не извращался - прозрачнее не становится), но это уже другая тема.


Сделал правку уже после вашего сообщения.

Хакер
Телепат
Телепат
Аватара пользователя
 
Сообщения: 16473
Зарегистрирован: 13.11.2005 (Вс) 2:43
Откуда: Казахстан, Петропавловск

Re: I love VB! (COM/ActiveX как реализовать события?)

Сообщение Хакер » 09.03.2014 (Вс) 21:53

Каким образом это коррелирует с необходимостью использовать извратный способ порождения экземпляра контрола?
—We separate their smiling faces from the rest of their body, Captain.
—That's right! We decapitate them.

Jack Ferre
Продвинутый пользователь
Продвинутый пользователь
Аватара пользователя
 
Сообщения: 132
Зарегистрирован: 17.02.2014 (Пн) 14:31
Откуда: Казахстан, Костанай

Re: I love VB! (COM/ActiveX как реализовать события?)

Сообщение Jack Ferre » 09.03.2014 (Вс) 22:04

Таким, что контрол можно будет заставить рисовать на собственном HDC (как? пока понятия не имею)
Если контрол лежит не форме, форму никак не сделать прозрачной.
Если свойсво ShockwaveFlash.WMode сделать "Transparent" у него "отваливается" hwnd и HDC.

Удобство использования в таком виде - как минимум можно проверить зарегистрирован ли Flash.
Без этой возможности программа с грохатом рушится при запуске (вроде "Can't create ActiveX Object")

Запихивание в ресурсы SWF файлов с последующим "кормлением" ими контрола.

Хакер
Телепат
Телепат
Аватара пользователя
 
Сообщения: 16473
Зарегистрирован: 13.11.2005 (Вс) 2:43
Откуда: Казахстан, Петропавловск

Re: I love VB! (COM/ActiveX как реализовать события?)

Сообщение Хакер » 09.03.2014 (Вс) 22:10

Jack Ferre писал(а):Таким, что контрол можно будет заставить рисовать на собственном HDC (как? пока понятия не имею)

Никак.
Да и лексически это не правильно. Рисовать на hDC нельзя, потому что hDC это хендл. Рисуют на device.

В чём вообще задумка? Сделать полупрозрачный контрол, который бы просвечивал другие контролы или фоновый рисунок? Или сделать полупрозрачное окно, которые просвечивал бы под собой другие окна (свои и окна др. приложений)? Если последнее — то просто используй layered windows.

Jack Ferre писал(а):Удобство использования в таком виде - как минимум можно проверить зарегистрирован ли Flash.
Без этой возможности программа с грохатом рушится при запуске (вроде "Can't create ActiveX Object")

Не правда. Can't create ActiveX object будет не при запуске, а как только ты попытаешься породить экземпляр формы. Поэтому проверяй наличие Флеша до попытки породить форму. Во-вторых, эту ошибку можно перехватить и обработать. Так что не с грохотом.

А вот уже более веская причина: ты можешь (как знаток Флеша) подтвердить, что от версии к версии, от релиза к резилу, они (Adobe) сохраняют постоянство CLSID-а контрола и IID-ов ключевых интерфейсов?
—We separate their smiling faces from the rest of their body, Captain.
—That's right! We decapitate them.

Jack Ferre
Продвинутый пользователь
Продвинутый пользователь
Аватара пользователя
 
Сообщения: 132
Зарегистрирован: 17.02.2014 (Пн) 14:31
Откуда: Казахстан, Костанай

Re: I love VB! (COM/ActiveX как реализовать события?)

Сообщение Jack Ferre » 09.03.2014 (Вс) 22:32

постоянство CLSID-а контрола

Да, так как в html он создается с помощью CLSID-а уже много лет
Очень удивился, когда нашел в Windows98 SWFlash.ocx 3.0.15 1999 года.
Только что сравнил - CLSID и IID-ы такие же.

Jack Ferre
Продвинутый пользователь
Продвинутый пользователь
Аватара пользователя
 
Сообщения: 132
Зарегистрирован: 17.02.2014 (Пн) 14:31
Откуда: Казахстан, Костанай

Re: I love VB! (COM/ActiveX как реализовать события?)

Сообщение Jack Ferre » 09.03.2014 (Вс) 22:50

Есть! +1 шаг.
Новая ошибка - CONNECT_E_CANNOTCONNECT = &H80040202
И это последняя строка функции AtlAdvise
Код: Выделить всё
hRes = pCP->Advise(pUnk, pdw);

Как я и ожидал, мой объект класса FlashEvents был отвергнут, буду мудрить дальше.

Хакер
Телепат
Телепат
Аватара пользователя
 
Сообщения: 16473
Зарегистрирован: 13.11.2005 (Вс) 2:43
Откуда: Казахстан, Петропавловск

Re: I love VB! (COM/ActiveX как реализовать события?)

Сообщение Хакер » 09.03.2014 (Вс) 22:50

Значит последний довод в пользу создания контрола твоим методом испаряется.
—We separate their smiling faces from the rest of their body, Captain.
—That's right! We decapitate them.

Хакер
Телепат
Телепат
Аватара пользователя
 
Сообщения: 16473
Зарегистрирован: 13.11.2005 (Вс) 2:43
Откуда: Казахстан, Петропавловск

Re: I love VB! (COM/ActiveX как реализовать события?)

Сообщение Хакер » 09.03.2014 (Вс) 22:54

Jack Ferre писал(а):Как я и ожидал, мой объект класса FlashEvents был отвергнут, буду мудрить дальше.

Я тебе ещё раз говорю. Тебе не нужна AtlAdvise. Тебе нужен WithEvents. Но вообще тебе не нужен WithEvents, тебе нужно обычное рядовое использование контрола.

И не надо мудрить. Для тебя это игра в метод тыка, для меня же — кристально ясный факт того, что твоя попытка подсунуть класс FlashEvents ни за что не будет успешной. Потому что я имею абсолютно ясное представление о том, как устроен механизм событий в COM.
—We separate their smiling faces from the rest of their body, Captain.
—That's right! We decapitate them.

neit95
Начинающий
Начинающий
Аватара пользователя
 
Сообщения: 14
Зарегистрирован: 10.03.2013 (Вс) 22:05
Откуда: Калининград

Re: I love VB! (COM/ActiveX как реализовать события?)

Сообщение neit95 » 09.03.2014 (Вс) 23:33

Кстати, касательно ошибки при сохранении. Это случайно не H80004005? Если да, то та же проблема. Работаю из под администратора - не спасает. Вываливается при сохранении именно формы с контролом. Советы support.microsoft.com особо не помогли, по крайней мере подключение daxctle.ocx: при попытке закинуть контролы из этого ocx на форму, для 3 из 4 вываливается сообщение о нехватке памяти . Пробовал перерегистрировать ocx - не помогло.

Jack Ferre
Продвинутый пользователь
Продвинутый пользователь
Аватара пользователя
 
Сообщения: 132
Зарегистрирован: 17.02.2014 (Пн) 14:31
Откуда: Казахстан, Костанай

Re: I love VB! (COM/ActiveX как реализовать события?)

Сообщение Jack Ferre » 09.03.2014 (Вс) 23:54

2 neit95
Код ошибки не помню, но помню что смысла в ней особого нет, т.е. на конкретную проблему она не указывает.
В интернете решений, кроме как "использовать старую версию", не нашел.

2 Хакер
Как создать фунцкцию, имя которой начинается на "_"?

Хакер
Телепат
Телепат
Аватара пользователя
 
Сообщения: 16473
Зарегистрирован: 13.11.2005 (Вс) 2:43
Откуда: Казахстан, Петропавловск

Re: I love VB! (COM/ActiveX как реализовать события?)

Сообщение Хакер » 10.03.2014 (Пн) 1:16

Jack Ferre писал(а):Как создать фунцкцию, имя которой начинается на "_"?


Никак / Зачем?
—We separate their smiling faces from the rest of their body, Captain.
—That's right! We decapitate them.

Jack Ferre
Продвинутый пользователь
Продвинутый пользователь
Аватара пользователя
 
Сообщения: 132
Зарегистрирован: 17.02.2014 (Пн) 14:31
Откуда: Казахстан, Костанай

Re: I love VB! (COM/ActiveX как реализовать события?)

Сообщение Jack Ferre » 10.03.2014 (Пн) 1:23

Код: Выделить всё
Implements ShockwaveFlashObjectsCtl.[_IShockwaveFlashEvents]

Ошибка: Object module needs to implement 'OnReadyStateChange' for interface '_IShockwaveFlashEvents'
Нужно так:
Код: Выделить всё
Public Sub _IShockwaveFlashEvents_OnProgress(percentDone As Long)
    ' ...
End Sub

Хакер
Телепат
Телепат
Аватара пользователя
 
Сообщения: 16473
Зарегистрирован: 13.11.2005 (Вс) 2:43
Откуда: Казахстан, Петропавловск

Re: I love VB! (COM/ActiveX как реализовать события?)

Сообщение Хакер » 10.03.2014 (Пн) 2:45

Слушай. Ты специально делаешь так, чтобы я перестал отвечать?

Я очень не люблю людей, которые приходят с вопросом «Я только что помыл свою кошку, как теперь лучше всего высушить её в микроволновке?», и когда им говоришь «Ни в коем случае не суши кошку в микроволновке, это её убьёт», они говорят «Да, пожалуй ты прав», и через некоторое время продолжают спрашивать «Какой режим микроволновки лучше всего для сушки шерсти?», из чего становится понятно, что от своей идеи они не отказались, хоть им и было сказано, что идея неприемлемая.

А у тебя есть А, у тебя есть Б. Я сказал, как нужно делать А. Я сказал, что если делать А как нужно, то необходимости в Б вообще не будет. Кроме того, я сказал, как правильно делать Б. Но я вижу, что ты и А намерен делать по прежнему не так, как я сказал, и Б тоже намерен делать так, как я сказал не делать. Если ты считаешь, что к моим словам не стоит прислушивать, то я считаю, что нет смысла оказывать помощь.
—We separate their smiling faces from the rest of their body, Captain.
—That's right! We decapitate them.

VisualFreeBasic
Начинающий
Начинающий
 
Сообщения: 12
Зарегистрирован: 14.02.2021 (Вс) 20:28

Re: I love VB! (COM/ActiveX как реализовать события?)

Сообщение VisualFreeBasic » 16.02.2021 (Вт) 19:41

visual freebasic ide ,code like this:
Код: Выделить всё
Const ProgID = "ComTest"
Const CLSID_Com = "{920DCEED-B3DD-4110-8F2F-981A554E07FF}"
'Event--------
Const IID___Com = "{62DD544B-09E0-4340-8FF8-41CCC0FD0666}"

Type IClassFactoryImp Extends IClassFactoryVtbl
   Declare Constructor()
End Type


Function IClassFactoryx_QueryInterface(ByVal This As IClassFactory Ptr, ByVal riid As REFIID, ByVal ppvObject As LPVOID Ptr) As HRESULT
   if IsEqualIID(riid, @IID_IUnknown) Then
   ElseIf IsEqualIID(riid, @IID_IDispatch) Then
   ElseIf IsEqualIID(riid, @IID_IClassFactory) Then
   elseif (IsEqualIID(riid, @IID_IConnectionPointContainer)) Then
      MsgBox "控件"
   Else
      RETURN E_NOINTERFACE
   End If
    *ppvObject = This
   Return S_OK
End Function

Function IClassFactoryx_AddRef(ByVal This As IClassFactory Ptr) As HRESULT
   Return S_OK
End Function

Function IClassFactoryx_Release(byVal This As IClassFactory Ptr) As HRESULT
   Return S_OK
End Function

Function IClassFactoryx_CreateInstance(byval This as IClassFactory ptr, byval pUnkOuter as IUnknown ptr, byval riid as const IID const ptr, byval ppvObject as any ptr ptr) as HRESULT
   if IsEqualIID(riid, @IID_IUnknown) Then
   ElseIf IsEqualIID(riid, @IID_IDispatch) Then
   ElseIf IsEqualIID(riid, @IID_IClassFactory) Then
       *ppvObject = this
      Return S_OK
   Else
      RETURN E_NOINTERFACE
   End If
   dim IDB As IDispatch ptr = New IDispatch
   IDB->lpVtbl = New Demo()
   *ppvObject = IDB
   IUnknown_Release(IDB)
   return S_OK
End Function

Function IClassFactoryx_LockServer(byval This as IClassFactory ptr, byval fLock as WINBOOL) as HRESULT
   return S_OK
End Function

Constructor IClassFactoryImp()
   This.QueryInterface = @IClassFactoryx_QueryInterface '0
   This.AddRef = @IClassFactoryx_AddRef '4
   This.Release = @IClassFactoryx_Release '8
   This.CreateInstance = @IClassFactoryx_CreateInstance '12
   This.LockServer = @IClassFactoryx_LockServer '16
End Constructor

Type Demo Extends IDispatchVtbl
   
   TestOpen As function(ByVal This As IDispatch Ptr) As HRESULT'32
   Declare Constructor()
End Type

Function Demo_QueryInterface(ByVal This As IDispatch PTR, ByVal riid As REFIID, ByVal ppvObject As LPVOID Ptr) As HRESULT
   if IsEqualIID(riid, @IID_IUnknown) Then
   ElseIf IsEqualIID(riid, @IID_IDispatch) Then
   ElseIf (IsEqualIID(riid, @IID_IConnectionPointContainer)) Then
      MsgBox "这是要找控件"
   Else
      RETURN E_NOINTERFACE
   End If
    *ppvObject = This
   Return S_OK
End Function

Function Demo_AddRef(ByVal This As IDispatch PTR) As HRESULT
   Return S_OK
End Function

Function Demo_Release(ByVal This As IDispatch PTR) As HRESULT
   Return S_OK
End Function

Function Demo_GetTypeInfoCount(ByVal This As IDispatch PTR, ByVal pctinfo As UINT Ptr) As HRESULT
    *pctinfo = 0
'   MsgBox "Demo_GetTypeInfoCount"
   Return S_OK
End Function

Function Demo_GetTypeInfo(ByVal This As IDispatch PTR, ByVal iTInfo As UINT, ByVal lcid As LCID, ByVal ppTInfo As ITypeInfo Ptr Ptr) As HRESULT
'   Dim TI As ITypeInfo Ptr=New ITypeInfo
'   TI->lpVtbl=new TypeInfoImp
'   *ppTInfo=TI
'   MsgBox "Demo_GetTypeInfo"
   Return S_OK
End Function

Function Demo_GetIDsOfNames(ByVal This As IDispatch PTR, ByVal riid As Const IID Const Ptr, ByVal rgszNames As LPOLESTR Ptr, ByVal cNames As UINT, ByVal lcid As LCID, ByVal rgDispId As DISPID Ptr) As HRESULT
   Select case *rgszNames[0]
      Case "Add"
          *rgDispId = 1
   End Select
   Return S_OK
End Function

Function Demo_Invoke(ByVal This As IDispatch PTR, ByVal dispIdMember As DISPID, ByVal riid As Const IID Const Ptr, ByVal lcid As LCID, ByVal wFlags As WORD, ByVal pDispParams As DISPPARAMS Ptr, ByVal pVarResult As VARIANT Ptr, ByVal pExcepInfo As EXCEPINFO Ptr, ByVal puArgErr As UINT Ptr) As HRESULT
   Dim p As Parameters
   p.Count = pDispParams->cArgs
   if p.Count > 0 then
      ReDim p.Item(p.Count -1)
      For i As Long = 0 to pDispParams->cArgs -1
         p.Item(i).Value = pDispParams->rgvarg[i]
      Next
   end if
   select case dispIdMember
      Case 1
         Dim r As Long
         r = p.Item(0).Value.lVal + p.Item(1).Value.lVal
          *pVarResult = CVAR(r)
   End Select
   Return S_OK
End Function

Function Demo_Open(ByVal This As IDispatch PTR) As HRESULT
   MsgBox"test"
   Return S_OK
End Function

Constructor Demo()
   This.QueryInterface = @Demo_QueryInterface '0
   This.AddRef = @Demo_AddRef '4
   This.Release = @Demo_Release '8
   This.GetTypeInfoCount = @Demo_GetTypeInfoCount '12
   This.GetTypeInfo = @Demo_GetTypeInfo '16
   This.GetIDsOfNames = @Demo_GetIDsOfNames '20
   This.Invoke = @Demo_Invoke '24
   This.TestOpen = @Demo_Open '28
End Constructor

Sub test()
   Dim IDB As IDispatch Ptr = New IDispatch
   IDB->lpVtbl = New Demo
   Dim ret As VARIANT
   DispCallFunc(IDB, 28, 1, vbLong, 0, 0, 0, @ret)
End sub

VisualFreeBasic
Начинающий
Начинающий
 
Сообщения: 12
Зарегистрирован: 14.02.2021 (Вс) 20:28

Re: I love VB! (COM/ActiveX как реализовать события?)

Сообщение VisualFreeBasic » 16.02.2021 (Вт) 20:02

form1:
Код: Выделить всё
Option Explicit
Dim ExcelApp As Object
Private Sub Command1_Click()
    Set ExcelApp = CreateObject("excel.application")
    Advise ExcelApp
    ExcelApp.Visible = True
    ExcelApp.WorkBooks.Add
End Sub


basefile:
Код: Выделить всё
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


Вложения
comEvent.zip
(183.14 Кб) Скачиваний: 115

VisualFreeBasic
Начинающий
Начинающий
 
Сообщения: 12
Зарегистрирован: 14.02.2021 (Вс) 20:28

Re: I love VB! (COM/ActiveX как реализовать события?)

Сообщение VisualFreeBasic » 16.02.2021 (Вт) 20:16

you can use TLBINF32.DLL,LIST ALL EVENT NAME,GUID,CLSID,AND ARGS NAME,ARGS type,so it's good

След.

Вернуться в Visual Basic 1–6

Кто сейчас на конференции

Сейчас этот форум просматривают: Google-бот, Mail.ru [бот] и гости: 10

    TopList