Encapsulation d'un ActiveX en un module en technologie Up ! Virtual Technical Machine

Commande de compilation

upscmp Source=ClassB.idl AdaptateurClientCom=Oui AdaptateurDictionnaire=Oui AdaptateurServeurUpsNet=Oui
upscmp Source=ClassA.idl AdaptateurClientCom=Oui AdaptateurDictionnaire=Oui AdaptateurServeurUpsNet=Oui
upscmp Source=client.upl

Commande d'exécution

client TracerCom=Oui

Fichiers sources

Classe ClassB - Source Visual Basic

Public A As Integer

Private Sub Class_Initialize()
' ============================
A = 100
End Sub

Classe ClassB - Interface Definition Language

[
uuid(D78EE459-CFC3-4BF4-9412-F47CAFF8C86C), version(1.0), helpstring(Active X Class B")
]
library ClassB
{
importlib("stdole2.tlb");

[
odl, uuid(9E0551B5-D71E-4F23-88B5-F0DE7553AA72), version(1.0), hidden, dual, nonextensible, oleautomation
]
interface _MClassB : IDispatch
{
[id(0x40030000), propget]
HRESULT A([out, retval] short* A);
[id(0x40030000), propput]
HRESULT A([in] short A);
};

[
uuid(8810DEAC-18DA-462A-AFB7-12C61DB47E70), version(1.0)
]
coclass MClassB
{
[default] interface _MClassB;
};
};

Classe ClassA - Source Visual Basic

Const ConstanteA As Integer = 1
Const ConstanteB As Double = 2.1

Public ChampA1 As Boolean
Public ChampB1 As Byte
Public ChampC1 As Double
Public ChampD1 As Integer
Public ChampE1 As Long
Public ChampF1 As MClassB
Public ChampG1 As String
Public ChampH1 As Variant

Public ChampA2(3) As Variant
Public ChampB2(3) As Variant
Public ChampC2(3) As Variant
Public ChampD2(3) As Variant
Public ChampE2(3) As Variant
Public ChampF2(3) As Variant
Public ChampG2(3) As Variant
Public ChampH2(3) As Variant

Public Sub AppelZ1()
'===================
End Sub

Public Function AppelA1(ByVal P1 As Boolean, ByRef P2 As Boolean) As Boolean
' ==========================================================================
P2 = P1
AppelA1 = ChampA1
End Function

Public Function AppelB1(ByVal P1 As Byte, ByRef P2 As Byte) As Byte
' =================================================================
P2 = P1
AppelB1 = ChampB1
End Function

Public Function AppelC1(ByVal P1 As Double, ByRef P2 As Double) As Double
' =======================================================================
P2 = P1
AppelC1 = ChampC1
End Function

Public Function AppelD1(ByVal P1 As Integer, ByRef P2 As Integer) As Integer
' ==========================================================================
P2 = P1
AppelD1 = ChampD1
End Function

Public Function AppelE1(ByVal P1 As Long, ByRef P2 As Long) As Long
' =================================================================
P2 = P1
AppelE1 = ChampE1
End Function

Public Function AppelF1(ByVal P1 As Object, ByRef P2 As Object) As Object
' =======================================================================
P2 = P1
Set AppelF1 = ChampF1
End Function

Public Function AppelG1(ByVal P1 As String, ByRef P2 As String) As String
' =======================================================================
P2 = P1
AppelG1 = ChampG1
End Function

Public Function AppelH1(ByVal P1 As Variant, ByRef P2 As Variant) As Variant
' ==========================================================================
P2 = P1
AppelH1 = ChampH1
End Function

Public Sub AppelZ2()
'===================
End Sub

Public Function AppelA2(ByVal P1 As Variant, ByRef P2 As Variant) As Variant
' ==========================================================================
Dim V1 As Boolean
Dim V2 As Boolean
Dim V3 As Boolean

V1 = False
V2 = True
V3 = False
P2 = Array(V1, V2, V3)
AppelA2 = P1
End Function

Public Function AppelB2(ByVal P1 As Variant, ByRef P2 As Variant) As Variant
' ==========================================================================
Dim V1 As Byte
Dim V2 As Byte
Dim V3 As Byte

V1 = 75
V2 = 76
V3 = 77
P2 = Array(V1, V2, V3)
AppelB2 = P1
End Function

Public Function AppelC2(ByVal P1 As Variant, ByRef P2 As Variant) As Variant
' ==========================================================================
Dim V1 As Double
Dim V2 As Double
Dim V3 As Double

V1 = 12.3
V2 = 13.4
V3 = 14.5
P2 = Array(12.3, 13.4, 14.5)
AppelC2 = P1
End Function

Public Function AppelD2(ByVal P1 As Variant, ByRef P2 As Variant) As Variant
' ==========================================================================
Dim V1 As Integer
Dim V2 As Integer
Dim V3 As Integer

V1 = 12
V2 = 13
V3 = 14
P2 = Array(V1, V2, V3)
AppelD2 = P1
End Function

Public Function AppelE2(ByVal P1 As Variant, ByRef P2 As Variant) As Variant
' ==========================================================================
Dim V1 As Long
Dim V2 As Long
Dim V3 As Long

V1 = 13
V2 = 14
V3 = 15
P2 = Array(V1, V2, V3)
AppelE2 = P1
End Function

Public Function AppelF2(ByVal P1 As Variant, ByRef P2 As Variant) As Variant
' ==========================================================================
Dim V1 As MClassB
Dim V2 As MClassB
Dim V3 As MClassB

Set V1 = New MClassB
V1.A = 11
Set V2 = New MClassB
V2.A = 12
Set V3 = New MClassB
V3.A = 13
P2 = Array(V1, V2, V3)
AppelF2 = P1
End Function

Public Function AppelG2(ByVal P1 As Variant, ByRef P2 As Variant) As Variant
' ==========================================================================
Dim V1 As String
Dim V2 As String
Dim V3 As String

V1 = "coucou 11"
V2 = "coucou 12"
V3 = "coucou 13"
P2 = Array(V1, V2, V3)
AppelG2 = P1
End Function

Public Function AppelH2(ByVal P1 As Variant, ByRef P2 As Variant) As Variant
' ==========================================================================
Dim V1 As Variant
Dim V2 As Variant
Dim V3 As Variant

V1 = "coucou 11"
V2 = "coucou 12"
V3 = "coucou 13"
P2 = Array(V1, V2, V3)
AppelH2 = P1
End Function

Private Sub Class_Initialize()
' ============================
Dim V1 As Variant
Dim V2 As Variant
Dim V3 As Variant

ChampA1 = True
ChampB1 = 65
ChampC1 = 2.3
ChampD1 = 2
ChampE1 = 3
Set ChampF1 = New MClassB
ChampF1.A = 1
ChampG1 = "coucou"
V1 = "coucou"
ChampH1 = V1

ChampA2 = Array(True, False, True)
ChampB2 = Array(CByte(65), CByte(66), CByte(67))
ChampC2 = Array(2.3, 3.4, 4.5)
ChampD2 = Array(CInt(2), CInt(3), CInt(4))
ChampE2 = Array(CLng(3), CLng(4), CLng(5))
ChampF2 = Array(New MClassB, New MClassB, New MClassB)
ChampF2(0).A = 1
ChampF2(1).A = 2
ChampF2(2).A = 3
ChampG2 = Array("coucou 1", "coucou 2", "coucou 3")
V1 = "coucou 1"
V2 = "coucou 2"
V3 = "coucou 3"
ChampH2 = Array(V1, V2, V3)
End Sub

Classe ClassB - Interface Definition Language

import "wtypes.idl";
import "unknwn.idl";
import "objidl.idl";
import "oaidl.idl";

[ uuid(2F54576A-8BFA-424C-9191-DF365B37170E), version(1.0), helpstring(Active X Class A")
]
library ClassA
{
importlib("stdole2.tlb");
importlib("ClassB.dll");

[
object, odl, uuid(763B0271-93BA-4B9D-AD0C-11D827B43650), version(1.0), hidden, dual, nonextensible, oleautomation
]
interface _MClassA : IDispatch
{
[id(0x40030000), propget]
HRESULT ChampA1([out, retval] VARIANT_BOOL* ChampA1);
[id(0x40030000), propput]
HRESULT ChampA1([in] VARIANT_BOOL ChampA1);
[id(0x40030001), propget]
HRESULT ChampB1([out, retval] unsigned char* ChampB1);
[id(0x40030001), propput]
HRESULT ChampB1([in] unsigned char ChampB1);
[id(0x40030002), propget]
HRESULT ChampC1([out, retval] double* ChampC1);
[id(0x40030002), propput]
HRESULT ChampC1([in] double ChampC1);
[id(0x40030003), propget]
HRESULT ChampD1([out, retval] short* ChampD1);
[id(0x40030003), propput]
HRESULT ChampD1([in] short ChampD1);
[id(0x40030004), propget]
HRESULT ChampE1([out, retval] long* ChampE1);
[id(0x40030004), propput]
HRESULT ChampE1([in] long ChampE1);
[id(0x40030005), propget]
HRESULT ChampF1([out, retval] _MClassB** ChampF1);
[id(0x40030005), propputref]
HRESULT ChampF1([in] _MClassB* ChampF1);
[id(0x40030006), propget]
HRESULT ChampG1([out, retval, ptr] BSTR* ChampG1);
[id(0x40030006), propput]
HRESULT ChampG1([in, ptr] BSTR ChampG1);
[id(0x40030007), propget]
HRESULT ChampH1([out, retval, ptr] VARIANT* ChampH1);
[id(0x40030007), propput]
HRESULT ChampH1([in, ptr] VARIANT* ChampH1);
[id(0x40030007), propputref]
HRESULT ChampH1([in, ptr] VARIANT* ChampH1);
[id(0x40030008), propget]
HRESULT ChampA2([out, retval, ptr] VARIANT* ChampA2);
[id(0x40030008), propput]
HRESULT ChampA2([in, ptr] VARIANT* ChampA2);
[id(0x40030008), propputref]
HRESULT ChampA2([in, ptr] VARIANT* ChampA2);
[id(0x40030009), propget]
HRESULT ChampB2([out, retval, ptr] VARIANT* ChampB2);
[id(0x40030009), propput]
HRESULT ChampB2([in, ptr] VARIANT* ChampB2);
[id(0x40030009), propputref]
HRESULT ChampB2([in, ptr] VARIANT* ChampB2);
[id(0x4003000a), propget]
HRESULT ChampC2([out, retval, ptr] VARIANT* ChampC2);
[id(0x4003000a), propput]
HRESULT ChampC2([in, ptr] VARIANT* ChampC2);
[id(0x4003000a), propputref]
HRESULT ChampC2([in, ptr] VARIANT* ChampC2);
[id(0x4003000b), propget]
HRESULT ChampD2([out, retval, ptr] VARIANT* ChampD2);
[id(0x4003000b), propput]
HRESULT ChampD2([in, ptr] VARIANT* ChampD2);
[id(0x4003000b), propputref]
HRESULT ChampD2([in, ptr] VARIANT* ChampD2);
[id(0x4003000c), propget]
HRESULT ChampE2([out, retval] VARIANT* ChampE2);
[id(0x4003000c), propput]
HRESULT ChampE2([in, ptr] VARIANT* ChampE2);
[id(0x4003000c), propputref]
HRESULT ChampE2([in, ptr] VARIANT* ChampE2);
[id(0x4003000d), propget]
HRESULT ChampF2([out, retval, ptr] VARIANT* ChampF2);
[id(0x4003000d), propput]
HRESULT ChampF2([in, ptr] VARIANT* ChampF2);
[id(0x4003000d), propputref]
HRESULT ChampF2([in, ptr] VARIANT* ChampF2);
[id(0x4003000e), propget]
HRESULT ChampG2([out, retval, ptr] VARIANT* ChampG2);
[id(0x4003000e), propput]
HRESULT ChampG2([in, ptr] VARIANT* ChampG2);
[id(0x4003000e), propputref]
HRESULT ChampG2([in, ptr] VARIANT* ChampG2);
[id(0x4003000f), propget]
HRESULT ChampH2([out, retval, ptr] VARIANT* ChampH2);
[id(0x4003000f), propput]
HRESULT ChampH2([in, ptr] VARIANT* ChampH2);
[id(0x4003000f), propputref]
HRESULT ChampH2([in, ptr] VARIANT* ChampH2);
[id(0x60030000)]
HRESULT AppelZ1();
[id(0x60030001)] HRESULT AppelA1( [id(0x60030002)]
HRESULT AppelB1( [id(0x60030003)]
HRESULT AppelC1( [id(0x60030004)]
HRESULT AppelD1( [id(0x60030005)]
HRESULT AppelE1( [id(0x60030006)]
HRESULT AppelF1( [id(0x60030007)]
HRESULT AppelG1( [id(0x60030008)]
HRESULT AppelH1( [id(0x60030009)]
HRESULT AppelZ2();
[id(0x6003000a)]
HRESULT AppelA2( [id(0x6003000b)]
HRESULT AppelB2( [id(0x6003000c)]
HRESULT AppelC2( [id(0x6003000d)]
HRESULT AppelD2( [id(0x6003000e)]
HRESULT AppelE2( [id(0x6003000f)]
HRESULT AppelF2( [id(0x60030010)]
HRESULT AppelG2( [id(0x60030011)]
HRESULT AppelH2( };

[
uuid(1B0F711A-787B-4D87-9832-81CF508CED7C), version(1.0)
]
coclass MClassA
{
[default] interface _MClassA;
};
};

Source du composant client.upl

Source Composant "Exemple de l'emploi d'Up ! Com" Version 4.0.0;

ImporterModule
/************/ Prive :
/*****/
Procedure EcrireTableau(L:Caractere, T:Tableau[?] De Nul Ou Objet)
/****************************************************************/
Variable
Debut
Pour I=T.BorneMin JusquA T.BorneMax Faire Fin Pour
Fin Procedure

Principal
/*******/
Variable
Debut A=_MClassA();
B=_MClassB();
Pour I=0 JusquA 2 Faire Fin Pour

Ecran.Ecrire("A.ChampA1="+Caractere(A.ChampA1));
Ecran.Ecrire("A.ChampB1="+Caractere(A.ChampB1));
Ecran.Ecrire("A.ChampC1="+Caractere(A.ChampC1));
Ecran.Ecrire("A.ChampD1="+Caractere(A.ChampD1));
Ecran.Ecrire("A.ChampE1="+Caractere(A.ChampE1));
Ecran.Ecrire("A.ChampF1.A="+Caractere(A.ChampF1.A));
Ecran.Ecrire("A.ChampG1="+A.ChampG1);
Ecran.Ecrire("A.ChampH1="+A.ChampH1);
Ecran.Ecrire("\n");
EcrireTableau("A.ChampA2", Tableau(A.ChampA2));
EcrireTableau("A.ChampB2", Tableau(A.ChampB2));
EcrireTableau("A.ChampC2", Tableau(A.ChampC2));
EcrireTableau("A.ChampD2", Tableau(A.ChampD2));
EcrireTableau("A.ChampE2", Tableau(A.ChampE2));
EcrireTableau("A.ChampF2", Tableau(A.ChampF2));
EcrireTableau("A.ChampG2", Tableau(A.ChampG2));
EcrireTableau("A.ChampH2", Tableau(A.ChampH2));
Ecran.Ecrire("\n");

A.ChampA1=Faux;
A.ChampB1=12;
A.ChampC1=13.4;
A.ChampD1=16;
A.ChampE1=18;
A.ChampF1.A=11; A.ChampG1="guten tag";
A.ChampH1="salut";
Ecran.Ecrire("\n");
A.ChampA2=TA2;
A.ChampB2=TB2;
A.ChampC2=TC2;
A.ChampD2=TD2;
A.ChampE2=TE2;
A.ChampF2=TF2;
A.ChampG2=TG2;
A.ChampH2=TH2;

Ecran.Ecrire("A.ChampA1="+Caractere(A.ChampA1));
Ecran.Ecrire("A.ChampB1="+Caractere(A.ChampB1));
Ecran.Ecrire("A.ChampC1="+Caractere(A.ChampC1));
Ecran.Ecrire("A.ChampD1="+Caractere(A.ChampD1));
Ecran.Ecrire("A.ChampE1="+Caractere(A.ChampE1));
Ecran.Ecrire("A.ChampF1.A="+Caractere(A.ChampF1.A));
Ecran.Ecrire("A.ChampG1="+A.ChampG1);
Ecran.Ecrire("A.ChampH1="+A.ChampH1);
Ecran.Ecrire("\n");
EcrireTableau("A.ChampA2", Tableau(A.ChampA2));
EcrireTableau("A.ChampB2", Tableau(A.ChampB2));
EcrireTableau("A.ChampC2", Tableau(A.ChampC2));
EcrireTableau("A.ChampD2", Tableau(A.ChampD2));
EcrireTableau("A.ChampE2", Tableau(A.ChampE2));
EcrireTableau("A.ChampF2", Tableau(A.ChampF2));
EcrireTableau("A.ChampG2", Tableau(A.ChampG2));
EcrireTableau("A.ChampH2", Tableau(A.ChampH2));
Ecran.Ecrire("\n");

A.AppelZ1();
Ecran.Ecrire("A.AppelA1()="+Caractere(A.AppelA1(Vrai, C))); Ecran.Ecrire("C="+Caractere(C));
Ecran.Ecrire("A.AppelB1()="+Caractere(A.AppelB1(2, D))); Ecran.Ecrire("D="+Caractere(E));
Ecran.Ecrire("A.AppelC1()="+Caractere(A.AppelC1(2.3, E))); Ecran.Ecrire("E="+Caractere(E));
Ecran.Ecrire("A.AppelD1()="+Caractere(A.AppelD1(3, D)));
Ecran.Ecrire("D="+Caractere(D));
Ecran.Ecrire("A.AppelE1()="+Caractere(A.AppelE1(4, D)));
Ecran.Ecrire("D="+Caractere(D));
Ecran.Ecrire("A.AppelG1()="+A.AppelG1("coucou", F));
Ecran.Ecrire("F="+F);
Ecran.Ecrire("A.AppelH1()="+Caractere(A.AppelH1("hello", G)));
Ecran.Ecrire("G="+Caractere(G));
Ecran.Ecrire("\n");

A.AppelZ2();
EcrireTableau("A.AppelA2=", Tableau(A.AppelA2(TA1,TA2)));
EcrireTableau("TA2", TA2);
EcrireTableau("A.AppelB2=", Tableau(A.AppelB2(TB1,TB2)));
EcrireTableau("TB2", TB2);
EcrireTableau("A.AppelC2=", Tableau(A.AppelC2(TC1,TC2)));
EcrireTableau("TC2", TC2);
EcrireTableau("A.AppelD2=", Tableau(A.AppelD2(TD1,TD2)));
EcrireTableau("TD2", TD2);
EcrireTableau("A.AppelE2=", Tableau(A.AppelE2(TE1,TE2)));
EcrireTableau("TE2", TE2);
EcrireTableau("A.AppelF2=", Tableau(A.AppelF2(TF1,TF2)));
EcrireTableau("TF2", TF2);
EcrireTableau("A.AppelG2=", Tableau(A.AppelG2(TG1,TG2)));
EcrireTableau("TG2", TG2);
EcrireTableau("A.AppelH2=", Tableau(A.AppelH2(TH1,TH2)));
EcrireTableau("TH2", TH2);
Ecran.Ecrire("\n");
Fin Principal