Текущий архив: 2007.10.28;
Скачать: CL | DM;

Вниз

Создание обработчика событий   Найти похожие ветки 

← →
kutnul   (2006-02-01 18:49) [0]

Доброго времени всем

Имеем библиотеку типов, в ней


*********************************************************************//
// DispIntf:   DSonicEvents
// Flags:     (4112) Hidden Dispatchable
// GUID:      {35D54C21-5894-F12A-CD54-00402513A157}
// *********************************************************************//
DSonicEvents = dispinterface
  ["{35D54C21-5894-F12A-CD54-00402513A157}"]
   function FileOpenNotify(const FileName: WideString): Integer; dispid 1;
.............
   function ActiveDocChangeNotify: Integer; dispid 4;
.............
 end;


Разъясните начинающему
1. что надо сделать для того чтобы перехватить события на сервере
2. как активировать на сервере

С уважением!

---

← →
Набережных С. ©   (2006-02-02 08:41) [1]

Ссылаешься в uses на модуль OleAuto и объявляешь класс - наследник от объявленного там TAutoObject. В этом классе заводишь секцию automated, в которой объявляешь методы твоего диспинтерфейса с теми же dispid. реализуешь эти мтоды, разумеется. Дальше, куогда надо подключиться к событиям, создаешь этот объект примерно так

var
 Disp: IDispatch;
 Disp:= TMyDispObject.Create.AutoDispatch

Все, далее можно обычным образом передать этот интерфейс серверу в качестве приемника событий.

Модуль OleAuto объявлен устаревшим, однако мне его использование в ряде случаев представляется достаточно удобным.

Все то же самое можно проделать и унаследовавшись от TAutoIntfObject или ComObj.TAutoObject, но там еще потребуется загрузить библиотеку типов, что, впрочем, не является препятствием, когда эта библиотека имеется, как в данном случае.

Есть и другие способы, но там возни заметно больше.

---

← →
kutnul   (2006-02-02 16:02) [2]

Большое спасибо за содействие
буду пробовать

Уважаемый Набережных С

не прими за наглость
но можно ли о других способах услышать (или где почитать)
на емайл или в рамках данного форуму

ещё раз спасибо

---

← →
kutnul   (2006-02-02 19:23) [3]

Брррр
не идет процесс

Во-первых
var
Disp: IDispatch;
Disp:= TMyDispObject.Create.AutoDispatch
пишет что несовместимы типы TAutoDispatch и IDispatch
пробовал и так и сяк

var
DispEv : iDispatch;
AutoMobil : TAutoDispatch;
begin
DispEv := TMyEvent.Create.AutoDispatch;
MyEvent := TMyEvent.Create;
AutoMobil := TMyEvent.Create.CreateAutoDispatch;
Automobil := TAutoDispatch.Create(MyEvent);


Во-вторых, правильно ли я понял, что
>> Все, далее можно обычным образом передать этот интерфейс серверу в качестве приемника событий.
то для этого необходимо -  InterfaceConnect (MySonicSrv, ISonicSrv, MyEvent, FCookie);
опят же не идет

что делать как быть?
привожу исходник

uses
 Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
 Dialogs, ComObj, OleAuto, SonicSrv_TLB;

type
   TMyEvent = class ;
 TForm1 = class(TForm)
   procedure FormCreate(Sender: TObject);
 private
   { Private declarations }
   MySonicSrv : ISonicSrv;
   FCookie : Integer;
 public
   { Public declarations }
 end;
 TMyEvent = class (TAutoObject)
   public
   { Public declarations }
   automated
   function DestroyNotify: Integer; dispid 3;
   function ActiveDocChangeNotify: Integer; dispid 4;
 end;

var
 Form1: TForm1;
 MyEvent : TMyEvent;

implementation

{$R *.dfm}

function TMyEvent.DestroyNotify():Integer ;
begin
ShowMessage ("Удаление ");
end;

function TMyEvent.ActiveDocChangeNotify(): Integer ;
begin
ShowMessage ("Произошло изменение активного документа");
end;

procedure TForm1.FormCreate(Sender: TObject);
var
DispEv : iDispatch;
AutoMobil : TAutoDispatch;
begin
MyEvent := TMyEvent.Create;
AutoMobil := TMyEvent.Create.CreateAutoDispatch;
Automobil := TAutoDispatch.Create(MyEvent);

MySonicSrv := CoSonicSrv_.Create;
MySonicSrv.Visible := True;
InterfaceConnect (MySonicSrv, ISonicSrv, MyEvent, FCookie);

end;

end.


---

← →
Набережных С. ©   (2006-02-03 08:57) [4]

> kutnul   (02.02.06 19:23) [3]
> Брррр
> не идет процесс

Еще бы:( Дело в том, что у меня модуль OleAuto основательно переделан, и не только он. А я об этом напрочь забыл:(( Еще хуже то, что я не помню что и где я изменил, давно я им не пользовался. А разбираться с этим сейчас мне не с руки, у меня была тяжелая ночь, почти не спал. Так что извини, виноват.

Я тут выкопал у себя вот этот класс:

unit DispatchEventsUnt;

interface

uses
 Windows, Messages, SysUtils, ComObj, ActiveX;

type
 TDispatchEvents = class(TObject, IUnknown, IDispatch)
 private
   FDispIID: TGUID;
   FConnectionID: integer;
   FSource: Pointer;
 protected
   { IUnknown }
   function QueryInterface(const IID: TGUID; out Obj): HResult; stdcall;
   function _AddRef: Integer; stdcall;
   function _Release: Integer; stdcall;

   { IDispatch }
   function GetIDsOfNames(const IID: TGUID; Names: Pointer;
     NameCount, LocaleID: Integer; DispIDs: Pointer): HResult; virtual; stdcall;
   function GetTypeInfo(Index, LocaleID: Integer; out TypeInfo): HResult; virtual; stdcall;
   function GetTypeInfoCount(out Count: Integer): HResult; virtual; stdcall;
   function Invoke(DispID: Integer; const IID: TGUID; LocaleID: Integer;
     Flags: Word; var Params; VarResult, ExcepInfo, ArgErr: Pointer): HResult; virtual; stdcall;

   function DoInvoke (DispID: Integer; LocaleID: Integer;
     var Params: TDispParams; VarResult, ExcepInfo,
     ArgErr: Pointer): HResult; virtual; abstract;
 public
   constructor Create(const DisIntfID: TGUID);
   destructor Destroy; override;

   procedure Connect(const Source: IUnknown);
   procedure Disconnect;
   
   property DispIID: TGUID read FDispIID;
 end;

implementation

{ TDispatchEvents }

function TDispatchEvents._AddRef: Integer;
begin
 Result:= 1;
end;

function TDispatchEvents._Release: Integer;
begin
 Result:= 1;
end;

function TDispatchEvents.GetIDsOfNames(const IID: TGUID; Names: Pointer;
 NameCount, LocaleID: Integer; DispIDs: Pointer): HResult;
begin
 Result:= E_NOTIMPL;
end;

function TDispatchEvents.GetTypeInfo(Index, LocaleID: Integer;
 out TypeInfo): HResult;
begin
 Result:= E_NOTIMPL;
end;

function TDispatchEvents.GetTypeInfoCount(out Count: Integer): HResult;
begin
 Result:= S_OK;
 Count:= 0;
end;

function TDispatchEvents.Invoke(DispID: Integer; const IID: TGUID;
 LocaleID: Integer; Flags: Word; var Params; VarResult, ExcepInfo,
 ArgErr: Pointer): HResult;
begin
 if Flags and DISPATCH_METHOD = 0 then
   raise EOleError.CreateFmt
     ("Class %s only dispatcing methods support.", [ClassName]);

 Result:= DoInvoke(DispID, LocaleID, TDispParams(Params),
   VarResult, ExcepInfo, ArgErr);
end;

function TDispatchEvents.QueryInterface(const IID: TGUID;
 out Obj): HResult;
begin
 if IsEqualGUID(IID, FDispIID) then
 begin
   Result:= S_OK;
   IDispatch(Obj):= Self;
 end else
 begin
   if GetInterface(IID, Obj) then Result:= S_OK
   else Result:= E_NOINTERFACE;
 end;
end;

constructor TDispatchEvents.Create(const DisIntfID: TGUID);
begin
 FDispIID:= DisIntfID;
end;

procedure TDispatchEvents.Connect(const Source: IUnknown);
begin
 Disconnect;
 if nil = Source then Exit;
 InterfaceConnect(Source, FDispIID, Self, FConnectionID);
 FSource:= Pointer(Source);
end;

destructor TDispatchEvents.Destroy;
begin
 Disconnect;
 inherited;
end;

procedure TDispatchEvents.Disconnect;
begin
 if nil <> FSource then
   InterfaceDisconnect(IUnknown(FSource), FDispIID, FConnectionID);
 FSource:= nil;
end;

end.


Это базовый класс, наследуясь от которого можно создавать реализаторы дисинтерфейсов. Создаешь наследника, в нем объявляешь и реализуешь методы твоего диспинтерфейса, также перекрываешь DoInvoke, в котором и вызываешь свои методы. Правда, диспетчирование нужно делать вручную, но это несложно. Например, для такого метода

procedure SomeMethod(const Value1: WideString; Value2: Integer);

c DispId = 333, реализация DoInvoke может быть такой:

function TMyEventSink.DoInvoke(DispID, LocaleID: Integer;
 var Params: TDispParams; VarResult, ExcepInfo, ArgErr: Pointer): HResult;
begin
 Result:= DISP_E_MEMBERNOTFOUND;
 case DispID of
   333:
   begin
     if Params.cArgs <> 2 then Exit;
     with Params do
       SomeMethod(rgvarg[1].bstrVal, rgvarg[0].iVal);
   end;
 end;
end;

Или можно, например, объявить в этом наследике событие и его генерировать. Обрати внимания, что аргументы в списке передаются в обратном порядке.

Вот это и есть один из других способов. Честно говоря, я не собирался выкладывать код, но раз уж ввел в заблуждение, то это как бы компенсация:)) Другой способ - сделать то же самое, но не в отдельном объете, а прямо внутри клиентского объекта, инкапсулирующего работу с сервером, если конечно таковой объект имеется.

Еще один - воспользоваться Import Type Library с генерацией компонента-обертки.

---

← →
kutnul   (2006-02-06 18:28) [5]

что-то не так
а что кто его знает

кое-какие сдвиги есть но....
что они значат - для моего темного разума не вдамек

используем класс (без изменений)  
TMyEventsSink = class (TDispatchEvents)
MyEventSonic : TMyEventsSink;
создаем экземпляр          MyEventSonic := MyEventsSink.Create(MyDiID_SonicSrv);
но при подключении       MyEventSonic.Connect(SonicSrv);
1. получаем ошибку
2. а при живом тыкание в приложении-сервере Sonic видим сообщение от Windows

Сервер занят
Действие не может быть завершено, так как
программа "Project1" не отвечает на запросы.
Перейдите в нужное окно с помощью кнопки
"Переключиться" и устраните ошибку.


т.е. получается сообщение от сервера получаю а обработать не могу - наверное?

Есть сомнение те ли параметры передаю в конструкторы
1. в TMyEventsSink.Create(MyDiID_SonicSrv) передаём  
из билиотеки типов
DSonicEvents = dispinterface
 ["{35D54C21-5894-F12A-CD54-00402513A157}"]
DIID_DSonicEvents: TGUID = "{35D54C21-5894-F12A-CD54-00402513A157}";
в клиенте
MyDiID_SonicSrv : TGUID;
MyDiID_SonicSrv := DIID_DSonicEvents;

2. MyEventSonic.Connect (SonicSrv);
где SonicSrv := CoSonicSrv_.Create;

3.1 На всякий случай - ни каких действий в методе DoInvoke - не делал - может и здесь ошибка
function TMyEventsSink.DoInvoke(DispID: Integer; LocaleID: Integer;
    var Params: TDispParams; VarResult, ExcepInfo,
    ArgErr: Pointer): HResult;
begin
  Result:= DISP_E_MEMBERNOTFOUND;
end;

3.2 да и в
function TMyEventsSink.Invoke то же - ничего
Result := S_ok; end;

С уважением!

---

Страницы: 1 вся ветка

Текущий архив: 2007.10.28;
Скачать: CL | DM;

Наверх

Память: 0.5 MB
Время: 0.021 c