
{*******************************************************}
{                                                       }
{       Borland Delphi Visual Component Library         }
{                                                       }
{  Copyright (c) 1999-2001 Borland Software Corporation }
{                                                       }
{*******************************************************}

unit OleServer;

{$R-}
{$WARN SYMBOL_PLATFORM OFF}

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
