C
cuddle
Unregistered / Unconfirmed
GUEST, unregistred user!
我做了一个带事件的Automation进程外服务器,还有客户端程序,编译一切正常。但是就是不能实现事件。
我看书上说是:“进程外服务器的注册和进程内服务器的注册采用不一样的方法。”书上说运行ChartServer.exe/regserver来注册服务器程序。还说可以把“/regserver"加入命令行来实现对服务器的注册!!
请问,这个注册过程到底是什么样的?如何实现?注册后在”注册表编辑器“里面是不是能找到服务器的GUID项?
我的事件所以不能实现,是不是就是没有注册上的缘故?
谢谢,朋友指点!!!
具体代码是:
[red]unit MainForm;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls;
type
TForm1 = class(TForm)
ListBox1: TListBox;
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.DFM}
end.[/red]
********************************************************************************
[red]unit ChartSource;
interface
uses
ComObj, ActiveX, AxCtrls, Classes, ChartServer_TLB, StdVcl,MainForm;
type
TChartServer = class(TAutoObject, IConnectionPointContainer, IChartServer)
private
{ Private declarations }
FConnectionPoints: TConnectionPoints;
FConnectionPoint: TConnectionPoint;
FSinkList: TList;
FEvents: IChartServerEvents;
public
procedure Initialize; override;
protected
{ Protected declarations }
property ConnectionPoints: TConnectionPoints read FConnectionPoints
implements IConnectionPointContainer;
procedure EventSinkChanged(const EventSink: IUnknown); override;
procedure SendMessage(const Message: WideString); safecall;
end;
implementation
uses ComServ;
procedure TChartServer.EventSinkChanged(const EventSink: IUnknown);
begin
FEvents := EventSink as IChartServerEvents;
if FConnectionPoint <> nil then
FSinkList := FConnectionPoint.SinkList;
end;
procedure TChartServer.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 TChartServer.SendMessage(const Message: WideString);
begin
Form1.ListBox1.Items.Add(Message);
FEvents.EventMessage(Message);
end;
initialization
TAutoObjectFactory.Create(ComServer, TChartServer, Class_ChartServer,
ciMultiInstance, tmApartment);
end.[/red]
********************************************************************************
[red]unit ChartServer_TLB;
// ************************************************************************ //
// WARNING
// -------
// The types declared in this file were generated from data read from a
// Type Library. If this type library is explicitly or indirectly (via
// another type library referring to this type library) re-imported, or the
// 'Refresh' command of the Type Library Editor activated while editing the
// Type Library, the contents of this file will be regenerated and all
// manual modifications will be lost.
// ************************************************************************ //
// PASTLWTR : $Revision: 1.88 $
// File generated on 2003-6-9 16:24:27 from Type Library described below.
// *************************************************************************//
// NOTE:
// Items guarded by $IFDEF_LIVE_SERVER_AT_DESIGN_TIME are used by properties
// which return objects that may need to be explicitly created via a function
// call prior to any access via the property. These items have been disabled
// in order to prevent accidental use from within the object inspector. You
// may enable them by defining LIVE_SERVER_AT_DESIGN_TIME or by selectively
// removing them from the $IFDEF blocks. However, such items must still be
// programmatically created via a method of the appropriate CoClass before
// they can be used.
// ************************************************************************ //
// Type Lib: C:/Program Files/Borland/Delphi5/Projects/Design/Automation/ChartServer.tlb (1)
// IID/LCID: {5FD01C45-4186-4FB0-ADB1-4BC74DD133BA}/0
// Helpfile:
// DepndLst:
// (1) v2.0 stdole, (C:/WINNT/System32/stdole2.tlb)
// (2) v4.0 StdVCL, (C:/WINNT/System32/STDVCL40.DLL)
// ************************************************************************ //
{$TYPEDADDRESS OFF} // Unit must be compiled without type-checked pointers.
interface
uses Windows, ActiveX, Classes, Graphics, OleServer, OleCtrls, StdVCL;
// *********************************************************************//
// GUIDS declared in the TypeLibrary. Following prefixes are used:
// Type Libraries : LIBID_xxxx
// CoClasses : CLASS_xxxx
// DISPInterfaces : DIID_xxxx
// Non-DISP interfaces: IID_xxxx
// *********************************************************************//
const
// TypeLibrary Major and minor versions
ChartServerMajorVersion = 1;
ChartServerMinorVersion = 0;
LIBID_ChartServer: TGUID = '{5FD01C45-4186-4FB0-ADB1-4BC74DD133BA}';
IID_IChartServer: TGUID = '{6B7190CB-EE14-4FDE-8FDD-7EBB0D47BC7F}';
DIID_IChartServerEvents: TGUID = '{C67B1D48-E5CF-41EC-AE51-E1C82DE3CFF6}';
CLASS_ChartServer: TGUID = '{03F62979-3132-4BF0-84B0-ABAE2D7E507D}';
type
// *********************************************************************//
// Forward declaration of types defined in TypeLibrary
// *********************************************************************//
IChartServer = interface;
IChartServerDisp = dispinterface;
IChartServerEvents = dispinterface;
// *********************************************************************//
// Declaration of CoClasses defined in Type Library
// (NOTE: Here we map each CoClass to its Default Interface)
// *********************************************************************//
ChartServer = IChartServer;
// *********************************************************************//
// Interface: IChartServer
// Flags: (4416) Dual OleAutomation Dispatchable
// GUID: {6B7190CB-EE14-4FDE-8FDD-7EBB0D47BC7F}
// *********************************************************************//
IChartServer = interface(IDispatch)
['{6B7190CB-EE14-4FDE-8FDD-7EBB0D47BC7F}']
procedure SendMessage(const Message: WideString); safecall;
end;
// *********************************************************************//
// DispIntf: IChartServerDisp
// Flags: (4416) Dual OleAutomation Dispatchable
// GUID: {6B7190CB-EE14-4FDE-8FDD-7EBB0D47BC7F}
// *********************************************************************//
IChartServerDisp = dispinterface
['{6B7190CB-EE14-4FDE-8FDD-7EBB0D47BC7F}']
procedure SendMessage(const Message: WideString); dispid 1;
end;
// *********************************************************************//
// DispIntf: IChartServerEvents
// Flags: (0)
// GUID: {C67B1D48-E5CF-41EC-AE51-E1C82DE3CFF6}
// *********************************************************************//
IChartServerEvents = dispinterface
['{C67B1D48-E5CF-41EC-AE51-E1C82DE3CFF6}']
procedure EventMessage(const Message: WideString); dispid 2;
end;
// *********************************************************************//
// The Class CoChartServer provides a Create and CreateRemote method to
// create instances of the default interface IChartServer exposed by
// the CoClass ChartServer. The functions are intended to be used by
// clients wishing to automate the CoClass objects exposed by the
// server of this typelibrary.
// *********************************************************************//
CoChartServer = class
class function Create: IChartServer;
class function CreateRemote(const MachineName: string): IChartServer;
end;
TChartServerEventMessage = procedure(Sender: TObject; var Message: OleVariant) of object;
// *********************************************************************//
// OLE Server Proxy class declaration
// Server Object : TChartServer
// Help String : ChartServer Object
// Default Interface: IChartServer
// Def. Intf. DISP? : No
// Event Interface: IChartServerEvents
// TypeFlags : (2) CanCreate
// *********************************************************************//
{$IFDEF LIVE_SERVER_AT_DESIGN_TIME}
TChartServerProperties= class;
{$ENDIF}
TChartServer = class(TOleServer)
private
FOnEventMessage: TChartServerEventMessage;
FIntf: IChartServer;
{$IFDEF LIVE_SERVER_AT_DESIGN_TIME}
FProps: TChartServerProperties;
function GetServerProperties: TChartServerProperties;
{$ENDIF}
function GetDefaultInterface: IChartServer;
protected
procedure InitServerData; override;
procedure InvokeEvent(DispID: TDispID; var Params: TVariantArray); override;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
procedure Connect; override;
procedure ConnectTo(svrIntf: IChartServer);
procedure Disconnect; override;
procedure SendMessage(const Message: WideString);
property DefaultInterface: IChartServer read GetDefaultInterface;
published
{$IFDEF LIVE_SERVER_AT_DESIGN_TIME}
property Server: TChartServerProperties read GetServerProperties;
{$ENDIF}
property OnEventMessage: TChartServerEventMessage read FOnEventMessage write FOnEventMessage;
end;
{$IFDEF LIVE_SERVER_AT_DESIGN_TIME}
// *********************************************************************//
// OLE Server Properties Proxy Class
// Server Object : TChartServer
// (This object is used by the IDE's Property Inspector to allow editing
// of the properties of this server)
// *********************************************************************//
TChartServerProperties = class(TPersistent)
private
FServer: TChartServer;
function GetDefaultInterface: IChartServer;
constructor Create(AServer: TChartServer);
protected
public
property DefaultInterface: IChartServer read GetDefaultInterface;
published
end;
{$ENDIF}
procedure Register;
implementation
uses ComObj;
class function CoChartServer.Create: IChartServer;
begin
Result := CreateComObject(CLASS_ChartServer) as IChartServer;
end;
class function CoChartServer.CreateRemote(const MachineName: string): IChartServer;
begin
Result := CreateRemoteComObject(MachineName, CLASS_ChartServer) as IChartServer;
end;
procedure TChartServer.InitServerData;
const
CServerData: TServerData = (
ClassID: '{03F62979-3132-4BF0-84B0-ABAE2D7E507D}';
IntfIID: '{6B7190CB-EE14-4FDE-8FDD-7EBB0D47BC7F}';
EventIID: '{C67B1D48-E5CF-41EC-AE51-E1C82DE3CFF6}';
LicenseKey: nil;
Version: 500);
begin
ServerData := @CServerData;
end;
procedure TChartServer.Connect;
var
punk: IUnknown;
begin
if FIntf = nil then
begin
punk := GetServer;
ConnectEvents(punk);
Fintf:= punk as IChartServer;
end;
end;
procedure TChartServer.ConnectTo(svrIntf: IChartServer);
begin
Disconnect;
FIntf := svrIntf;
ConnectEvents(FIntf);
end;
procedure TChartServer.DisConnect;
begin
if Fintf <> nil then
begin
DisconnectEvents(FIntf);
FIntf := nil;
end;
end;
function TChartServer.GetDefaultInterface: IChartServer;
begin
if FIntf = nil then
Connect;
Assert(FIntf <> nil, 'DefaultInterface is NULL. Component is not connected to Server. You must call ''Connect'' or ''ConnectTo'' before this operation');
Result := FIntf;
end;
constructor TChartServer.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
{$IFDEF LIVE_SERVER_AT_DESIGN_TIME}
FProps := TChartServerProperties.Create(Self);
{$ENDIF}
end;
destructor TChartServer.Destroy;
begin
{$IFDEF LIVE_SERVER_AT_DESIGN_TIME}
FProps.Free;
{$ENDIF}
inherited Destroy;
end;
{$IFDEF LIVE_SERVER_AT_DESIGN_TIME}
function TChartServer.GetServerProperties: TChartServerProperties;
begin
Result := FProps;
end;
{$ENDIF}
procedure TChartServer.InvokeEvent(DispID: TDispID; var Params: TVariantArray);
begin
case DispID of
-1: Exit; // DISPID_UNKNOWN
2: if Assigned(FOnEventMessage) then
FOnEventMessage(Self, Params[0] {const WideString});
end; {case DispID}
end;
procedure TChartServer.SendMessage(const Message: WideString);
begin
DefaultInterface.SendMessage(Message);
end;
{$IFDEF LIVE_SERVER_AT_DESIGN_TIME}
constructor TChartServerProperties.Create(AServer: TChartServer);
begin
inherited Create;
FServer := AServer;
end;
function TChartServerProperties.GetDefaultInterface: IChartServer;
begin
Result := FServer.DefaultInterface;
end;
{$ENDIF}
procedure Register;
begin
RegisterComponents('Servers',[TChartServer]);
end;
end.[/red]
********************************************************************************
客户端代码为:
[red]program Clientprj;
uses
Forms,
ClientForm in 'ClientForm.pas' {Form1},
ChartServer_TLB in 'ChartServer_TLB.pas';
{$R *.RES}
begin
Application.Initialize;
Application.CreateForm(TForm1, Form1);
Application.Run;
end.[/red]
********************************************************************************
[red]unit ClientForm;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls,OleServer,ChartServer_TLB;
type
TForm1 = class(TForm)
ListBox1: TListBox;
Edit1: TEdit;
Button1: TButton;
ChartServer1: TChartServer;
procedure ChartServer1EventMessage(Sender:TObject;var Message:OleVariant);
procedure Button1Click(Sender:TObject);
procedure FormCreate(Sender:TObject);
procedure FormClose(Sender:TObject;var Action:TCloseAction);
private
FChart:IChartServer;
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.DFM}
procedure TForm1.ChartServer1EventMessage(Sender:TObject;var Message:OleVariant);
begin
ListBox1.Items.Add(Message);
end;
procedure TForm1.FormCreate(Sender:TObject);
begin
FChart:=CoChartServer.Create;
ChartServer1.ConnectTo(FChart);
end;
procedure TForm1.Button1Click(Sender:TObject);
begin
if Assigned(FChart)then
FChart.SendMessage(Edit1.Text);
end;
procedure TForm1.FormClose(Sender:TObject;var Action:TCloseAction);
begin
ChartServer1.Disconnect;
FChart:=nil;
end;
end.[/red]
谢谢大家了!!
我看书上说是:“进程外服务器的注册和进程内服务器的注册采用不一样的方法。”书上说运行ChartServer.exe/regserver来注册服务器程序。还说可以把“/regserver"加入命令行来实现对服务器的注册!!
请问,这个注册过程到底是什么样的?如何实现?注册后在”注册表编辑器“里面是不是能找到服务器的GUID项?
我的事件所以不能实现,是不是就是没有注册上的缘故?
谢谢,朋友指点!!!
具体代码是:
[red]unit MainForm;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls;
type
TForm1 = class(TForm)
ListBox1: TListBox;
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.DFM}
end.[/red]
********************************************************************************
[red]unit ChartSource;
interface
uses
ComObj, ActiveX, AxCtrls, Classes, ChartServer_TLB, StdVcl,MainForm;
type
TChartServer = class(TAutoObject, IConnectionPointContainer, IChartServer)
private
{ Private declarations }
FConnectionPoints: TConnectionPoints;
FConnectionPoint: TConnectionPoint;
FSinkList: TList;
FEvents: IChartServerEvents;
public
procedure Initialize; override;
protected
{ Protected declarations }
property ConnectionPoints: TConnectionPoints read FConnectionPoints
implements IConnectionPointContainer;
procedure EventSinkChanged(const EventSink: IUnknown); override;
procedure SendMessage(const Message: WideString); safecall;
end;
implementation
uses ComServ;
procedure TChartServer.EventSinkChanged(const EventSink: IUnknown);
begin
FEvents := EventSink as IChartServerEvents;
if FConnectionPoint <> nil then
FSinkList := FConnectionPoint.SinkList;
end;
procedure TChartServer.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 TChartServer.SendMessage(const Message: WideString);
begin
Form1.ListBox1.Items.Add(Message);
FEvents.EventMessage(Message);
end;
initialization
TAutoObjectFactory.Create(ComServer, TChartServer, Class_ChartServer,
ciMultiInstance, tmApartment);
end.[/red]
********************************************************************************
[red]unit ChartServer_TLB;
// ************************************************************************ //
// WARNING
// -------
// The types declared in this file were generated from data read from a
// Type Library. If this type library is explicitly or indirectly (via
// another type library referring to this type library) re-imported, or the
// 'Refresh' command of the Type Library Editor activated while editing the
// Type Library, the contents of this file will be regenerated and all
// manual modifications will be lost.
// ************************************************************************ //
// PASTLWTR : $Revision: 1.88 $
// File generated on 2003-6-9 16:24:27 from Type Library described below.
// *************************************************************************//
// NOTE:
// Items guarded by $IFDEF_LIVE_SERVER_AT_DESIGN_TIME are used by properties
// which return objects that may need to be explicitly created via a function
// call prior to any access via the property. These items have been disabled
// in order to prevent accidental use from within the object inspector. You
// may enable them by defining LIVE_SERVER_AT_DESIGN_TIME or by selectively
// removing them from the $IFDEF blocks. However, such items must still be
// programmatically created via a method of the appropriate CoClass before
// they can be used.
// ************************************************************************ //
// Type Lib: C:/Program Files/Borland/Delphi5/Projects/Design/Automation/ChartServer.tlb (1)
// IID/LCID: {5FD01C45-4186-4FB0-ADB1-4BC74DD133BA}/0
// Helpfile:
// DepndLst:
// (1) v2.0 stdole, (C:/WINNT/System32/stdole2.tlb)
// (2) v4.0 StdVCL, (C:/WINNT/System32/STDVCL40.DLL)
// ************************************************************************ //
{$TYPEDADDRESS OFF} // Unit must be compiled without type-checked pointers.
interface
uses Windows, ActiveX, Classes, Graphics, OleServer, OleCtrls, StdVCL;
// *********************************************************************//
// GUIDS declared in the TypeLibrary. Following prefixes are used:
// Type Libraries : LIBID_xxxx
// CoClasses : CLASS_xxxx
// DISPInterfaces : DIID_xxxx
// Non-DISP interfaces: IID_xxxx
// *********************************************************************//
const
// TypeLibrary Major and minor versions
ChartServerMajorVersion = 1;
ChartServerMinorVersion = 0;
LIBID_ChartServer: TGUID = '{5FD01C45-4186-4FB0-ADB1-4BC74DD133BA}';
IID_IChartServer: TGUID = '{6B7190CB-EE14-4FDE-8FDD-7EBB0D47BC7F}';
DIID_IChartServerEvents: TGUID = '{C67B1D48-E5CF-41EC-AE51-E1C82DE3CFF6}';
CLASS_ChartServer: TGUID = '{03F62979-3132-4BF0-84B0-ABAE2D7E507D}';
type
// *********************************************************************//
// Forward declaration of types defined in TypeLibrary
// *********************************************************************//
IChartServer = interface;
IChartServerDisp = dispinterface;
IChartServerEvents = dispinterface;
// *********************************************************************//
// Declaration of CoClasses defined in Type Library
// (NOTE: Here we map each CoClass to its Default Interface)
// *********************************************************************//
ChartServer = IChartServer;
// *********************************************************************//
// Interface: IChartServer
// Flags: (4416) Dual OleAutomation Dispatchable
// GUID: {6B7190CB-EE14-4FDE-8FDD-7EBB0D47BC7F}
// *********************************************************************//
IChartServer = interface(IDispatch)
['{6B7190CB-EE14-4FDE-8FDD-7EBB0D47BC7F}']
procedure SendMessage(const Message: WideString); safecall;
end;
// *********************************************************************//
// DispIntf: IChartServerDisp
// Flags: (4416) Dual OleAutomation Dispatchable
// GUID: {6B7190CB-EE14-4FDE-8FDD-7EBB0D47BC7F}
// *********************************************************************//
IChartServerDisp = dispinterface
['{6B7190CB-EE14-4FDE-8FDD-7EBB0D47BC7F}']
procedure SendMessage(const Message: WideString); dispid 1;
end;
// *********************************************************************//
// DispIntf: IChartServerEvents
// Flags: (0)
// GUID: {C67B1D48-E5CF-41EC-AE51-E1C82DE3CFF6}
// *********************************************************************//
IChartServerEvents = dispinterface
['{C67B1D48-E5CF-41EC-AE51-E1C82DE3CFF6}']
procedure EventMessage(const Message: WideString); dispid 2;
end;
// *********************************************************************//
// The Class CoChartServer provides a Create and CreateRemote method to
// create instances of the default interface IChartServer exposed by
// the CoClass ChartServer. The functions are intended to be used by
// clients wishing to automate the CoClass objects exposed by the
// server of this typelibrary.
// *********************************************************************//
CoChartServer = class
class function Create: IChartServer;
class function CreateRemote(const MachineName: string): IChartServer;
end;
TChartServerEventMessage = procedure(Sender: TObject; var Message: OleVariant) of object;
// *********************************************************************//
// OLE Server Proxy class declaration
// Server Object : TChartServer
// Help String : ChartServer Object
// Default Interface: IChartServer
// Def. Intf. DISP? : No
// Event Interface: IChartServerEvents
// TypeFlags : (2) CanCreate
// *********************************************************************//
{$IFDEF LIVE_SERVER_AT_DESIGN_TIME}
TChartServerProperties= class;
{$ENDIF}
TChartServer = class(TOleServer)
private
FOnEventMessage: TChartServerEventMessage;
FIntf: IChartServer;
{$IFDEF LIVE_SERVER_AT_DESIGN_TIME}
FProps: TChartServerProperties;
function GetServerProperties: TChartServerProperties;
{$ENDIF}
function GetDefaultInterface: IChartServer;
protected
procedure InitServerData; override;
procedure InvokeEvent(DispID: TDispID; var Params: TVariantArray); override;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
procedure Connect; override;
procedure ConnectTo(svrIntf: IChartServer);
procedure Disconnect; override;
procedure SendMessage(const Message: WideString);
property DefaultInterface: IChartServer read GetDefaultInterface;
published
{$IFDEF LIVE_SERVER_AT_DESIGN_TIME}
property Server: TChartServerProperties read GetServerProperties;
{$ENDIF}
property OnEventMessage: TChartServerEventMessage read FOnEventMessage write FOnEventMessage;
end;
{$IFDEF LIVE_SERVER_AT_DESIGN_TIME}
// *********************************************************************//
// OLE Server Properties Proxy Class
// Server Object : TChartServer
// (This object is used by the IDE's Property Inspector to allow editing
// of the properties of this server)
// *********************************************************************//
TChartServerProperties = class(TPersistent)
private
FServer: TChartServer;
function GetDefaultInterface: IChartServer;
constructor Create(AServer: TChartServer);
protected
public
property DefaultInterface: IChartServer read GetDefaultInterface;
published
end;
{$ENDIF}
procedure Register;
implementation
uses ComObj;
class function CoChartServer.Create: IChartServer;
begin
Result := CreateComObject(CLASS_ChartServer) as IChartServer;
end;
class function CoChartServer.CreateRemote(const MachineName: string): IChartServer;
begin
Result := CreateRemoteComObject(MachineName, CLASS_ChartServer) as IChartServer;
end;
procedure TChartServer.InitServerData;
const
CServerData: TServerData = (
ClassID: '{03F62979-3132-4BF0-84B0-ABAE2D7E507D}';
IntfIID: '{6B7190CB-EE14-4FDE-8FDD-7EBB0D47BC7F}';
EventIID: '{C67B1D48-E5CF-41EC-AE51-E1C82DE3CFF6}';
LicenseKey: nil;
Version: 500);
begin
ServerData := @CServerData;
end;
procedure TChartServer.Connect;
var
punk: IUnknown;
begin
if FIntf = nil then
begin
punk := GetServer;
ConnectEvents(punk);
Fintf:= punk as IChartServer;
end;
end;
procedure TChartServer.ConnectTo(svrIntf: IChartServer);
begin
Disconnect;
FIntf := svrIntf;
ConnectEvents(FIntf);
end;
procedure TChartServer.DisConnect;
begin
if Fintf <> nil then
begin
DisconnectEvents(FIntf);
FIntf := nil;
end;
end;
function TChartServer.GetDefaultInterface: IChartServer;
begin
if FIntf = nil then
Connect;
Assert(FIntf <> nil, 'DefaultInterface is NULL. Component is not connected to Server. You must call ''Connect'' or ''ConnectTo'' before this operation');
Result := FIntf;
end;
constructor TChartServer.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
{$IFDEF LIVE_SERVER_AT_DESIGN_TIME}
FProps := TChartServerProperties.Create(Self);
{$ENDIF}
end;
destructor TChartServer.Destroy;
begin
{$IFDEF LIVE_SERVER_AT_DESIGN_TIME}
FProps.Free;
{$ENDIF}
inherited Destroy;
end;
{$IFDEF LIVE_SERVER_AT_DESIGN_TIME}
function TChartServer.GetServerProperties: TChartServerProperties;
begin
Result := FProps;
end;
{$ENDIF}
procedure TChartServer.InvokeEvent(DispID: TDispID; var Params: TVariantArray);
begin
case DispID of
-1: Exit; // DISPID_UNKNOWN
2: if Assigned(FOnEventMessage) then
FOnEventMessage(Self, Params[0] {const WideString});
end; {case DispID}
end;
procedure TChartServer.SendMessage(const Message: WideString);
begin
DefaultInterface.SendMessage(Message);
end;
{$IFDEF LIVE_SERVER_AT_DESIGN_TIME}
constructor TChartServerProperties.Create(AServer: TChartServer);
begin
inherited Create;
FServer := AServer;
end;
function TChartServerProperties.GetDefaultInterface: IChartServer;
begin
Result := FServer.DefaultInterface;
end;
{$ENDIF}
procedure Register;
begin
RegisterComponents('Servers',[TChartServer]);
end;
end.[/red]
********************************************************************************
客户端代码为:
[red]program Clientprj;
uses
Forms,
ClientForm in 'ClientForm.pas' {Form1},
ChartServer_TLB in 'ChartServer_TLB.pas';
{$R *.RES}
begin
Application.Initialize;
Application.CreateForm(TForm1, Form1);
Application.Run;
end.[/red]
********************************************************************************
[red]unit ClientForm;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls,OleServer,ChartServer_TLB;
type
TForm1 = class(TForm)
ListBox1: TListBox;
Edit1: TEdit;
Button1: TButton;
ChartServer1: TChartServer;
procedure ChartServer1EventMessage(Sender:TObject;var Message:OleVariant);
procedure Button1Click(Sender:TObject);
procedure FormCreate(Sender:TObject);
procedure FormClose(Sender:TObject;var Action:TCloseAction);
private
FChart:IChartServer;
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.DFM}
procedure TForm1.ChartServer1EventMessage(Sender:TObject;var Message:OleVariant);
begin
ListBox1.Items.Add(Message);
end;
procedure TForm1.FormCreate(Sender:TObject);
begin
FChart:=CoChartServer.Create;
ChartServer1.ConnectTo(FChart);
end;
procedure TForm1.Button1Click(Sender:TObject);
begin
if Assigned(FChart)then
FChart.SendMessage(Edit1.Text);
end;
procedure TForm1.FormClose(Sender:TObject;var Action:TCloseAction);
begin
ChartServer1.Disconnect;
FChart:=nil;
end;
end.[/red]
谢谢大家了!!