| ' ************************************************************* | |
| ' | |
| ' Licensed to the Apache Software Foundation (ASF) under one | |
| ' or more contributor license agreements. See the NOTICE file | |
| ' distributed with this work for additional information | |
| ' regarding copyright ownership. The ASF licenses this file | |
| ' to you under the Apache License, Version 2.0 (the | |
| ' "License")' you may not use this file except in compliance | |
| ' with the License. You may obtain a copy of the License at | |
| ' | |
| ' http://www.apache.org/licenses/LICENSE-2.0 | |
| ' | |
| ' Unless required by applicable law or agreed to in writing, | |
| ' software distributed under the License is distributed on an | |
| ' "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY | |
| ' KIND, either express or implied. See the License for the | |
| ' specific language governing permissions and limitations | |
| ' under the License. | |
| ' | |
| ' ************************************************************* | |
| 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 parameter" | |
| 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 parameter" 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<long> > 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 |