Option Strict Off Option Explicit On Module Module1 Private objServiceManager As Object Private objCoreReflection As Object Private objOleTest As Object Private objEventListener As Object 'General counter Dim i As Integer Dim j As Integer Dim sError As String Dim outHyper, inHyper, retHyper As Object Public Sub Main() objServiceManager = CreateObject("com.sun.star.ServiceManager") objCoreReflection = objServiceManager.createInstance("com.sun.star.reflection.CoreReflection") ' extensions/test/ole/cpnt objOleTest = objServiceManager.createInstance("oletest.OleTest") ' extensions/test/ole/EventListenerSample/VBEventListener objEventListener = CreateObject("VBasicEventListener.VBEventListener") Debug.Print(TypeName(objOleTest)) testBasics() testHyper() testAny() testObjects() testGetStruct() ''dispose not working i103353 'testImplementedInterfaces() testGetValueObject() testArrays() testProps() End Sub Function testProps() As Object Dim aToolbarItemProp1 As Object aToolbarItemProp1 = objOleTest.Bridge_GetStruct("com.sun.star.beans.PropertyValue") Dim aToolbarItemProp2 As Object aToolbarItemProp2 = objOleTest.Bridge_GetStruct("com.sun.star.beans.PropertyValue") Dim aToolbarItemProp3 As Object aToolbarItemProp3 = objOleTest.Bridge_GetStruct("com.sun.star.beans.PropertyValue") Dim properties(2) As Object aToolbarItemProp1.Name = "CommandURL" aToolbarItemProp1.Value = "macro:///standard.module1.TestIt" aToolbarItemProp2.Name = "Label" aToolbarItemProp2.Value = "Test" aToolbarItemProp3.Name = "Type" aToolbarItemProp3.Value = 0 properties(0) = aToolbarItemProp1 properties(1) = aToolbarItemProp2 properties(2) = aToolbarItemProp3 Dim dummy(-1) As Object Dim Desktop As Object Desktop = objServiceManager.createInstance("com.sun.star.frame.Desktop") Dim Doc As Object Doc = Desktop.loadComponentFromURL("private:factory/swriter", "_blank", 2, dummy) Dim LayoutManager As Object LayoutManager = Doc.currentController.Frame.LayoutManager LayoutManager.createElement("private:resource/toolbar/user_toolbar1") LayoutManager.showElement("private:resource/toolbar/user_toolbar1") Dim ToolBar As Object ToolBar = LayoutManager.getElement("private:resource/toolbar/user_toolbar1") Dim settings As Object settings = ToolBar.getSettings(True) 'the changes are here: Dim aany As Object aany = objServiceManager.Bridge_GetValueObject() Call aany.Set("[]com.sun.star.beans.PropertyValue", properties) Call settings.insertByIndex(0, aany) Call ToolBar.setSettings(settings) End Function Function testBasics() As Object ' In Parameter, simple types '============================================ Dim tmpVar As Object Dim ret As Object Dim outByte, inByte, retByte As Byte Dim outBool, inBool, retBool As Boolean Dim outShort, inShort, retShort As Short Dim outUShort, inUShort, retUShort As Short Dim outLong, inLong, retLong As Integer Dim outULong, inULong, retULong As Integer Dim outHyper, inHyper, retHyper As Object Dim outUHyper, inUHyper, retUHyper As Object Dim outFloat, inFloat, retFloat As Single Dim outDouble, inDouble, retDouble As Double Dim outString, inString, retString As String Dim retChar, inChar, outChar, retChar2 As Short Dim outCharAsString, inCharAsString, retCharAsString As String Dim outAny, inAny, retAny As Object Dim outType, inType, retType As Object Dim outXInterface, inXInterface, retXInterface As Object Dim outXInterface2, inXInterface2, retXInterface2 As Object Dim outVarByte As Object Dim outVarBool As Object Dim outVarShort As Object Dim outVarUShort As Object Dim outVarLong As Object Dim outVarULong As Object Dim outVarFloat As Object Dim outVarDouble As Object Dim outVarString As Object Dim outVarChar As Object Dim outVarAny As Object Dim outVarType As Object inByte = 10 inBool = True inShort = -10 inUShort = -100 inLong = -1000 inHyper = CDec("-9223372036854775808") 'lowest int64 inUHyper = CDec("18446744073709551615") ' highest unsigned int64 inULong = 10000 inFloat = 3.14 inDouble = 3.14 inString = "Hello World!" inChar = 65 inCharAsString = "A" inAny = "Hello World" inType = objServiceManager.Bridge_CreateType("[]long") inXInterface = objCoreReflection inXInterface2 = objEventListener retByte = objOleTest.in_methodByte(inByte) retBool = objOleTest.in_methodBool(inBool) retShort = objOleTest.in_methodShort(inShort) retUShort = objOleTest.in_methodUShort(inUShort) retLong = objOleTest.in_methodLong(inLong) retULong = objOleTest.in_methodULong(inULong) retHyper = objOleTest.in_methodHyper(inHyper) retUHyper = objOleTest.in_methodUHyper(inUHyper) retFloat = objOleTest.in_methodFloat(inFloat) retDouble = objOleTest.in_methodDouble(inDouble) retString = objOleTest.in_methodString(inString) retChar = objOleTest.in_methodChar(inChar) retChar2 = objOleTest.in_methodChar(inCharAsString) retAny = objOleTest.in_methodAny(inAny) retType = objOleTest.in_methodType(inType) retXInterface = objOleTest.in_methodXInterface(inXInterface) ' UNO object retXInterface2 = objOleTest.in_methodXInterface(inXInterface2) If retByte <> inByte Or retBool <> inBool Or retShort <> inShort Or retUShort <> inUShort _ Or retLong <> inLong Or retULong <> inULong Or retHyper <> inHyper _ Or retUHyper <> inUHyper Or retFloat <> inFloat Or retDouble <> inDouble _ Or retString <> inString Or retChar <> inChar Or retChar2 <> Asc(inCharAsString) _ Or retAny <> inAny Or Not (retType.Name = inType.Name) _ Or inXInterface IsNot retXInterface Or inXInterface2 IsNot retXInterface2 Then sError = "in - parameter and return value test failed" MsgBox(sError) End If 'Out Parameter simple types '================================================ objOleTest.testout_methodByte(outByte) objOleTest.testout_methodFloat(outFloat) objOleTest.testout_methodDouble(outDouble) objOleTest.testout_methodBool(outBool) objOleTest.testout_methodShort(outShort) objOleTest.testout_methodUShort(outUShort) objOleTest.testout_methodLong(outLong) objOleTest.testout_methodULong(outULong) objOleTest.testout_methodHyper(outHyper) objOleTest.testout_methodUHyper(outUHyper) objOleTest.testout_methodString(outString) objOleTest.testout_methodChar(outChar) 'outCharAsString is a string. Therfore the returned sal_Unicode value of 65 will be converted 'to a string "65" objOleTest.testout_methodChar(outCharAsString) objOleTest.testout_methodAny(outAny) objOleTest.testout_methodType(outType) 'objOleTest.in_methodXInterface (inXInterface) ' UNO object Call objOleTest.in_methodXInterface(inXInterface) ' UNO object objOleTest.testout_methodXInterface(outXInterface) Call objOleTest.in_methodXInterface(inXInterface2) ' COM object objOleTest.testout_methodXInterface(outXInterface2) If outByte <> inByte Or outFloat <> inFloat Or outDouble <> inDouble _ Or outBool <> inBool Or outShort <> inShort Or outUShort <> inUShort _ Or outLong <> inLong Or outULong <> inULong Or outHyper <> inHyper _ Or outUHyper <> inUHyper Or outString <> inString Or outChar <> inChar _ Or Not (outCharAsString = "65") Or outAny <> inAny _ Or Not (outType.Name = inType.Name) Or inXInterface IsNot outXInterface _ Or inXInterface2 IsNot outXInterface2 Then sError = "out - parameter test failed!" MsgBox(sError) End If 'Out Parameter simple types (VARIANT var) '==================================================== objOleTest.testout_methodByte(outVarByte) objOleTest.testout_methodBool(outVarBool) objOleTest.testout_methodChar(outVarChar) objOleTest.testout_methodShort(outVarShort) objOleTest.testout_methodUShort(outVarUShort) objOleTest.testout_methodLong(outVarLong) objOleTest.testout_methodULong(outVarULong) objOleTest.testout_methodString(outVarString) objOleTest.testout_methodFloat(outVarFloat) objOleTest.testout_methodDouble(outVarDouble) objOleTest.testout_methodAny(outVarAny) objOleTest.testout_methodType(outVarType) If outVarByte <> inByte Or outVarBool <> inBool Or outVarChar <> inChar _ Or outVarShort <> inShort Or outVarUShort <> inUShort _ Or outVarLong <> inLong Or outVarULong <> inULong Or outVarString <> inString _ Or outVarFloat <> inFloat Or outVarDouble <> inDouble Or outVarAny <> inAny _ Or Not (outVarType.Name = inType.Name) Then sError = "out - parameter (VARIANT) test failed!" MsgBox(sError) End If 'In/Out simple types '============================================ objOleTest.in_methodByte(0) objOleTest.in_methodBool(False) objOleTest.in_methodShort(0) objOleTest.in_methodUShort(0) objOleTest.in_methodLong(0) objOleTest.in_methodULong(0) objOleTest.in_methodHyper(0) objOleTest.in_methodUHyper(0) objOleTest.in_methodFloat(0) objOleTest.in_methodDouble(0) objOleTest.in_methodString(0) objOleTest.in_methodChar(0) objOleTest.in_methodAny(0) objOleTest.in_methodType(objServiceManager.Bridge_CreateType("boolean")) outXInterface = Nothing Call objOleTest.in_methodXInterface(outXInterface) outByte = 10 retByte = outByte objOleTest.testinout_methodByte(retByte) objOleTest.testinout_methodByte(retByte) outBool = True retBool = outBool objOleTest.testinout_methodBool(retBool) objOleTest.testinout_methodBool(retBool) outShort = 10 retShort = outShort objOleTest.testinout_methodShort(retShort) objOleTest.testinout_methodShort(retShort) outUShort = 20 retUShort = outUShort objOleTest.testinout_methodUShort(retUShort) objOleTest.testinout_methodUShort(retUShort) outLong = 30 retLong = outLong objOleTest.testinout_methodLong(retLong) objOleTest.testinout_methodLong(retLong) outULong = 40 retULong = outULong objOleTest.testinout_methodULong(retLong) objOleTest.testinout_methodULong(retLong) outHyper = CDec("9223372036854775807") 'highest positiv value of int64 retHyper = outHyper objOleTest.testinout_methodHyper(retHyper) objOleTest.testinout_methodHyper(retHyper) outUHyper = CDec("18446744073709551615") 'highest value of unsigned int64 retUHyper = outUHyper objOleTest.testinout_methodUHyper(retUHyper) objOleTest.testinout_methodUHyper(retUHyper) outFloat = 3.14 retFloat = outFloat objOleTest.testinout_methodFloat(retFloat) objOleTest.testinout_methodFloat(retFloat) outDouble = 4.14 retDouble = outDouble objOleTest.testinout_methodDouble(retDouble) objOleTest.testinout_methodDouble(retDouble) outString = "Hello World!" retString = outString objOleTest.testinout_methodString(retString) objOleTest.testinout_methodString(retString) outChar = 66 retChar = outChar objOleTest.testinout_methodChar(retChar) objOleTest.testinout_methodChar(retChar) outCharAsString = "H" retCharAsString = outCharAsString objOleTest.testinout_methodChar(retCharAsString) objOleTest.testinout_methodChar(retCharAsString) outAny = "Hello World 2!" retAny = outAny objOleTest.testinout_methodAny(retAny) objOleTest.testinout_methodAny(retAny) outType = objServiceManager.Bridge_CreateType("long") retType = outType objOleTest.testinout_methodType(retType) objOleTest.testinout_methodType(retType) outXInterface = objCoreReflection retXInterface = outXInterface objOleTest.testinout_methodXInterface2(retXInterface) If outByte <> retByte Or outBool <> retBool Or outShort <> retShort _ Or outUShort <> retUShort Or outLong <> retLong Or outULong <> retULong _ Or outHyper <> retHyper Or outUHyper <> outUHyper _ Or outFloat <> retFloat Or outDouble <> retDouble _ Or outString <> retString Or outChar <> retChar _ Or outCharAsString <> retCharAsString _ Or outAny <> retAny Or Not (outType.Name = retType.Name) _ Or outXInterface IsNot retXInterface Then sError = "in/out - parameter test failed!" MsgBox(sError) End If 'Attributes objOleTest.AByte = inByte retByte = 0 retByte = objOleTest.AByte objOleTest.AFloat = inFloat retFloat = 0 retFloat = objOleTest.AFloat objOleTest.AType = inType retType = Nothing retType = objOleTest.AType If inByte <> retByte Or inFloat <> retFloat Or Not (inType.Name = retType.Name) Then sError = "Attributes - test failed!" MsgBox(sError) End If End Function Function testHyper() As Object '====================================================================== ' Other Hyper tests Dim emptyVar As Object Dim retAny As Object retAny = emptyVar inHyper = CDec("9223372036854775807") 'highest positiv value of int64 retAny = objOleTest.in_methodAny(inHyper) sError = "hyper test failed" If inHyper <> retAny Then MsgBox(sError) End If inHyper = CDec("-9223372036854775808") 'lowest negativ value of int64 retAny = objOleTest.in_methodAny(inHyper) If inHyper <> retAny Then MsgBox(sError) End If inHyper = CDec("18446744073709551615") 'highest positiv value of unsigne int64 retAny = objOleTest.in_methodAny(inHyper) If inHyper <> retAny Then MsgBox(sError) End If inHyper = CDec(-1) retAny = objOleTest.in_methodAny(inHyper) If inHyper <> retAny Then MsgBox(sError) End If inHyper = CDec(0) retAny = objOleTest.in_methodAny(inHyper) If inHyper <> retAny Then MsgBox(sError) End If '============================================================================== End Function Function testAny() As Object Dim outVAr As Object 'Any test. We pass in an any as value object. If it is not correct converted 'then the target component throws a RuntimeException Dim lengthInAny As Integer lengthInAny = 10 Dim seqLongInAny(10) As Integer For i = 0 To lengthInAny - 1 seqLongInAny(i) = i + 10 Next Dim anySeqLong As Object anySeqLong = objOleTest.Bridge_GetValueObject() anySeqLong.Set("[]long", seqLongInAny) Dim anySeqRet As Object Err.Clear() On Error Resume Next anySeqRet = objOleTest.other_methodAny(anySeqLong, "[]long") If Err.Number <> 0 Then MsgBox("error") End If End Function Function testObjects() As Object ' COM obj Dim outVAr As Object 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() retObj = objOleTest.in_methodInvocation(objEventListener) Dim ret As Object 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 myAny As Object Dim objOleTest2 As Object objOleTest2 = objServiceManager.createInstance("oletest.OleTest") 'Set a value objOleTest2.AttrAny2 = "VBString " 'testinout_methodXInterfaces substitutes the argument with the object set in in_methodXInterface objOleTest.AttrAny2 = "VBString this string was written in the UNO component to the inout pararmeter" objOleTest.in_methodXInterface(objOleTest) objOleTest.testinout_methodXInterface2(objOleTest2) Dim tmpVar As Object tmpVar = System.DBNull.Value 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 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 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 End Function Function testGetStruct() As Object 'Bridge_GetStruct '======================================================== Dim objDocument As Object objDocument = createHiddenDocument() 'dispose not working i103353 'objDocument.dispose() objDocument.close(True) End Function Function testImplementedInterfaces() As Object 'Bridge_ImplementedInterfaces '================================================= ' call an UNO function that takes an XEventListener interface 'We provide a COM implementation (IDispatch) as EventListener 'Open a new empty writer document Dim objDocument As Object objDocument = createHiddenDocument() objEventListener.resetDisposing() objDocument.addEventListener(objEventListener) objDocument.dispose() If objEventListener.disposingCalled = False Then MsgBox("Error") End If End Function Function testGetValueObject() As Object 'Bridge_GetValueObject '================================================== Dim objVal As Object objVal = objOleTest.Bridge_GetValueObject() Dim arrByte(9) As Byte Dim countvar As Integer For countvar = 0 To 9 arrByte(countvar) = countvar Next countvar objVal.Set("[]byte", arrByte) Dim ret As Object ret = 0 ret = objOleTest.methodByte(objVal) 'Test if ret is the same array Dim key As Object key = 0 For Each key In ret If ret(key) <> arrByte(key) Then MsgBox("Error") End If Debug.Print(ret(key)) Next key Dim outByte As Byte outByte = 77 Dim retByte As Byte retByte = outByte objVal.InitInOutParam("byte", retByte) objOleTest.testinout_methodByte(objVal) objVal.InitInOutParam("byte", retByte) objOleTest.testinout_methodByte(objVal) ret = 0 ret = objVal.Get() Debug.Print(ret) If ret <> outByte Then MsgBox("error") End If objVal.InitOutParam() Dim inChar As Short inChar = 65 objOleTest.in_methodChar(inChar) objOleTest.testout_methodChar(objVal) 'Returns 'A' (65) ret = 0 ret = objVal.Get() Debug.Print(ret) If ret <> inChar Then MsgBox("error") End If End Function Function testArrays() As Object 'Arrays '======================================== Dim arrLong(2) As Integer Dim arrObj(2) As Object Dim countvar As Integer For countvar = 0 To 2 arrLong(countvar) = countvar + 10 Debug.Print(countvar) arrObj(countvar) = CreateObject("VBasicEventListener.VBEventListener") arrObj(countvar).setQuiet(True) Next 'Arrays always contain VARIANTS Dim seq() As Object 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) Dim tmp As Object For countvar = 0 To 2 seq(countvar).resetDisposing() seq(countvar).disposing(CObj(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 arEventListener(countvar) = CreateObject("VBasicEventListener.VBEventListener") arEventListener(countvar).setQuiet(True) Next 'The function calls disposing on the listeners seq = objOleTest.methodXEventListeners(arEventListener) Dim count As Object 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 Object For countvar = 0 To 2 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 Object Dim var As Object For countvar = 0 To 2 arEventListener3(countvar) = CreateObject("VBasicEventListener.VBEventListener") arEventListener3(countvar).setQuiet(True) Next Dim varContAr As Object varContAr = VB6.CopyArray(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 Object objOleTest.testout_methodSequence(seqX) Dim key As Object For Each key In seqX Debug.Print(CStr(seqX(key))) If seqX(key) <> key Then MsgBox("error") End If Next key 'Get a sequence created in UNO, out param is array Variant ( VT_BYREF|VT_VARIANT|VT_ARRAY) Dim seqX2() As Object objOleTest.testout_methodSequence(seqX2) For Each key In seqX2 Debug.Print(CStr(seqX2(key))) Next key 'pass it to UNO and get it back Dim seq7() As Object seq7 = objOleTest.methodLong(seqX) Dim key2 As Object For Each key2 In seq7 Debug.Print(CStr(seq7(key2))) If seqX2(key) <> key Then MsgBox("error") End If Next key2 'array with starting index != 0 Dim seqIndex(2) As Integer Dim seq8() As Object Dim longVal1, longVal2 As Integer longVal1 = 1 longVal2 = 2 seqIndex(1) = longVal1 seqIndex(2) = longVal2 'The bridge returns a Safearray of Variants. It does not yet convert to an _ 'array of a particular type! 'Comparing of elements from seq8 (Object) with long values worked without _ 'explicit cast as is necessary in VS 2008. Also arrays in VS 2008 start at _ 'index 0 seq8 = objOleTest.methodLong(seqIndex) If longVal1 <> CInt(seq8(1)) And longVal2 <> CInt(seq8(2)) Then MsgBox("error") End If 'in out Array ' arrLong is Long Array Dim inoutVar(2) As Object 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 > methodSequence( Sequence< Sequence long> >) ' Real multidimensional array Array ' 9 is Dim 1 (least significant) with C API Dim mulAr(9, 1) As Integer For i = 0 To 1 For j = 0 To 9 mulAr(j, i) = i * 10 + j Next j Next i Dim resMul As Object resMul = objOleTest.methodSequence(mulAr) Dim countDim1 As Integer Dim countDim2 As Integer Dim arr As Object For countDim2 = 0 To 1 arr = resMul(countDim2) For countDim1 = 0 To 9 Debug.Print(arr(countDim1)) If arr(countDim1) <> mulAr(countDim1, countDim2) Then MsgBox("Error Multidimensional Array") End If Next countDim1 Next countDim2 IsArray(resMul) 'Array of VARIANTs containing arrays Dim mulAr2(1) As Object Dim arr2(9) As Integer For i = 0 To 1 ' Dim arr(9) As Long For j = 0 To 9 arr2(j) = i * 10 + j Next j mulAr2(i) = VB6.CopyArray(arr2) Next i resMul = 0 resMul = objOleTest.methodSequence(mulAr2) arr = 0 Dim tmpVar As Object For countDim2 = 0 To 1 arr = resMul(countDim2) tmpVar = mulAr2(countDim2) For countDim1 = 0 To 9 Debug.Print(arr(countDim1)) If arr(countDim1) <> tmpVar(countDim1) Then MsgBox("Error Multidimensional Array") End If Next countDim1 Next countDim2 'Array containing interfaces (element type is VT_DISPATCH) Dim arArEventListener(1, 2) As Object For i = 0 To 1 For j = 0 To 2 arArEventListener(i, j) = CreateObject("VBasicEventListener.VBEventListener") arArEventListener(i, j).setQuiet(True) Next Next 'The function calls disposing on the listeners seq = objOleTest.methodXEventListenersMul(arArEventListener) For i = 0 To 1 For j = 0 To 2 If arArEventListener(i, j).disposingCalled = False Then MsgBox("Error") End If Next Next 'Array containing interfaces (element type is VT_VARIANT containing VT_DISPATCH) Dim arArEventListener2(1, 2) As Object For i = 0 To 1 For j = 0 To 2 arArEventListener2(i, j) = CreateObject("VBasicEventListener.VBEventListener") arArEventListener2(i, j).setQuiet(True) Next Next 'The function calls disposing on the listeners seq = objOleTest.methodXEventListenersMul(arArEventListener2) For i = 0 To 1 For j = 0 To 2 If arArEventListener2(i, j).disposingCalled = False Then MsgBox("Error") End If Next Next ' SAFEARRAY of VARIANTS containing SAFEARRAYs 'The ultimate element type is VT_DISPATCH ( XEventListener) Dim arEventListener4(1) As Object Dim seq1(2) As Object Dim seq2(2) As Object For i = 0 To 2 seq1(i) = CreateObject("VBasicEventListener.VBEventListener") seq2(i) = CreateObject("VBasicEventListener.VBEventListener") seq1(i).setQuiet(True) seq2(i).setQuiet(True) Next arEventListener4(0) = VB6.CopyArray(seq1) arEventListener4(1) = VB6.CopyArray(seq2) 'The function calls disposing on the listeners seq = objOleTest.methodXEventListenersMul(arEventListener4) For i = 0 To 2 If seq1(i).disposingCalled = False Or seq2(i).disposingCalled = False Then MsgBox("Error") End If Next End Function Function createHiddenDocument() As Object 'Try to create a hidden document Dim objPropValue As Object objPropValue = objOleTest.Bridge_GetStruct("com.sun.star.beans.PropertyValue") 'Set the members. If this fails then there is an Error objPropValue.Name = "Hidden" objPropValue.Handle = -1 objPropValue.Value = True 'create a hidden document 'Create the Desktop Dim objDesktop As Object objDesktop = objServiceManager.createInstance("com.sun.star.frame.Desktop") 'Open a new empty writer document Dim args(0) As Object args(0) = objPropValue createHiddenDocument = objDesktop.loadComponentFromURL("private:factory/swriter", "_blank", 0, args) End Function End Module