File : gnatcom-dispinterface.ads
------------------------------------------------------------------------------
-- --
-- GNATCOM - Ada 95 COM/DCOM/COM+ Development Framework and Tools --
-- --
-- G N A T C O M . D I S P I N T E R F A C E --
-- --
-- S p e c --
-- --
-- $Revision: 1.3 $
-- --
-- Copyright (C) 1999, 2000, 2001 David Botton --
-- --
-- This is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
-- ware Foundation; either version 2, or (at your option) any later ver- --
-- sion. It is distributed in the hope that it will be useful, but WITHOUT --
-- ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or --
-- FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
-- for more details. You should have received a copy of the GNU General --
-- Public License distributed with this; see file COPYING. If not, write --
-- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, --
-- MA 02111-1307, USA. --
-- --
-- As a special exception, if other files instantiate generics from this --
-- unit, or you link this unit with other files to produce an executable, --
-- this unit does not by itself cause the resulting executable to be --
-- covered by the GNU General Public License. This exception does not --
-- however invalidate any other reasons why the executable file might be --
-- covered by the GNU Public License. --
-- --
-- More information about GNATCOM and the most current public version can --
-- be located on the web at http://www.adapower.com/gnatcom --
-- --
-- Support for GNATCOM is available from Ada Core Technologies, Inc. --
-- --
-- In the U.S., contact Ada Core Technologies at: --
-- Tel: +1 (212) 620 7300 ext 117 --
-- Fax: +1 (212) 807 0162 --
-- Email: sales@gnat.com --
-- --
-- In Europe and elsewhere, contact ACT Europe at: --
-- Tel: +33 1 49 70 67 16 --
-- Fax: +33 1 49 70 05 52 --
-- Email: sales@act-europe.fr --
------------------------------------------------------------------------------
-- The Dispinterface_Type encapsulates the functionality of IDispatch
-- creating a thick binding to COM Dispatch Interfaces (dispinterfaces)
-- One of the COM initialization methods must be called first before
-- using any COM Interface wrapper
with Ada.Unchecked_Conversion;
with System;
with Interfaces.C;
with GNATCOM.Types;
with GNATCOM.Interface;
package GNATCOM.Dispinterface is
type Dispinterface_Type is new GNATCOM.Interface.Interface_Type
with null record;
procedure Attach
(This : in out Dispinterface_Type;
From : in GNATCOM.Types.Pointer_To_IDispatch);
-- Attaches a disinterface to a dispnterface_Type. AddRef is not called.
procedure Attach
(This : in out Dispinterface_Type;
From : in GNATCOM.Types.VARIANT);
-- Attaches a Dispatch interface contained in a VARINT to a
-- Dispinterface_Type. AddRef is not called.
function Pointer (This : Dispinterface_Type)
return GNATCOM.Types.Pointer_To_IDispatch;
-- Returns the internal interface pointer
procedure Initialize (This : in out Dispinterface_Type);
-- Called by runtime of controlled objects
-- Initializes IID to IDispatch
function To_Pointer_To_IDispatch is
new Ada.Unchecked_Conversion
(System.Address, GNATCOM.Types.Pointer_To_IDispatch);
function To_VARIANT_From_Dispinterface (From : Dispinterface_Type)
return GNATCOM.Types.VARIANT;
-- Returns a variant containing and IDispatch Pointer to This
-- Calls Addref. VARIANT should be destroyed when no longer needed.
function Has_Type_Info (This : Dispinterface_Type) return Boolean;
-- Returns true if there is a ITypeInfo object available for this
-- dispinterface
function Get_Type_Info
(This : Dispinterface_Type;
LCID : Interfaces.C.long := 0)
return GNATCOM.Types.Pointer_To_ITypeInfo;
-- Retrieves the type information for an object, which can then be used
-- to get the type information for an interface.
function Get_DISPID
(This : Dispinterface_Type;
Of_Name : String)
return Interfaces.C.long;
-- Retrieve the DISPID Of_Name in object
type Parameter_Array is array (Positive range <>) of GNATCOM.Types.VARIANT;
-- Used to create an array of parameters in right to left order.
-- IDispatch::Invoke uses VB/FORTRAN right to left
procedure Put
(This : in Dispinterface_Type;
Name : in String;
Value : in GNATCOM.Types.VARIANT;
Free : in Boolean := True;
LCID : in Interfaces.C.long := 0);
procedure Put
(This : in Dispinterface_Type;
DISPID : in Interfaces.C.long;
Value : in GNATCOM.Types.VARIANT;
Free : in Boolean := True;
LCID : in Interfaces.C.long := 0);
-- Invoke a member as a put
-- If Free then Free Variants after put
procedure Put
(This : in Dispinterface_Type;
Name : in String;
Value : in GNATCOM.Types.VARIANT;
Index_Value : in GNATCOM.Types.VARIANT;
Free : in Boolean := True;
LCID : in Interfaces.C.long := 0);
procedure Put
(This : in Dispinterface_Type;
DISPID : in Interfaces.C.long;
Value : in GNATCOM.Types.VARIANT;
Index_Value : in GNATCOM.Types.VARIANT;
Free : in Boolean := True;
LCID : in Interfaces.C.long := 0);
-- Invoke a member as a put on a collection indexed by Index_Value
-- If Free then Free Variants after put
procedure Put
(This : in Dispinterface_Type;
Name : in String;
Value : in GNATCOM.Types.VARIANT;
Index_Values : in Parameter_Array;
Free : in Boolean := True;
LCID : in Interfaces.C.long := 0);
procedure Put
(This : in Dispinterface_Type;
DISPID : in Interfaces.C.long;
Value : in GNATCOM.Types.VARIANT;
Index_Values : in Parameter_Array;
Free : in Boolean := True;
LCID : in Interfaces.C.long := 0);
-- Invoke a member as a get on a multi-dimensional collection indexed by
-- Index_Value. Index_Values are passed in column-major order, ie, right
-- to left order (1,2,3) = IndexValues(1) = 3, IndexValues(2) = 2 ...
-- If Free then Free Variants after put
procedure Put
(This : in Dispinterface_Type;
Name : in String;
Parameters : in Parameter_Array;
Free : in Boolean := True;
LCID : in Interfaces.C.long := 0);
procedure Put
(This : in Dispinterface_Type;
DISPID : in Interfaces.C.long;
Parameters : in Parameter_Array;
Free : in Boolean := True;
LCID : in Interfaces.C.long := 0);
-- Invoke a member as a put with variable number of parameters
-- If Free then Free Variants after put
procedure PutRef
(This : in Dispinterface_Type;
Name : in String;
Value : in GNATCOM.Types.VARIANT;
LCID : in Interfaces.C.long := 0);
procedure PutRef
(This : in Dispinterface_Type;
DISPID : in Interfaces.C.long;
Value : in GNATCOM.Types.VARIANT;
LCID : in Interfaces.C.long := 0);
-- Invoke a member as a putref
procedure PutRef
(This : in Dispinterface_Type;
Name : in String;
Parameters : in Parameter_Array;
LCID : in Interfaces.C.long := 0);
procedure PutRef
(This : in Dispinterface_Type;
DISPID : in Interfaces.C.long;
Parameters : in Parameter_Array;
LCID : in Interfaces.C.long := 0);
-- Invoke a member as a putref with multiple paramters
function Get
(This : Dispinterface_Type;
Name : String;
LCID : Interfaces.C.long := 0)
return GNATCOM.Types.VARIANT;
function Get
(This : Dispinterface_Type;
DISPID : Interfaces.C.long;
LCID : Interfaces.C.long := 0)
return GNATCOM.Types.VARIANT;
-- Invoke a member as a get
function Get
(This : Dispinterface_Type;
Name : String;
Index_Value : GNATCOM.Types.VARIANT;
Free : Boolean := True;
LCID : Interfaces.C.long := 0)
return GNATCOM.Types.VARIANT;
function Get
(This : Dispinterface_Type;
DISPID : Interfaces.C.long;
Index_Value : GNATCOM.Types.VARIANT;
Free : Boolean := True;
LCID : Interfaces.C.long := 0)
return GNATCOM.Types.VARIANT;
-- Invoke a member as a get on a collection indexed by Index_Value
function Get
(This : Dispinterface_Type;
Name : String;
Index_Values : Parameter_Array;
Free : Boolean := True;
LCID : Interfaces.C.long := 0)
return GNATCOM.Types.VARIANT;
function Get
(This : Dispinterface_Type;
DISPID : Interfaces.C.long;
Index_Values : Parameter_Array;
Free : Boolean := True;
LCID : Interfaces.C.long := 0)
return GNATCOM.Types.VARIANT;
-- Invoke a member as a get on a multi-dimensional collection indexed by
-- Index_Value. Index_Values are passed in column-major order, ie, right
-- to left order (1,2,3) = IndexValues(1) = 3, IndexValues(2) = 2 ...
function Invoke
(This : Dispinterface_Type;
Name : String;
Parameters : Parameter_Array;
Free : Boolean := True;
LCID : Interfaces.C.long := 0)
return GNATCOM.Types.VARIANT;
function Invoke
(This : Dispinterface_Type;
DISPID : Interfaces.C.long;
Parameters : Parameter_Array;
Free : Boolean := True;
LCID : Interfaces.C.long := 0)
return GNATCOM.Types.VARIANT;
-- Invoke a member as a method
-- If Free then Free Variants after put
procedure Invoke
(This : in Dispinterface_Type;
Name : in String;
Parameters : in Parameter_Array;
Free : in Boolean := True;
LCID : in Interfaces.C.long := 0);
procedure Invoke
(This : in Dispinterface_Type;
DISPID : in Interfaces.C.long;
Parameters : in Parameter_Array;
Free : in Boolean := True;
LCID : in Interfaces.C.long := 0);
-- Invoke a member as a method
-- If Free then Free Variants after put
function Invoke
(This : Dispinterface_Type;
Name : String;
LCID : Interfaces.C.long := 0)
return GNATCOM.Types.VARIANT;
function Invoke
(This : Dispinterface_Type;
DISPID : Interfaces.C.long;
LCID : Interfaces.C.long := 0)
return GNATCOM.Types.VARIANT;
-- Invoke a member as a method
procedure Invoke
(This : in Dispinterface_Type;
Name : in String;
LCID : in Interfaces.C.long := 0);
procedure Invoke
(This : in Dispinterface_Type;
DISPID : in Interfaces.C.long;
LCID : in Interfaces.C.long := 0);
-- Invoke a member as a method
function Invoke
(This : Dispinterface_Type;
Name : String;
wFlags : Interfaces.C.short;
Parameters : Parameter_Array;
Free : Boolean := True;
LCID : Interfaces.C.long := 0)
return GNATCOM.Types.VARIANT;
function Invoke
(This : Dispinterface_Type;
DISPID : Interfaces.C.long;
wFlags : Interfaces.C.short;
Parameters : Parameter_Array;
Free : Boolean := True;
LCID : Interfaces.C.long := 0)
return GNATCOM.Types.VARIANT;
-- Generic invoke of a member of the dispinterface
-- If Free then Free Variants after put
INVOKE_ERROR : exception;
-- Raised when the IDispatch Invoke method returns with an error
PARAMETER_ERROR : exception;
-- Raised when the wrong number of paramaters are passed in
TYPE_MISMATCH_ERROR : exception;
-- Raised when there is a type mismatch in the arguments passed in
UNKNOWN_NAME_ERROR : exception;
-- Raised when there is no matching get/put/invoke in the object
UNKNOWN_LCID_ERROR : exception;
-- Raised when an unknown local ID is passed in
ELEMENT_NOT_FOUND_ERROR : exception;
-- Raised when a request for an TypeInfo can not be fulfilled
end GNATCOM.Dispinterface;