home *** CD-ROM | disk | FTP | other *** search
- {*******************************************************}
- { Borland Delphi Visual Component Library }
- { Support classes for hosting servers in IDE }
- { }
- { $Revision: 1.19 $ }
- { Copyright (c) 1999 Inprise Corporation }
- {*******************************************************}
- unit OleServer;
-
- {$R-}
-
- interface
-
- uses Windows, Messages, ActiveX, SysUtils, Classes, ComObj;
-
- type
- TVariantArray = Array of OleVariant;
- TOleServer = class;
- TConnectKind = (ckRunningOrNew, // Attach to a running or create a new instance of the server
- ckNewInstance, // Create a new instance of the server
- ckRunningInstance, // Attach to a running instance of the server
- ckRemote, // Bind to a remote instance of the server
- ckAttachToInterface); // Don't bind to server, user will provide interface via 'CpnnectTo'
-
- TServerEventDispatch = class(TObject, IUnknown, IDispatch)
- protected
- { IUnknown }
- function QueryInterface(const IID: TGUID; out Obj): HResult; stdcall;
- function _AddRef: Integer; stdcall;
- function _Release: Integer; stdcall;
- { IDispatch }
- function GetTypeInfoCount(out Count: Integer): HResult; stdcall;
- function GetTypeInfo(Index, LocaleID: Integer; out TypeInfo): HResult; stdcall;
- function GetIDsOfNames(const IID: TGUID; Names: Pointer;
- NameCount, LocaleID: Integer; DispIDs: Pointer): HResult; stdcall;
- function Invoke(DispID: Integer; const IID: TGUID; LocaleID: Integer;
- Flags: Word; var Params; VarResult, ExcepInfo, ArgErr: Pointer): HResult; stdcall;
- property Server: TOleServer;
- function ServerDisconnect :Boolean;
- public
- constructor Create(Server: TOleServer);
- end;
-
- PServerData = ^TServerData;
- TServerData = record
- ClassID: TGUID; // CLSID of CoClass
- IntfIID: TGUID; // IID of default interface
- EventIID: TGUID; // IID of default source interface
- LicenseKey: Pointer; // Pointer to license string (not implemented)
- Version: Integer; // Version of this structure
- InstanceCount: Integer; // Instance of the Server running
- end;
-
- TOleServer = class(TComponent, IUnknown)
- protected
- { IUnknown }
- function QueryInterface(const IID: TGUID; out Obj): HResult; override;
- function _AddRef: Integer; stdcall;
- function _Release: Integer; stdcall;
-
- procedure Loaded; override;
- procedure InitServerData; virtual; abstract;
-
- function GetServer: IUnknown; virtual;
-
- procedure ConnectEvents(const Obj: IUnknown);
- procedure DisconnectEvents(const Obj: Iunknown);
- procedure InvokeEvent(DispID: TDispID; var Params: TVariantArray); virtual;
-
- function GetConnectKind: TConnectKind;
- procedure SetConnectKind(ck: TConnectKind);
-
- function GetAutoConnect: Boolean;
- procedure SetAutoConnect(flag: Boolean);
-
- property ServerData: PServerData;
- property EventDispatch: TServerEventDispatch;
-
- public
- constructor Create(AOwner: TComponent); override;
- destructor Destroy; override;
-
- // NOTE: If derived class is generated by TLIBIMP or ImportTypeLibraryCodeGenerator,
- // the derived class will also expose a 'ConnectTo(interface)' function.
- // You must invoke that method if you're using 'ckAttachToInterface' connection
- // kind.
- procedure Connect; virtual; abstract;
- procedure Disconnect; virtual; abstract;
-
- published
- property AutoConnect: Boolean;
- property ConnectKind: TConnectKind;
- property RemoteMachineName: string;
- end;
-
-
- implementation
-