1,183
社区成员
发帖
与我相关
我的任务
分享
unit RealOAMessengerAutoServer;
{$WARN SYMBOL_PLATFORM OFF}
interface
uses
ComObj, ActiveX, AxCtrls, Classes, RealICQCOM_TLB, StdVcl,Dialogs;
type
TRealOAMessengerAutoServer = class(TAutoObject, IConnectionPointContainer, IRealOAMessengerAutoServer)
private
{ Private declarations }
FConnectionPoints: TConnectionPoints;
FConnectionPoint: TConnectionPoint;
FEvents: IRealOAMessengerAutoServerEvents;
{ note: FEvents maintains a *single* event sink. For access to more
than one event sink, use FConnectionPoint.SinkList, and iterate
through the list of sinks. }
public
procedure Initialize; override;
protected
procedure AddText(const NewText: WideString); safecall;
procedure clear; safecall;
{ Protected declarations }
property ConnectionPoints: TConnectionPoints read FConnectionPoints
implements IConnectionPointContainer;
procedure EventSinkChanged(const EventSink: IUnknown); override;
end;
implementation
uses ComServ;
procedure TRealOAMessengerAutoServer.EventSinkChanged(const EventSink: IUnknown);
begin
FEvents := EventSink as IRealOAMessengerAutoServerEvents;
end;
procedure TRealOAMessengerAutoServer.Initialize;
begin
inherited Initialize;
FConnectionPoints := TConnectionPoints.Create(Self);
if AutoFactory.EventTypeInfo <> nil then
FConnectionPoint := FConnectionPoints.CreateConnectionPoint(
AutoFactory.EventIID, ckSingle, EventConnect)
else FConnectionPoint := nil;
end;
procedure TRealOAMessengerAutoServer.AddText(const NewText: WideString);
begin
if FEvents <> nil then FEvents.OnTextChanged('我成功了');
// showmessage('dsf');
end;
procedure TRealOAMessengerAutoServer.clear;
begin
end;
initialization
TAutoObjectFactory.Create(ComServer, TRealOAMessengerAutoServer, Class_RealOAMessengerAutoServer,
ciMultiInstance, tmApartment);
end.
IRealOAMessengerAutoServerDisp = dispinterface
['{5C187B3A-8691-4561-AA31-FAEDEBA42A10}']
procedure clear; dispid 201;
procedure AddText(const NewText: WideString); dispid 202;
end;
IRealOAMessengerAutoServerEvents = dispinterface
['{00BC3F20-3265-403C-B0E3-69DF1C6EF89D}']
procedure OnTextChanged(const NewText: WideString); dispid 203;
procedure OnClear; dispid 204;
end;
unit main;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls;
const
CLASS_AutoTest: TGUID = '{64C576F0-C9A7-420A-9EAB-0BE98264BC9D}';
type
TForm1 = class(TForm)
Button1: TButton;
Button2: TButton;
Edit1: TEdit;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
private
FVar: OleVariant;
procedure OnEditChange(const NewText: WideString);
procedure OnClear;
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
uses ComObj;
procedure TForm1.Button1Click(Sender: TObject);
begin
FVar := CreateOleObject('RealICQCOM.RealOAMessengerAutoServer');//Srv.AutoTest');
// FVar.OnTextChanged:=OnEditChange('d');
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
FVar.AddText(Edit1.Text);
end;
procedure TForm1.OnClear;
begin
self.Edit1.Clear;
end;
procedure TForm1.OnEditChange(const NewText: WideString);
begin
showmessage(NewText);
end;
end.
Fobject:IUnKnown;//声明
Fobject:= CreateComObject(Class_AutoTest) as IUnKnown;//创建实例
InterfaceConnect(Fobject, IRealOAMessengerAutoServerEvents, FEventSink, FCookie);//连接,其中FEventSink是接收器。