vba_tlb.pas

基于Delphi的IP电话开发的源代码

// Flags:     (4432) Hidden Dual OleAutomation Dispatchable
// GUID:      {A4C466B8-499F-101B-BB78-00AA00383CBB}
// *********************************************************************//
  _ErrObjectDisp = dispinterface
    ['{A4C466B8-499F-101B-BB78-00AA00383CBB}']
    property Number: Integer dispid 0;
    property Source: WideString readonly dispid 1610743810;
    property Description: WideString readonly dispid 1610743812;
    property HelpFile: WideString readonly dispid 1610743814;
    property HelpContext: Integer readonly dispid 1610743816;
    procedure Raise_(Number: Integer; var Source: OleVariant; var Description: OleVariant; 
                     var HelpFile: OleVariant; var HelpContext: OleVariant); dispid 1610743818;
    procedure Clear; dispid 1610743819;
    property LastDllError: Integer readonly dispid 1610743820;
  end;

// *********************************************************************//
// Interface: _Collection
// Flags:     (4432) Hidden Dual OleAutomation Dispatchable
// GUID:      {A4C46780-499F-101B-BB78-00AA00383CBB}
// *********************************************************************//
  _Collection = interface(IDispatch)
    ['{A4C46780-499F-101B-BB78-00AA00383CBB}']
    function  Item(var Index: OleVariant): OleVariant; safecall;
    procedure Add(var Item: OleVariant; var Key: OleVariant; var Before: OleVariant; 
                  var After: OleVariant); safecall;
    function  Count: Integer; safecall;
    procedure Remove(var Index: OleVariant); safecall;
    function  _NewEnum: IUnknown; safecall;
  end;

// *********************************************************************//
// DispIntf:  _CollectionDisp
// Flags:     (4432) Hidden Dual OleAutomation Dispatchable
// GUID:      {A4C46780-499F-101B-BB78-00AA00383CBB}
// *********************************************************************//
  _CollectionDisp = dispinterface
    ['{A4C46780-499F-101B-BB78-00AA00383CBB}']
    function  Item(var Index: OleVariant): OleVariant; dispid 0;
    procedure Add(var Item: OleVariant; var Key: OleVariant; var Before: OleVariant; 
                  var After: OleVariant); dispid 1;
    function  Count: Integer; dispid 2;
    procedure Remove(var Index: OleVariant); dispid 3;
    function  _NewEnum: IUnknown; dispid -4;
  end;

// *********************************************************************//
// The Class CoErrObject provides a Create and CreateRemote method to          
// create instances of the default interface _ErrObject exposed by              
// the CoClass ErrObject. The functions are intended to be used by             
// clients wishing to automate the CoClass objects exposed by the         
// server of this typelibrary.                                            
// *********************************************************************//
  CoErrObject = class
    class function Create: _ErrObject;
    class function CreateRemote(const MachineName: string): _ErrObject;
  end;


// *********************************************************************//
// OLE Server Proxy class declaration
// Server Object    : TVBAErrObject
// Help String      : 
// Default Interface: _ErrObject
// Def. Intf. DISP? : No
// Event   Interface: 
// TypeFlags        : (2) CanCreate
// *********************************************************************//
{$IFDEF LIVE_SERVER_AT_DESIGN_TIME}
  TVBAErrObjectProperties= class;
{$ENDIF}
  TVBAErrObject = class(TOleServer)
  private
    FIntf:        _ErrObject;
{$IFDEF LIVE_SERVER_AT_DESIGN_TIME}
    FProps:       TVBAErrObjectProperties;
    function      GetServerProperties: TVBAErrObjectProperties;
{$ENDIF}
    function      GetDefaultInterface: _ErrObject;
  protected
    procedure InitServerData; override;
    function  Get_Number: Integer;
    procedure Set_Number(pi4: Integer);
    function  Get_Source: WideString;
    procedure Set_Source(const pbstr: WideString);
    function  Get_Description: WideString;
    procedure Set_Description(const pbstr: WideString);
    function  Get_HelpFile: WideString;
    procedure Set_HelpFile(const pbstr: WideString);
    function  Get_HelpContext: Integer;
    procedure Set_HelpContext(pi4: Integer);
    function  Get_LastDllError: Integer;
  public
    constructor Create(AOwner: TComponent); override;
    destructor  Destroy; override;
    procedure Connect; override;
    procedure ConnectTo(svrIntf: _ErrObject);
    procedure Disconnect; override;
    procedure Raise_(Number: Integer); overload;
    procedure Raise_(Number: Integer; var Source: OleVariant); overload;
    procedure Raise_(Number: Integer; var Source: OleVariant; var Description: OleVariant); overload;
    procedure Raise_(Number: Integer; var Source: OleVariant; var Description: OleVariant; 
                     var HelpFile: OleVariant); overload;
    procedure Raise_(Number: Integer; var Source: OleVariant; var Description: OleVariant; 
                     var HelpFile: OleVariant; var HelpContext: OleVariant); overload;
    procedure Clear;
    property  DefaultInterface: _ErrObject read GetDefaultInterface;
    property LastDllError: Integer read Get_LastDllError;
    property Number: Integer read Get_Number write Set_Number;
    property Source: WideString read Get_Source write Set_Source;
    property Description: WideString read Get_Description write Set_Description;
    property HelpFile: WideString read Get_HelpFile write Set_HelpFile;
    property HelpContext: Integer read Get_HelpContext write Set_HelpContext;
  published
{$IFDEF LIVE_SERVER_AT_DESIGN_TIME}
    property Server: TVBAErrObjectProperties read GetServerProperties;
{$ENDIF}
  end;

{$IFDEF LIVE_SERVER_AT_DESIGN_TIME}
// *********************************************************************//
// OLE Server Properties Proxy Class
// Server Object    : TVBAErrObject
// (This object is used by the IDE's Property Inspector to allow editing
//  of the properties of this server)
// *********************************************************************//
 TVBAErrObjectProperties = class(TPersistent)
  private
    FServer:    TVBAErrObject;
    function    GetDefaultInterface: _ErrObject;
    constructor Create(AServer: TVBAErrObject);
  protected
    function  Get_Number: Integer;
    procedure Set_Number(pi4: Integer);
    function  Get_Source: WideString;
    procedure Set_Source(const pbstr: WideString);
    function  Get_Description: WideString;
    procedure Set_Description(const pbstr: WideString);
    function  Get_HelpFile: WideString;
    procedure Set_HelpFile(const pbstr: WideString);
    function  Get_HelpContext: Integer;
    procedure Set_HelpContext(pi4: Integer);
    function  Get_LastDllError: Integer;
  public
    property DefaultInterface: _ErrObject read GetDefaultInterface;
  published
    property Number: Integer read Get_Number write Set_Number;
    property Source: WideString read Get_Source write Set_Source;
    property Description: WideString read Get_Description write Set_Description;
    property HelpFile: WideString read Get_HelpFile write Set_HelpFile;
    property HelpContext: Integer read Get_HelpContext write Set_HelpContext;
  end;
{$ENDIF}


// *********************************************************************//
// The Class CoCollection provides a Create and CreateRemote method to          
// create instances of the default interface _Collection exposed by              
// the CoClass Collection. The functions are intended to be used by             
// clients wishing to automate the CoClass objects exposed by the         
// server of this typelibrary.                                            
// *********************************************************************//
  CoCollection = class
    class function Create: _Collection;
    class function CreateRemote(const MachineName: string): _Collection;
  end;


// *********************************************************************//
// OLE Server Proxy class declaration
// Server Object    : TVBACollection
// Help String      : 
// Default Interface: _Collection
// Def. Intf. DISP? : No
// Event   Interface: 
// TypeFlags        : (2) CanCreate
// *********************************************************************//
{$IFDEF LIVE_SERVER_AT_DESIGN_TIME}
  TVBACollectionProperties= class;
{$ENDIF}
  TVBACollection = class(TOleServer)
  private
    FIntf:        _Collection;
{$IFDEF LIVE_SERVER_AT_DESIGN_TIME}
    FProps:       TVBACollectionProperties;
    function      GetServerProperties: TVBACollectionProperties;
{$ENDIF}
    function      GetDefaultInterface: _Collection;
  protected
    procedure InitServerData; override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor  Destroy; override;
    procedure Connect; override;
    procedure ConnectTo(svrIntf: _Collection);
    procedure Disconnect; override;
    function  Item(var Index: OleVariant): OleVariant;
    procedure Add(var Item: OleVariant); overload;
    procedure Add(var Item: OleVariant; var Key: OleVariant); overload;
    procedure Add(var Item: OleVariant; var Key: OleVariant; var Before: OleVariant); overload;
    procedure Add(var Item: OleVariant; var Key: OleVariant; var Before: OleVariant; 
                  var After: OleVariant); overload;
    function  Count: Integer;
    procedure Remove(var Index: OleVariant);
    function  _NewEnum: IUnknown;
    property  DefaultInterface: _Collection read GetDefaultInterface;
  published
{$IFDEF LIVE_SERVER_AT_DESIGN_TIME}
    property Server: TVBACollectionProperties read GetServerProperties;
{$ENDIF}
  end;

{$IFDEF LIVE_SERVER_AT_DESIGN_TIME}
// *********************************************************************//
// OLE Server Properties Proxy Class
// Server Object    : TVBACollection
// (This object is used by the IDE's Property Inspector to allow editing
//  of the properties of this server)
// *********************************************************************//
 TVBACollectionProperties = class(TPersistent)
  private
    FServer:    TVBACollection;
    function    GetDefaultInterface: _Collection;
    constructor Create(AServer: TVBACollection);
  protected
  public
    property DefaultInterface: _Collection read GetDefaultInterface;
  published
  end;
{$ENDIF}


procedure Register;

resourcestring
  dtlServerPage = 'ActiveX';

implementation

uses ComObj;

class function CoErrObject.Create: _ErrObject;
begin
  Result := CreateComObject(CLASS_ErrObject) as _ErrObject;
end;

class function CoErrObject.CreateRemote(const MachineName: string): _ErrObject;
begin
  Result := CreateRemoteComObject(MachineName, CLASS_ErrObject) as _ErrObject;
end;

procedure TVBAErrObject.InitServerData;
const
  CServerData: TServerData = (
    ClassID:   '{A4C46654-499F-101B-BB78-00AA00383CBB}';
    IntfIID:   '{A4C466B8-499F-101B-BB78-00AA00383CBB}';
    EventIID:  '';
    LicenseKey: nil;
    Version: 500);
begin
  ServerData := @CServerData;
end;

procedure TVBAErrObject.Connect;
var
  punk: IUnknown;
begin
  if FIntf = nil then
  begin
    punk := GetServer;
    Fintf:= punk as _ErrObject;
  end;
end;

procedure TVBAErrObject.ConnectTo(svrIntf: _ErrObject);
begin
  Disconnect;
  FIntf := svrIntf;
end;

procedure TVBAErrObject.DisConnect;
begin
  if Fintf <> nil then
  begin
    FIntf := nil;
  end;
end;

function TVBAErrObject.GetDefaultInterface: _ErrObject;
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 TVBAErrObject.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
{$IFDEF LIVE_SERVER_AT_DESIGN_TIME}
  FProps := TVBAErrObjectProperties.Create(Self);
{$ENDIF}
end;

destructor TVBAErrObject.Destroy;
begin
{$IFDEF LIVE_SERVER_AT_DESIGN_TIME}
  FProps.Free;
{$ENDIF}
  inherited Destroy;
end;

{$IFDEF LIVE_SERVER_AT_DESIGN_TIME}
function TVBAErrObject.GetServerProperties: TVBAErrObjectProperties;
begin
  Result := FProps;
end;
{$ENDIF}

function  TVBAErrObject.Get_Number: Integer;
begin
  Result := DefaultInterface.Number;
end;

procedure TVBAErrObject.Set_Number(pi4: Integer);
begin
  DefaultInterface.Number := pi4;