对于使用CreateOleObject创建的对象，怎样定义它的fire 事件。

Question

兄弟我一直写vc的程序，现在要修改别人的delphi程序。
只好试着写了我的问题是，一个nt service的守护程序，我使用了一个对象，它有event，可以在接收到请求时触发，但我不知道代码该怎样写，谢谢各位了

Answer 1

可能要用到sink,兄弟熟吗？
分不是问题，我还有7000多分。

Answer 2

需要实现一个IDispatch接口作事件接收器(EventSink)，
在接口里的invoke里实现事件代码，
创建ole对象后，
用InterfaceConnect将该接口连接上ole对象，
这样便可处理ole对象触发的事件了，
ole对象销毁前需要用InterfaceDisconnect断开之

Answer 3

具体实现方法可参考d5开发人员指南上的例子,
不过它给出的代码量有点大，
这里给出一个较简单的实现方法,第一步：创建一个EventSink(整个过程你只需写几行代码)File -> New -> ActiveX -> Automation object -> (Instancing Internal),
delphi为为你自动生成一个内部的自动化对象,
我们将用它作为EventSink,
把目标ole对象的事件定义加入它的方法列表，
(如：假定事件目标ole对象为某个网页的一个按钮的onclick事件，则往你的EventSink里加上一个同名的方法onclick，参数也要一致)
此时delphi会自动为你生成该事件的代码，不过是空的，往里面填上你的功能代码即可。
显然，我们需要实现对事件接口的支持，
故需重载ObjQueryInterface方法(被QueryInterface所调用)，
当传入iid为ole事件接口的iid时返回S_OK即可，
以下为EventSink相应代码:function TEventSink.ObjQueryInterface(const IID: TGUID; out Obj): HResult;
begin
  if IsEqualGUID(IID, Form1.OleEventIID) and GetInterface(IDispatch, Obj) then
    Result := S_OK
  else
    Result := inherited ObjQueryInterface(IID, Obj);
end;procedure TEventSink.OnClear;
begin
  Form1.Memo1.Clear; 
end;procedure TEventSink.OnTextChanged(const NewText: WideString);
begin
  Form1.Memo1.Text := NewText;
end;
第二步：绑定该EventSink到ole对象上在ole对象创建之后(假定在FormCreate中创建)
procedure TForm1.FormCreate(Sender: TObject);
begin
  FServer := CreateOleObject('MyTyplib.MyObj')
  FEvent := TEventSink.Create;
  TheOleEventIID := ?; 
  //TheOleEventIID: TGUID 为ole对象事件接口的iid, 可查其类型库得到
  InterfaceConnect(FServer, OleEventIID, FEvent, FConnection);
  //if FConnection > 0 then ShowMessage('连接成功。');
end;//ok, 大功告成。
//如有疑问，可向我要源代码例子

Answer 4

兄弟，我在国外，手头没有书，如果方便的话，希望能把例子发给我。[email protected]，或者[email protected]

Answer 5

我给你的[email protected]发了一份例程，
演示了动态绑定web页面中按钮点击事件的例子

Answer 6

//这是类型库自动生成的代码，我把delphi自动生成的注释删掉了，方便阅读
//请注意，这里onclick指定的dispid跟HTMLButtonElementEvents2的IID一致。unit OleEventDemo_TLB;
{$TYPEDADDRESS OFF} 
interface
uses Windows, ActiveX, Classes, Graphics, OleServer, OleCtrls, StdVCL;
const
  // TypeLibrary Major and minor versions
  ClientDemo2MajorVersion = 1;
  ClientDemo2MinorVersion = 0;  LIBID_ClientDemo2: TGUID = '{8BE97D79-E940-458D-9C82-FCA7E0D4ED61}';  IID_IEventSink: TGUID = '{D7EB2580-1D81-4049-A211-B7438DE62D56}';
  CLASS_EventSink: TGUID = '{C4BE29E4-7139-4B3C-9AA0-4C476E293EAA}';
type
  IEventSink = interface;
  IEventSinkDisp = dispinterface;  EventSink = IEventSink;
  IEventSink = interface(IDispatch)
    ['{D7EB2580-1D81-4049-A211-B7438DE62D56}']
    function  onclick(const dispSource: IDispatch): WordBool; safecall;
  end;  IEventSinkDisp = dispinterface
    ['{D7EB2580-1D81-4049-A211-B7438DE62D56}']
    function  onclick(const dispSource: IDispatch): WordBool; dispid -600;
  end;  CoEventSink = class
    class function Create: IEventSink;
    class function CreateRemote(const MachineName: string): IEventSink;
  end;implementationuses ComObj;class function CoEventSink.Create: IEventSink;
begin
  Result := CreateComObject(CLASS_EventSink) as IEventSink;
end;class function CoEventSink.CreateRemote(const MachineName: string): IEventSink;
begin
  Result := CreateRemoteComObject(MachineName, CLASS_EventSink) as IEventSink;
end;end.

Answer 7

//接下来是接口的实现代码，
//这个是内部接口，无需注册
//注意其中的onclick代码，dispSource即网页中的event对象unit u_EventSink;interfaceuses
  ComObj, ActiveX, OleEventDemo_TLB, StdVcl, SysUtils;type
  TEventSink = class(TAutoObject, IEventSink)
  protected
    function onclick(const dispSource: IDispatch): WordBool; safecall;
    { Protected declarations }
  public
    function ObjQueryInterface(const IID: TGUID; out Obj): HResult; override; stdcall;
  end;implementation
uses ComServ, u_Main, Windows;function TEventSink.ObjQueryInterface(const IID: TGUID; out Obj): HResult;
begin
  if IsEqualGUID(IID, Form1.FEventIID) and GetInterface(IDispatch, Obj) then
    Result := S_OK
  else
    Result := inherited ObjQueryInterface(IID, Obj);
end;function TEventSink.onclick(const dispSource: IDispatch): WordBool;
begin
  OleVariant(dispSource).srcElement.style.backgroundColor := '#' + IntToHex(RGB(Random(256), Random(256), Random(256)), 6);
  Result := True;
end;initialization
  TAutoObjectFactory.Create(ComServer, TEventSink, Class_EventSink,
    ciInternal, tmApartment);
end.

Answer 8

//主程序：
unit u_Main;interfaceuses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, ToolWin, ComCtrls, OleEventDemo_TLB, ActiveX,
  OleCtrls, SHDocVw, MSHtml;type
  TForm1 = class(TForm)
    ToolBar1: TToolBar;
    wb: TWebBrowser;
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    StatusBar1: TStatusBar;
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
  private
    { Private declarations }
    procedure WriteHtml(const AHtml: String);
  public
    { Public declarations }
    FServer: IHTMLButtonElement;
    FEventIID: TGUID;
    FEvent: IEventSink;
    FConnection: Integer;    
  end;var
  Form1: TForm1;implementation
uses ComObj, u_EventSink;{$R *.DFM}procedure TForm1.FormCreate(Sender: TObject);
begin
  wb.Navigate('about:blank');
end;procedure TForm1.Button1Click(Sender: TObject);
begin
  WriteHtml('<html><body><button id=btn>测试按钮</button><br/>本页面中按钮响应代码来自delphi</body></html>');
end;procedure TForm1.Button2Click(Sender: TObject);
var doc: IHTMLDocument2; btn: IHTMLButtonElement;
begin
  doc := wb.Document as IHTMLDocument2;
  btn := doc.all.item('btn', EmptyParam) as IHTMLButtonElement;
  FServer := btn;
  FEvent := TEventSink.Create;
  FEventIID := HTMLButtonElementEvents2; 
  FConnection := 0;
  InterfaceConnect(FServer, FEventIID, FEvent, FConnection);
  StatusBar1.SimpleText := IntToStr(FConnection);
end;procedure TForm1.WriteHtml(const AHtml: String);
var 
  Stream: ActiveX.IStream;
  hHTMLText: HGLOBAL;
  psi: IPersistStreamInit;
begin
  if not Assigned(wb.Document) then Exit;
  hHTMLText := GlobalAlloc(GPTR, Length(AHtml) + 1);
  if 0 = hHTMLText then RaiseLastWin32Error;
  CopyMemory(Pointer(hHTMLText), PChar(AHtml), Length(AHtml));
  OleCheck(CreateStreamOnHGlobal(hHTMLText, True, Stream));
  try
    OleCheck(wb.Document.QueryInterface(IPersistStreamInit, psi));
    try
      OleCheck(psi.InitNew); 
      OleCheck(psi.Load(Stream));
    finally 
      psi := nil;
    end;
  finally 
    Stream := nil; 
  end;
end;procedure TForm1.Button3Click(Sender: TObject);
begin
  FServer.value := '已取消。';
  ComObj.InterfaceDisconnect(FServer, FEventIID, FConnection);
  StatusBar1.SimpleText := IntToStr(FConnection);
  FEvent := nil;
  FServer := nil;
end;end.