From 29a4847890f529dad10e2d9f0334eeb6c919f0c7 Mon Sep 17 00:00:00 2001 From: Jens-Heiner Rechtien
-The script on this page creates a new StarOffice document and connects an event listener -to it. When the document is closed then the XEventListener::disposing method is called on the -listener object. How the listener is set up depends on the button being clicked. -
--The button will run JScript code that and adds an JScript event listener to the document. -The listener is also implemented in JScript an is on this page.. -
- -- -The button runs JScript code that creates the ActiveX component EventListener.EvtListener that -is written in C++ and housed in a dll. Then the event listener is added to the document. -
- --The button runs VBScript code that creates the components EventListener.EvtListener and adds it -to the document. -
- --Runs VBScript code that creates VBasicEventListener.VBEventListener ActiveX component which was -written with VB -
- - - - - - diff --git a/extensions/test/ole/EventListenerSample/readme.txt b/extensions/test/ole/EventListenerSample/readme.txt deleted file mode 100644 index 46c674153ab7..000000000000 --- a/extensions/test/ole/EventListenerSample/readme.txt +++ /dev/null @@ -1,18 +0,0 @@ -EventListener -________________________________________________________ - -The folder EventListener contains an MSDEV project that builds a dll that contains -the EventListener.EvtListener ActiveX component. The component implements the XEventListener -interface according to the rules of the OleBridge. The component will be used from the -HTML page events.htm. - -VBEventListener: -_________________________________________________________ -Contains a Visual Basic project that builds an ActiveX component that implements -com.sun.star.lang.XEventListener. Its ProgId is VBasicEventListener.VBEventListener -The dll should also be checked in. VB needs its TLB, so it uses the same CLSIDs on -the next build. The component will create a message box when its disposing function -has been called. - -The project also contains a client that builds a Project1.exe (in the same folder) -that creates VBEventListener and adds it to a StarOffice document diff --git a/extensions/test/ole/StarBasic_OleClient/oleclient.bas b/extensions/test/ole/StarBasic_OleClient/oleclient.bas deleted file mode 100644 index 17b75e3c94e0..000000000000 --- a/extensions/test/ole/StarBasic_OleClient/oleclient.bas +++ /dev/null @@ -1,209 +0,0 @@ -REM ***** BASIC ***** - - -Sub Main -factory= createUnoService("com.sun.star.bridge.OleObjectFactory") -obj= factory.createInstance("AxTestComponents.Basic") - - -obj.prpObject= obj -prpObject= obj.prpObject -'identity of objects, mapped from COM to UNO, is not given currently -if NOT equalUnoObjects(obj,prpObject) then - MsgBox "error" -end if - -'properties ------------------------------------------------------------------------- -Dim ar1(1) -ar1(0)= "1" -ar1(1)= "2" -obj.prpArray= ar1() -prpArray= obj.prpArray -if (prpArray(0) <> "1") OR (prpArray(1) <> "2") then - MsgBox "error" -end if - -obj.prpVariant="string" -prpVariant= obj.prpVariant -if prpVariant <> "string" then - MsgBox "error" -end if - -obj.prpDouble=3.145 -prpDouble= obj.prpDouble -if NOT ((prpDouble >3.144) AND (prpDouble < 3.146)) then - MsgBox "error" -end if - - -obj.prpFloat= 3.14 -prpFloat= obj.prpFloat -if NOT ((prpFloat >3.13) AND (prpFloat < 3.15)) then - MsgBox "error" -end if - -obj.prpString= "string" -prpString= obj.prpString -if prpString <> "string" then - MsgBox "error" -end if - -obj.prpLong= 1000 -prpLong= obj.prpLong -if prpLong <> 1000 then - MsgBox "error" -end if - -obj.prpShort= 127 -prpShort= obj.prpShort -if prpShort <> 127 then - MsgBox "error" -end if - -obj.prpByte= 11 -prpByte= obj.prpByte -if prpByte <> 11 then - MsgBox "error" -end if - - -'out parameter ------------------------------------------------------------------------- -Dim outObject -obj.outObject(outObject) -if outObject.prpString <> "out" then - MsgBox "error" -end if - -Dim outArray -obj.outArray(outArray) -if (outArray(0) <> "out1") OR (outArray(1) <> "out2") OR (outArray(2) <> "out3")then - MsgBox "error" -end if -Dim outVariant -obj.outVariant(outVariant) -if outVariant <> "out" then - MsgBox "error" -end if -Dim outDouble -obj.outDouble(outDouble) -if NOT ((outDouble >3.144) AND (outDouble < 3.146)) then - MsgBox "error" -end if - - -Dim outFloat -obj.outFloat(outFloat) -if NOT ((outFloat >3.13) AND (outFloat < 3.15)) then - MsgBox "error" -end if - -Dim outString -obj.outString(outString) -if outString <> "out" then - MsgBox "error" -end if -Dim outLong -obj.outLong(outLong) -if outLong <> 111111 then - MsgBox "error" -end if - -Dim outShort -obj.outShort(outShort) -if outShort <> 1111 then - MsgBox "error" -end if - -Dim outByte -obj.outByte(outByte) -if outByte <> 111 then - MsgBox "error" -end if - - -'in-out parameter ------------------------------------------------------------- -obj2= factory.createInstance("AxTestComponents.Basic") -inoutObj= obj2 -inoutObj.prpString="in" -obj.inoutObject(inoutObj) -if equalUnoObjects(inoutObj,obj) then - MsgBox "error" -end if - -if inoutObj.prpString <> "out" then - MsgBox "error" -end if - - -Dim inoutAr(2) -inoutAr(0)="1" -inoutAr(1)="2" -inoutAr(2)="3" -obj.inoutArray(inoutAr()) - -if (inoutAr(0) <> "1out") OR (inoutAr(1) <> "2out") OR (inoutAr(2) <> "3out") then - MsgBox "error" -end if - -inoutVar= "in" -obj.inoutVariant(inoutVar) -if inoutVar <> "inout" then - MsgBox "error" -end if - -inoutDouble= 3.14 -obj.inoutDouble(inoutDouble) -if NOT ((inoutDouble >4.13) AND (inoutDouble < 4.15)) then - MsgBox "error" -end if - -inoutFloat= 3.14 -obj.inoutFloat(inoutFloat) -if NOT ((inoutFloat >4.13) AND (inoutFloat < 4.15)) then - MsgBox "error" -end if - -inoutString= "in" -obj.inoutString(inoutString) -if inoutString <> "inout" then - MsgBox "error" -end if - - -inoutLong= 10 -obj.inoutLong(inoutLong) -if inoutLong <> 11 then - MsgBox "error" -end if - -inoutShort= 10 -obj.inoutShort(inoutShort) -if inoutShort <> 11 then - MsgBox "error" -end if - - -inoutByte= 10 -obj.inoutByte(inoutByte) -if inoutByte <> 11 then - MsgBox "error" -end if - - -'in parameter ------------------------------------------------------------------- -obj.inByte(11) -obj.inShort(111) -obj.inLong(11111) -obj.inString("I am a string") -obj.inFloat(3.14) -obj.inDouble(3.145) -obj.inVariant("I am a string in a variant") -obj.prpString= "a string property" -obj.inObject(obj) - -Dim arString(1) as String -arString(0)= "String one" -arString(1)= "String two" -obj.inArray(arString()) - -End Sub diff --git a/extensions/test/ole/StarBasic_OleClient/readme.txt b/extensions/test/ole/StarBasic_OleClient/readme.txt deleted file mode 100644 index 8e129dddddcd..000000000000 --- a/extensions/test/ole/StarBasic_OleClient/readme.txt +++ /dev/null @@ -1,10 +0,0 @@ -oleclient.bas is a StarBasic script that uses the -"com.sun.star.bridge.OleObjectFactory" service to instantiate -the ActiveX component "AxTestComponents.Basic" and calls -functions on it. - ------------------------------------------------------------- -Requirements: - -ActiveX component: AxTestComponent.Basic must be registered. -It is contained in extensions/test/ole/AxTestComponents \ No newline at end of file diff --git a/extensions/test/ole/VisualBasic/Form1.frm b/extensions/test/ole/VisualBasic/Form1.frm deleted file mode 100644 index c2ed1f6a11f5..000000000000 --- a/extensions/test/ole/VisualBasic/Form1.frm +++ /dev/null @@ -1,349 +0,0 @@ -VERSION 5.00 -Begin VB.Form Form1 - Caption = "Form1" - ClientHeight = 4572 - ClientLeft = 48 - ClientTop = 336 - ClientWidth = 8460 - LinkTopic = "Form1" - ScaleHeight = 4572 - ScaleWidth = 8460 - StartUpPosition = 3 'Windows Default - Begin VB.CommandButton ctrInParamStart - Caption = "Start" - Height = 252 - Left = 240 - TabIndex = 20 - Top = 480 - Width = 732 - End - Begin VB.TextBox tareaResult - Height = 1932 - Left = 4920 - TabIndex = 19 - Top = 480 - Width = 3372 - End - Begin VB.CommandButton Command20 - Caption = "Command20" - Height = 252 - Left = 3000 - TabIndex = 18 - Top = 2640 - Width = 492 - End - Begin VB.CommandButton Command19 - Caption = "string" - Height = 252 - Left = 2280 - TabIndex = 17 - Top = 2640 - Width = 492 - End - Begin VB.CommandButton Command18 - Caption = "long" - Height = 252 - Left = 1560 - TabIndex = 16 - Top = 2640 - Width = 492 - End - Begin VB.CommandButton Command17 - Caption = "short" - Height = 252 - Left = 840 - TabIndex = 15 - Top = 2640 - Width = 492 - End - Begin VB.CommandButton Command16 - Caption = "byte" - Height = 252 - Left = 120 - TabIndex = 14 - Top = 2640 - Width = 492 - End - Begin VB.CommandButton Command15 - Caption = "array" - Height = 252 - Left = 3000 - TabIndex = 12 - Top = 1920 - Width = 612 - End - Begin VB.CommandButton Command14 - Caption = "string" - Height = 252 - Left = 2280 - TabIndex = 11 - Top = 1920 - Width = 492 - End - Begin VB.CommandButton Command13 - Caption = "long" - Height = 252 - Left = 1440 - TabIndex = 10 - Top = 1920 - Width = 612 - End - Begin VB.CommandButton Command12 - Caption = "short" - Height = 252 - Left = 720 - TabIndex = 9 - Top = 1920 - Width = 612 - End - Begin VB.CommandButton Command11 - Caption = "byte" - Height = 252 - Left = 120 - TabIndex = 8 - Top = 1920 - Width = 492 - End - Begin VB.CommandButton Command10 - Caption = "array" - Height = 252 - Left = 3000 - TabIndex = 6 - Top = 1200 - Width = 612 - End - Begin VB.CommandButton Command9 - Caption = "string" - Height = 252 - Left = 2280 - TabIndex = 5 - Top = 1200 - Width = 612 - End - Begin VB.CommandButton Command8 - Caption = "long" - Height = 252 - Left = 1560 - TabIndex = 4 - Top = 1200 - Width = 612 - End - Begin VB.CommandButton Command7 - Caption = "short" - Height = 252 - Left = 840 - TabIndex = 3 - Top = 1200 - Width = 612 - End - Begin VB.CommandButton Command6 - Caption = "byte" - Height = 252 - Left = 120 - TabIndex = 2 - Top = 1200 - Width = 612 - End - Begin VB.Label Label4 - Caption = "Properties" - Height = 252 - Left = 120 - TabIndex = 13 - Top = 2280 - Width = 1212 - End - Begin VB.Label Label3 - Caption = "In Out Parameter" - Height = 252 - Left = 120 - TabIndex = 7 - Top = 1560 - Width = 1332 - End - Begin VB.Label Label2 - Caption = "Out Parameter" - Height = 252 - Left = 120 - TabIndex = 1 - Top = 840 - Width = 1332 - End - Begin VB.Label Label1 - Caption = "In Parameter" - Height = 252 - Left = 240 - TabIndex = 0 - Top = 120 - Width = 1212 - End -End -Attribute VB_Name = "Form1" -Attribute VB_GlobalNameSpace = False -Attribute VB_Creatable = False -Attribute VB_PredeclaredId = True -Attribute VB_Exposed = False -Option Explicit -Private objServiceManager -Private objCoreReflection -Private objOleTest - -Private Sub ctrInParamStart_Click() -Dim ret As Variant - -' In Parameter, simple types -'============================================ -ret = objOleTest.in_methodByte(10) -Debug.Print TypeName(ret) & " " & CStr(ret) -ret = objOleTest.in_methodFloat(3.14) -Debug.Print TypeName(ret) & " " & CStr(ret) - -Dim d As Double 'try conversion -d = 3.14 -ret = objOleTest.in_methodFloat(3.14) -Debug.Print TypeName(ret) & " " & CStr(ret) -ret = objOleTest.in_methodDouble(4.14) -Debug.Print TypeName(ret) & " " & CStr(ret) -Dim s As Single -s = 4.14 -ret = objOleTest.in_methodDouble(s) -Debug.Print TypeName(ret) & " " & CStr(ret) -ret = objOleTest.in_methodBool(True) -Debug.Print TypeName(ret) & " " & CStr(ret) -ret = objOleTest.in_methodBool(False) -Debug.Print TypeName(ret) & " " & CStr(ret) -ret = objOleTest.in_methodShort(-10) -Debug.Print TypeName(ret) & " " & CStr(ret) -ret = objOleTest.in_methodUShort(10) -Debug.Print TypeName(ret) & " " & CStr(ret) -ret = objOleTest.in_methodLong(-1000000) -Debug.Print TypeName(ret) & " " & CStr(ret) -ret = objOleTest.in_methodULong(1000000) -Debug.Print TypeName(ret) & " " & CStr(ret) -ret = objOleTest.in_methodString("This is a String") -Debug.Print TypeName(ret) & " " & CStr(ret) -ret = objOleTest.in_methodChar("A") -Debug.Print TypeName(ret) & " " & CStr(ret) -ret = objOleTest.in_methodAny("This is a String in an any") -Debug.Print TypeName(ret) & " " & CStr(ret) - -Call objOleTest.in_methodAll(10, 10.1, 10.111, True, 10, 11, 12, 13, _ - "A String", "A", "A String in an Any") - -'Out Parameter simple types -'================================================ -Dim outByte As Byte -objOleTest.testout_methodByte outByte -Debug.Print "out byte " & CStr(outByte) -Dim outFloat As Single -objOleTest.testout_methodFloat outFloat -Debug.Print "out float " & CStr(outFloat) -Dim outDouble As Double -objOleTest.testout_methodDouble outDouble -Debug.Print "out double " & CStr(outDouble) -Dim outBool As Boolean -objOleTest.testout_methodBool outBool -Debug.Print "out bool " & CStr(outBool) -Dim outInt As Integer -objOleTest.testout_methodShort outInt -Debug.Print "out short " & CStr(outInt) -objOleTest.testout_methodUShort outInt -Debug.Print "out unsignedshort " & CStr(outInt) -Dim outLong As Long -objOleTest.testout_methodLong outLong -Debug.Print "out long " & CStr(outInt) -objOleTest.testout_methodULong outLong -Debug.Print "out unsigned long " & CStr(outInt) -Dim outString As String -objOleTest.testout_methodString outString -Debug.Print "out string " & CStr(outString) -Dim outChar As Integer -objOleTest.testout_methodChar outChar -Debug.Print "out char " & CStr(outChar) -Dim outCharS As String -objOleTest.testout_methodChar outCharS -Debug.Print "out char (String) " & CStr(outCharS) -objOleTest.testout_methodAny outString -Debug.Print "out Any " & CStr(outString) -'Out Parameter simple types (VARIANT var) -Dim outVar As Variant -objOleTest.testout_methodByte outVar -Debug.Print "out Byte (VARIANT) " & CStr(outVar) -objOleTest.testout_methodFloat outVar -Debug.Print "out float (VARIANT) " & CStr(outVar) -objOleTest.testout_methodDouble outVar -Debug.Print "out double (VARIANT) " & CStr(outVar) -objOleTest.testout_methodBool outVar -Debug.Print "out bool (VARIANT) " & CStr(outVar) -objOleTest.testout_methodShort outVar -Debug.Print "out short (VARIANT) " & CStr(outVar) -objOleTest.testout_methodUShort outVar -Debug.Print "out unsigned short (VARIANT) " & CStr(outVar) -objOleTest.testout_methodLong outVar -Debug.Print "out long (VARIANT) " & CStr(outVar) -objOleTest.testout_methodULong outVar -Debug.Print "out unsigned long (VARIANT) " & CStr(outVar) -objOleTest.testout_methodString outVar -Debug.Print "out string (VARIANT) " & CStr(outVar) -objOleTest.testout_methodChar outVar -Debug.Print "out char (VARIANT) " & CStr(outVar) -objOleTest.testout_methodAny outVar -Debug.Print "out any (VARIANT) " & CStr(outVar) - -'In/Out simple types -outByte = 10 -objOleTest.testinout_methodByte outByte -Debug.Print "inout byte " & CStr(outByte) -outFloat = 3.14 -objOleTest.testinout_methodFloat outFloat -Debug.Print "inout float " & CStr(outFloat) -outDouble = 4.14 -objOleTest.testinout_methodDouble outDouble -Debug.Print "inout double " & CStr(outDouble) -outBool = True -objOleTest.testinout_methodBool outBool -Debug.Print "inout bool " & CStr(outBool) -outInt = 10 -objOleTest.testinout_methodShort outInt -Debug.Print "inout short " & CStr(outInt) -outInt = 20 -objOleTest.testinout_methodUShort outInt -Debug.Print "inout unsignedshort " & CStr(outInt) -outLong = 30 -objOleTest.testinout_methodLong outLong -Debug.Print "inout long " & CStr(outLong) -outLong = 40 -objOleTest.testinout_methodULong outLong -Debug.Print "inout unsigned long " & CStr(outLong) -outString = "this is an in string" -objOleTest.testinout_methodString outString -Debug.Print "inout string " & CStr(outString) - -outString = "this is an in String" -objOleTest.testout_methodChar outString -Debug.Print "out char " & CStr(outString) -outString = "this is another in out string" -objOleTest.testout_methodAny outString -Debug.Print "out Any " & CStr(outString) - - - - - -Dim var As Boolean -var = True -Debug.Print CStr(var) - - -End Sub - -Private Sub Form_Load() - Set objServiceManager = CreateObject("com.sun.star.ServiceManager") - Set objCoreReflection = objServiceManager.createInstance("com.sun.star.reflection.CoreReflection") - - Set objOleTest = objServiceManager.createInstance("oletest.OleTest") - Debug.Print TypeName(objOleTest) -End Sub - -Private Sub Text1_Change() - -End Sub diff --git a/extensions/test/ole/VisualBasic/Module1.bas b/extensions/test/ole/VisualBasic/Module1.bas deleted file mode 100644 index e3ab7b34e46e..000000000000 --- a/extensions/test/ole/VisualBasic/Module1.bas +++ /dev/null @@ -1,743 +0,0 @@ -Attribute VB_Name = "Module1" -Option Explicit - -Private objServiceManager -Private objCoreReflection -Private objOleTest -Private objEventListener - -Sub Main() - Set objServiceManager = CreateObject("com.sun.star.ServiceManager") - Set objCoreReflection = objServiceManager.createInstance("com.sun.star.reflection.CoreReflection") - ' extensions/test/ole/cpnt - Set objOleTest = objServiceManager.createInstance("oletest.OleTest") - ' extensions/test/ole/EventListenerSample/VBEventListener - Set objEventListener = CreateObject("VBasicEventListener.VBEventListener") - Debug.Print TypeName(objOleTest) - -' In Parameter, simple types -'============================================ -Dim tmpVar As Variant -Dim ret As Variant -Dim bError As Boolean -ret = objOleTest.in_methodByte(10) -Debug.Print TypeName(ret) & " " & CStr(ret) -If ret <> 10 Then - MsgBox "error" -End If - -ret = objOleTest.in_methodFloat(3.14) -Debug.Print TypeName(ret) & " " & CStr(ret) -If ret <> 3.14 Then - MsgBox "error" -End If -Dim d As Double 'try conversion -d = 3.14 -ret = objOleTest.in_methodFloat(3.14) -Debug.Print TypeName(ret) & " " & CStr(ret) -If ret <> 3.14 Then - MsgBox "error" -End If - -ret = objOleTest.in_methodDouble(4.14) -Debug.Print TypeName(ret) & " " & CStr(ret) -If ret <> 4.14 Then - MsgBox "error" -End If -Dim s As Single -s = 4.14 -ret = objOleTest.in_methodDouble(s) -Debug.Print TypeName(ret) & " " & CStr(ret) -If (ret < 4.13) And (ret > 4.15) Then - MsgBox "error" -End If - -ret = objOleTest.in_methodBool(True) -Debug.Print TypeName(ret) & " " & CStr(ret) -If ret <> True Then - MsgBox "error" -End If - -ret = objOleTest.in_methodBool(False) -Debug.Print TypeName(ret) & " " & CStr(ret) -If ret <> False Then - MsgBox "error" -End If - -ret = objOleTest.in_methodShort(-10) -Debug.Print TypeName(ret) & " " & CStr(ret) -If ret <> -10 Then - MsgBox "error" -End If -ret = objOleTest.in_methodUShort(10) -Debug.Print TypeName(ret) & " " & CStr(ret) -If ret <> 10 Then - MsgBox "error" -End If -ret = objOleTest.in_methodLong(-1000000) -Debug.Print TypeName(ret) & " " & CStr(ret) -If ret <> -1000000 Then - MsgBox "error" -End If - -ret = objOleTest.in_methodULong(1000000) -Debug.Print TypeName(ret) & " " & CStr(ret) -If ret <> 1000000 Then - MsgBox "error" -End If - -ret = objOleTest.in_methodString("This is a String") -Debug.Print TypeName(ret) & " " & CStr(ret) -If CStr(ret) <> "This is a String" Then - MsgBox "error" -End If - -'different character tests -ret = objOleTest.in_methodChar("A") -Debug.Print TypeName(ret) & " " & CStr(ret) -If ret <> 65 Then - MsgBox "error" -End If -'!!!Function returns char, i.e sal_Unicode which VB converts to String -Dim ret1 As String -ret1 = objOleTest.in_methodChar("A") -Debug.Print TypeName(ret1) & " " & CStr(ret1) -If ret <> 65 Then - MsgBox "error" -End If - -ret1 = objOleTest.in_methodChar(65) -Debug.Print TypeName(ret1) & " " & CStr(ret1) -If ret <> 65 Then - MsgBox "error" -End If - -ret = objOleTest.in_methodAny("input string") -Debug.Print TypeName(ret) & " " & CStr(ret) -If ret <> "input string" Then - MsgBox "error" -End If - -'Call objOleTest.in_methodAll(10, 10.1, 10.111, True, 10, 11, 12, 13, _ -' "A String", "A", "A String in an Any") - -'Out Parameter simple types -'================================================ -Dim outByte As Byte -objOleTest.testout_methodByte outByte -Debug.Print "out byte " & CStr(outByte) -If outByte <> 111 Then - MsgBox "error" -End If - -Dim outFloat As Single -objOleTest.testout_methodFloat outFloat -Debug.Print "out float " & CStr(outFloat) -If outFloat <> 3.14 Then - MsgBox "error" -End If - -Dim outDouble As Double -objOleTest.testout_methodDouble outDouble -Debug.Print "out double " & CStr(outDouble) -If outDouble <> 3.14 Then - MsgBox "error" -End If - -Dim outBool As Boolean -objOleTest.testout_methodBool outBool -Debug.Print "out bool " & CStr(outBool) -If outBool <> True Then - MsgBox "error" -End If - -Dim outInt As Integer -objOleTest.testout_methodShort outInt -Debug.Print "out short " & CStr(outInt) -If outInt <> 222 Then - MsgBox "error" -End If - -objOleTest.testout_methodUShort outInt -Debug.Print "out unsignedshort " & CStr(outInt) -If outInt <> 333 Then - MsgBox "error" -End If - -Dim outLong As Long -objOleTest.testout_methodLong outLong -Debug.Print "out long " & CStr(outLong) -If outLong <> 444 Then - MsgBox "error" -End If - -objOleTest.testout_methodULong outLong -Debug.Print "out unsigned long " & CStr(outLong) -If outLong <> 555 Then - MsgBox "error" -End If - -Dim outString As String -objOleTest.testout_methodString outString -Debug.Print "out string " & CStr(outString) -If outString <> "a little string" Then - MsgBox "error" -End If - -Dim outChar As Integer -objOleTest.testout_methodChar outChar -Debug.Print "out char " & CStr(outChar) -If outChar <> 65 Then - MsgBox "error" -End If - -Dim outCharS As String -objOleTest.testout_methodChar outCharS -Debug.Print "out char (String) " & CStr(outCharS) -If outCharS <> "A" Then - MsgBox "error" -End If - -objOleTest.testout_methodAny outString -Debug.Print "out Any " & CStr(outString) - -'Out Parameter simple types (VARIANT var) -Dim outVar As Variant -objOleTest.testout_methodByte outVar -Debug.Print "out Byte (VARIANT) " & CStr(outVar) -If outVar <> 111 Then - MsgBox "error" -End If - -objOleTest.testout_methodFloat outVar -Debug.Print "out float (VARIANT) " & CStr(outVar) -If outVar <> 3.14 Then - MsgBox "error" -End If - -objOleTest.testout_methodDouble outVar -Debug.Print "out double (VARIANT) " & CStr(outVar) -If outVar <> 3.14 Then - MsgBox "error" -End If - -objOleTest.testout_methodBool outVar -Debug.Print "out bool (VARIANT) " & CStr(outVar) -If outVar <> True Then - MsgBox "error" -End If - -objOleTest.testout_methodShort outVar -Debug.Print "out short (VARIANT) " & CStr(outVar) -If outVar <> 222 Then - MsgBox "error" -End If - -objOleTest.testout_methodUShort outVar -Debug.Print "out unsigned short (VARIANT) " & CStr(outVar) -If outVar <> 333 Then - MsgBox "error" -End If - -objOleTest.testout_methodLong outVar -Debug.Print "out long (VARIANT) " & CStr(outVar) -If outVar <> 444 Then - MsgBox "error" -End If - -objOleTest.testout_methodULong outVar -Debug.Print "out unsigned long (VARIANT) " & CStr(outVar) -If outVar <> 555 Then - MsgBox "error" -End If - -objOleTest.testout_methodString outVar -Debug.Print "out string (VARIANT) " & CStr(outVar) -If outVar <> "a little string" Then - MsgBox "error" -End If - -objOleTest.testout_methodChar outVar -Debug.Print "out char (VARIANT) " & CStr(outVar) -If outVar <> 65 Then - MsgBox "error" -End If - -objOleTest.testout_methodAny outVar -Debug.Print "out any (VARIANT) " & CStr(outVar) -If outVar <> "I am a string in an any" Then - MsgBox "error" -End If - -'In/Out simple types -'============================================ -outByte = 10 -objOleTest.testinout_methodByte outByte -Debug.Print "inout byte " & CStr(outByte) -If outByte <> 11 Then - MsgBox "error" -End If - -outFloat = 3.14 -objOleTest.testinout_methodFloat outFloat -Debug.Print "inout float " & CStr(outFloat) -If (outFloat > 4.15) And (outFloat < 4.13) Then - MsgBox "error" -End If - -outDouble = 4.14 -objOleTest.testinout_methodDouble outDouble -Debug.Print "inout double " & CStr(outDouble) -If outDouble <> 5.14 Then - MsgBox "error" -End If - -outBool = True -objOleTest.testinout_methodBool outBool -Debug.Print "inout bool " & CStr(outBool) -If outBool <> False Then - MsgBox "error" -End If - -outInt = 10 -objOleTest.testinout_methodShort outInt -Debug.Print "inout short " & CStr(outInt) -If outInt <> 11 Then - MsgBox "error" -End If - -outInt = 20 -objOleTest.testinout_methodUShort outInt -Debug.Print "inout unsignedshort " & CStr(outInt) -If outInt <> 21 Then - MsgBox "error" -End If - -outLong = 30 -objOleTest.testinout_methodLong outLong -Debug.Print "inout long " & CStr(outLong) -If outLong <> 31 Then - MsgBox "error" -End If - -outLong = 40 -objOleTest.testinout_methodULong outLong -Debug.Print "inout unsigned long " & CStr(outLong) -If outLong <> 41 Then - MsgBox "error" -End If - -outString = "this is an in string" -objOleTest.testinout_methodString outString -Debug.Print "inout string " & CStr(outString) -If outString <> "this is an in string out string" Then - MsgBox "error" -End If - -'different Char conversions -objOleTest.testout_methodChar outString -Debug.Print "out char (in: String)" & CStr(outString) -If outString <> "A" Then - MsgBox "error" -End If - -objOleTest.testout_methodChar outInt -Debug.Print "out char (in: Int)" & CStr(outInt) -If outInt <> 65 Then - MsgBox "error" -End If - -'-- -outString = "this is another in out string" -objOleTest.testout_methodAny outString -Debug.Print "out Any " & CStr(outString) -If outString <> "I am a string in an any" Then - MsgBox "error" -End If - -'Objects -' -'========================================================== -' COM obj -Dim retObj As Object -'OleTest receives a COM object that implements XEventListener -'OleTest then calls a disposing on the object. The object then will be -'asked if it has been called -objEventListener.setQuiet True -objEventListener.resetDisposing -Set retObj = objOleTest.in_methodInvocation(objEventListener) -ret = objEventListener.disposingCalled -If ret = False Then - MsgBox "Error" -End If - -'The returned object should be objEventListener, test it by calling disposing -' takes an IDispatch as Param ( EventObject).To provide a TypeMismatch -'we put in another IDispatch -retObj.resetDisposing -retObj.disposing objEventListener -If retObj.disposingCalled = False Then - MsgBox "Error" -End If - - -' out param gives out the OleTestComponent -objOleTest.testout_methodXInterface retObj -outVar = Null -retObj.testout_methodAny outVar -Debug.Print "test out Interface " & CStr(outVar) -If outVar <> "I am a string in an any" Then - MsgBox "error" -End If - -'in out -' in: UNO object, the same is expected as out param -' the function expects OleTest as parameter and sets a value -Dim objOleTest2 As Object -Set objOleTest2 = objServiceManager.createInstance("oletest.OleTest") -'Set a value -objOleTest2.AttrAny2 = "VBString " -objOleTest.testinout_methodXInterface2 objOleTest2 -tmpVar = Null -tmpVar = objOleTest2.AttrAny2 -Debug.Print "in: Uno out: the same object // " & CStr(tmpVar) -If tmpVar <> "VBString this string was written in the UNO component to the inout pararmeter" Then - MsgBox "error" -End If - - -'create a struct -Dim structClass As Object -Set structClass = objCoreReflection.forName("oletest.SimpleStruct") -Dim structInstance As Object -structClass.CreateObject structInstance -structInstance.message = "Now we are in VB" -Debug.Print "struct out " & structInstance.message -If structInstance.message <> "Now we are in VB" Then - MsgBox "error" -End If - -'put the struct into OleTest. The same struct will be returned with an added String -Dim structRet As Object -Set structRet = objOleTest.in_methodStruct(structInstance) -Debug.Print "struct in - return " & structRet.message -If structRet.message <> "Now we are in VBThis string was set in OleTest" Then - MsgBox "error" -End If - -'inout later - -'Arrays -'======================================== -Dim arrLong(2) As Long -Dim arrObj(2) As Object -Dim countvar As Long -For countvar = 0 To 2 - arrLong(countvar) = countvar + 10 - Debug.Print countvar - Set arrObj(countvar) = CreateObject("VBasicEventListener.VBEventListener") - arrObj(countvar).setQuiet True -Next - -'Arrays always contain VARIANTS -Dim seq() As Variant -seq = objOleTest.methodLong(arrLong) - -For countvar = 0 To 2 - Debug.Print CStr(seq(countvar)) - If arrLong(countvar) <> seq(countvar) Then - MsgBox "error" - End If -Next -seq = objOleTest.methodXInterface(arrObj) -For countvar = 0 To 2 - Dim tmp As Object - seq(countvar).resetDisposing - seq(countvar).disposing tmp - If seq(countvar).disposingCalled = False Then - MsgBox "Error" - End If -Next - -'Array containing interfaces (element type is VT_DISPATCH) -Dim arEventListener(2) As Object -For countvar = 0 To 2 - Set arEventListener(countvar) = CreateObject("VBasicEventListener.VBEventListener") - arEventListener(countvar).setQuiet True -Next - -'The function calls disposing on the listeners -seq = objOleTest.methodXEventListeners(arEventListener) -Dim count -For countvar = 0 To 2 - If arEventListener(countvar).disposingCalled = False Then - MsgBox "Error" - End If -Next -'Array containing interfaces (element type is VT_VARIANT which contains VT_DISPATCH -Dim arEventListener2(2) As Variant -For countvar = 0 To 2 - Set arEventListener2(countvar) = CreateObject("VBasicEventListener.VBEventListener") - arEventListener2(countvar).setQuiet True -Next -seq = objOleTest.methodXEventListeners(arEventListener2) -For countvar = 0 To 2 - If arEventListener2(countvar).disposingCalled = False Then - MsgBox "Error" - End If -Next - -'Variant containing Array containing interfaces (element type is VT_VARIANT which contains VT_DISPATCH -Dim arEventListener3(2) As Variant -For countvar = 0 To 2 - Dim var As Variant - Set arEventListener3(countvar) = CreateObject("VBasicEventListener.VBEventListener") - arEventListener3(countvar).setQuiet True -Next -Dim varContAr As Variant -varContAr = arEventListener3 -seq = objOleTest.methodXEventListeners(varContAr) -For countvar = 0 To 2 - If arEventListener3(countvar).disposingCalled = False Then - MsgBox "Error" - End If -Next - -'Get a sequence created in UNO, out param is Variant ( VT_BYREF|VT_VARIANT) -Dim seqX As Variant - -objOleTest.testout_methodSequence seqX -Dim key -For Each key In seqX - Debug.Print CStr(seqX(key)) - If seqX(key) <> key Then - MsgBox "error" - End If -Next -'Get a sequence created in UNO, out param is array Variant ( VT_BYREF|VT_VARIANT|VT_ARRAY) -Dim seqX2() As Variant -objOleTest.testout_methodSequence seqX2 - -For Each key In seqX2 - Debug.Print CStr(seqX2(key)) -Next - -'pass it to UNO and get it back -Dim seq7() As Variant -seq7 = objOleTest.methodLong(seqX) -Dim key2 -For Each key2 In seq7 - Debug.Print CStr(seq7(key2)) - If seqX2(key) <> key Then - MsgBox "error" - End If -Next - -'in out Array -' arrLong is Long Array -Dim inoutVar(2) As Variant - -For countvar = 0 To 2 - inoutVar(countvar) = countvar + 10 -Next - -objOleTest.testinout_methodSequence inoutVar - -countvar = 0 -For countvar = 0 To 2 - Debug.Print CStr(inoutVar(countvar)) - If inoutVar(countvar) <> countvar + 11 Then - MsgBox "error" - End If -Next - -'Multidimensional array -'============================================================ -' Sequence< Sequence