1*3e02b54dSAndrew Rist' ************************************************************* 2*3e02b54dSAndrew Rist' 3*3e02b54dSAndrew Rist' Licensed to the Apache Software Foundation (ASF) under one 4*3e02b54dSAndrew Rist' or more contributor license agreements. See the NOTICE file 5*3e02b54dSAndrew Rist' distributed with this work for additional information 6*3e02b54dSAndrew Rist' regarding copyright ownership. The ASF licenses this file 7*3e02b54dSAndrew Rist' to you under the Apache License, Version 2.0 (the 8*3e02b54dSAndrew Rist' "License")' you may not use this file except in compliance 9*3e02b54dSAndrew Rist' with the License. You may obtain a copy of the License at 10*3e02b54dSAndrew Rist' 11*3e02b54dSAndrew Rist' http://www.apache.org/licenses/LICENSE-2.0 12*3e02b54dSAndrew Rist' 13*3e02b54dSAndrew Rist' Unless required by applicable law or agreed to in writing, 14*3e02b54dSAndrew Rist' software distributed under the License is distributed on an 15*3e02b54dSAndrew Rist' "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY 16*3e02b54dSAndrew Rist' KIND, either express or implied. See the License for the 17*3e02b54dSAndrew Rist' specific language governing permissions and limitations 18*3e02b54dSAndrew Rist' under the License. 19*3e02b54dSAndrew Rist' 20*3e02b54dSAndrew Rist' ************************************************************* 21cdf0e10cSrcweirOption Strict Off 22cdf0e10cSrcweirOption Explicit On 23cdf0e10cSrcweirModule Module1 24cdf0e10cSrcweir 25cdf0e10cSrcweirPrivate objServiceManager As Object 26cdf0e10cSrcweirPrivate objCoreReflection As Object 27cdf0e10cSrcweirPrivate objOleTest As Object 28cdf0e10cSrcweirPrivate objEventListener As Object 29cdf0e10cSrcweir'General counter 30cdf0e10cSrcweirDim i As Integer 31cdf0e10cSrcweirDim j As Integer 32cdf0e10cSrcweirDim sError As String 33cdf0e10cSrcweirDim outHyper, inHyper, retHyper As Object 34cdf0e10cSrcweir 35cdf0e10cSrcweirPublic Sub Main() 36cdf0e10cSrcweir objServiceManager = CreateObject("com.sun.star.ServiceManager") 37cdf0e10cSrcweir objCoreReflection = objServiceManager.createInstance("com.sun.star.reflection.CoreReflection") 38cdf0e10cSrcweir ' extensions/test/ole/cpnt 39cdf0e10cSrcweir objOleTest = objServiceManager.createInstance("oletest.OleTest") 40cdf0e10cSrcweir ' extensions/test/ole/EventListenerSample/VBEventListener 41cdf0e10cSrcweir objEventListener = CreateObject("VBasicEventListener.VBEventListener") 42cdf0e10cSrcweir Debug.Print(TypeName(objOleTest)) 43cdf0e10cSrcweir 44cdf0e10cSrcweir 45cdf0e10cSrcweir testBasics() 46cdf0e10cSrcweir testHyper() 47cdf0e10cSrcweir testAny() 48cdf0e10cSrcweir testObjects() 49cdf0e10cSrcweir testGetStruct() 50cdf0e10cSrcweir ''dispose not working i103353 51cdf0e10cSrcweir 'testImplementedInterfaces() 52cdf0e10cSrcweir testGetValueObject() 53cdf0e10cSrcweir testArrays() 54cdf0e10cSrcweir testProps() 55cdf0e10cSrcweir 56cdf0e10cSrcweir End Sub 57cdf0e10cSrcweir Function testProps() As Object 58cdf0e10cSrcweir 59cdf0e10cSrcweir Dim aToolbarItemProp1 As Object 60cdf0e10cSrcweir aToolbarItemProp1 = objOleTest.Bridge_GetStruct("com.sun.star.beans.PropertyValue") 61cdf0e10cSrcweir Dim aToolbarItemProp2 As Object 62cdf0e10cSrcweir aToolbarItemProp2 = objOleTest.Bridge_GetStruct("com.sun.star.beans.PropertyValue") 63cdf0e10cSrcweir Dim aToolbarItemProp3 As Object 64cdf0e10cSrcweir aToolbarItemProp3 = objOleTest.Bridge_GetStruct("com.sun.star.beans.PropertyValue") 65cdf0e10cSrcweir Dim properties(2) As Object 66cdf0e10cSrcweir 67cdf0e10cSrcweir aToolbarItemProp1.Name = "CommandURL" 68cdf0e10cSrcweir aToolbarItemProp1.Value = "macro:///standard.module1.TestIt" 69cdf0e10cSrcweir aToolbarItemProp2.Name = "Label" 70cdf0e10cSrcweir aToolbarItemProp2.Value = "Test" 71cdf0e10cSrcweir aToolbarItemProp3.Name = "Type" 72cdf0e10cSrcweir aToolbarItemProp3.Value = 0 73cdf0e10cSrcweir 74cdf0e10cSrcweir properties(0) = aToolbarItemProp1 75cdf0e10cSrcweir properties(1) = aToolbarItemProp2 76cdf0e10cSrcweir properties(2) = aToolbarItemProp3 77cdf0e10cSrcweir 78cdf0e10cSrcweir 79cdf0e10cSrcweir Dim dummy(-1) As Object 80cdf0e10cSrcweir 81cdf0e10cSrcweir Dim Desktop As Object 82cdf0e10cSrcweir Desktop = objServiceManager.createInstance("com.sun.star.frame.Desktop") 83cdf0e10cSrcweir Dim Doc As Object 84cdf0e10cSrcweir Doc = Desktop.loadComponentFromURL("private:factory/swriter", "_blank", 2, dummy) 85cdf0e10cSrcweir Dim LayoutManager As Object 86cdf0e10cSrcweir LayoutManager = Doc.currentController.Frame.LayoutManager 87cdf0e10cSrcweir 88cdf0e10cSrcweir LayoutManager.createElement("private:resource/toolbar/user_toolbar1") 89cdf0e10cSrcweir LayoutManager.showElement("private:resource/toolbar/user_toolbar1") 90cdf0e10cSrcweir Dim ToolBar As Object 91cdf0e10cSrcweir ToolBar = LayoutManager.getElement("private:resource/toolbar/user_toolbar1") 92cdf0e10cSrcweir Dim settings As Object 93cdf0e10cSrcweir settings = ToolBar.getSettings(True) 94cdf0e10cSrcweir 95cdf0e10cSrcweir 'the changes are here: 96cdf0e10cSrcweir Dim aany As Object 97cdf0e10cSrcweir aany = objServiceManager.Bridge_GetValueObject() 98cdf0e10cSrcweir Call aany.Set("[]com.sun.star.beans.PropertyValue", properties) 99cdf0e10cSrcweir Call settings.insertByIndex(0, aany) 100cdf0e10cSrcweir Call ToolBar.setSettings(settings) 101cdf0e10cSrcweir 102cdf0e10cSrcweir 103cdf0e10cSrcweir End Function 104cdf0e10cSrcweir 105cdf0e10cSrcweir 106cdf0e10cSrcweir Function testBasics() As Object 107cdf0e10cSrcweir ' In Parameter, simple types 108cdf0e10cSrcweir '============================================ 109cdf0e10cSrcweir Dim tmpVar As Object 110cdf0e10cSrcweir Dim ret As Object 111cdf0e10cSrcweir Dim outByte, inByte, retByte As Byte 112cdf0e10cSrcweir Dim outBool, inBool, retBool As Boolean 113cdf0e10cSrcweir Dim outShort, inShort, retShort As Short 114cdf0e10cSrcweir Dim outUShort, inUShort, retUShort As Short 115cdf0e10cSrcweir Dim outLong, inLong, retLong As Integer 116cdf0e10cSrcweir Dim outULong, inULong, retULong As Integer 117cdf0e10cSrcweir Dim outHyper, inHyper, retHyper As Object 118cdf0e10cSrcweir Dim outUHyper, inUHyper, retUHyper As Object 119cdf0e10cSrcweir Dim outFloat, inFloat, retFloat As Single 120cdf0e10cSrcweir Dim outDouble, inDouble, retDouble As Double 121cdf0e10cSrcweir Dim outString, inString, retString As String 122cdf0e10cSrcweir Dim retChar, inChar, outChar, retChar2 As Short 123cdf0e10cSrcweir Dim outCharAsString, inCharAsString, retCharAsString As String 124cdf0e10cSrcweir Dim outAny, inAny, retAny As Object 125cdf0e10cSrcweir Dim outType, inType, retType As Object 126cdf0e10cSrcweir Dim outXInterface, inXInterface, retXInterface As Object 127cdf0e10cSrcweir Dim outXInterface2, inXInterface2, retXInterface2 As Object 128cdf0e10cSrcweir 129cdf0e10cSrcweir 130cdf0e10cSrcweir Dim outVarByte As Object 131cdf0e10cSrcweir Dim outVarBool As Object 132cdf0e10cSrcweir Dim outVarShort As Object 133cdf0e10cSrcweir Dim outVarUShort As Object 134cdf0e10cSrcweir Dim outVarLong As Object 135cdf0e10cSrcweir Dim outVarULong As Object 136cdf0e10cSrcweir Dim outVarFloat As Object 137cdf0e10cSrcweir Dim outVarDouble As Object 138cdf0e10cSrcweir Dim outVarString As Object 139cdf0e10cSrcweir Dim outVarChar As Object 140cdf0e10cSrcweir Dim outVarAny As Object 141cdf0e10cSrcweir Dim outVarType As Object 142cdf0e10cSrcweir 143cdf0e10cSrcweir inByte = 10 144cdf0e10cSrcweir inBool = True 145cdf0e10cSrcweir inShort = -10 146cdf0e10cSrcweir inUShort = -100 147cdf0e10cSrcweir inLong = -1000 148cdf0e10cSrcweir inHyper = CDec("-9223372036854775808") 'lowest int64 149cdf0e10cSrcweir inUHyper = CDec("18446744073709551615") ' highest unsigned int64 150cdf0e10cSrcweir inULong = 10000 151cdf0e10cSrcweir inFloat = 3.14 152cdf0e10cSrcweir inDouble = 3.14 153cdf0e10cSrcweir inString = "Hello World!" 154cdf0e10cSrcweir inChar = 65 155cdf0e10cSrcweir inCharAsString = "A" 156cdf0e10cSrcweir inAny = "Hello World" 157cdf0e10cSrcweir inType = objServiceManager.Bridge_CreateType("[]long") 158cdf0e10cSrcweir inXInterface = objCoreReflection 159cdf0e10cSrcweir inXInterface2 = objEventListener 160cdf0e10cSrcweir 161cdf0e10cSrcweir retByte = objOleTest.in_methodByte(inByte) 162cdf0e10cSrcweir retBool = objOleTest.in_methodBool(inBool) 163cdf0e10cSrcweir retShort = objOleTest.in_methodShort(inShort) 164cdf0e10cSrcweir retUShort = objOleTest.in_methodUShort(inUShort) 165cdf0e10cSrcweir retLong = objOleTest.in_methodLong(inLong) 166cdf0e10cSrcweir retULong = objOleTest.in_methodULong(inULong) 167cdf0e10cSrcweir retHyper = objOleTest.in_methodHyper(inHyper) 168cdf0e10cSrcweir retUHyper = objOleTest.in_methodUHyper(inUHyper) 169cdf0e10cSrcweir retFloat = objOleTest.in_methodFloat(inFloat) 170cdf0e10cSrcweir retDouble = objOleTest.in_methodDouble(inDouble) 171cdf0e10cSrcweir retString = objOleTest.in_methodString(inString) 172cdf0e10cSrcweir retChar = objOleTest.in_methodChar(inChar) 173cdf0e10cSrcweir retChar2 = objOleTest.in_methodChar(inCharAsString) 174cdf0e10cSrcweir retAny = objOleTest.in_methodAny(inAny) 175cdf0e10cSrcweir retType = objOleTest.in_methodType(inType) 176cdf0e10cSrcweir retXInterface = objOleTest.in_methodXInterface(inXInterface) ' UNO object 177cdf0e10cSrcweir retXInterface2 = objOleTest.in_methodXInterface(inXInterface2) 178cdf0e10cSrcweir 179cdf0e10cSrcweir If retByte <> inByte Or retBool <> inBool Or retShort <> inShort Or retUShort <> inUShort _ 180cdf0e10cSrcweir Or retLong <> inLong Or retULong <> inULong Or retHyper <> inHyper _ 181cdf0e10cSrcweir Or retUHyper <> inUHyper Or retFloat <> inFloat Or retDouble <> inDouble _ 182cdf0e10cSrcweir Or retString <> inString Or retChar <> inChar Or retChar2 <> Asc(inCharAsString) _ 183cdf0e10cSrcweir Or retAny <> inAny Or Not (retType.Name = inType.Name) _ 184cdf0e10cSrcweir Or inXInterface IsNot retXInterface Or inXInterface2 IsNot retXInterface2 Then 185cdf0e10cSrcweir sError = "in - parameter and return value test failed" 186cdf0e10cSrcweir MsgBox(sError) 187cdf0e10cSrcweir 188cdf0e10cSrcweir End If 189cdf0e10cSrcweir 190cdf0e10cSrcweir 'Out Parameter simple types 191cdf0e10cSrcweir '================================================ 192cdf0e10cSrcweir 193cdf0e10cSrcweir 194cdf0e10cSrcweir objOleTest.testout_methodByte(outByte) 195cdf0e10cSrcweir objOleTest.testout_methodFloat(outFloat) 196cdf0e10cSrcweir objOleTest.testout_methodDouble(outDouble) 197cdf0e10cSrcweir objOleTest.testout_methodBool(outBool) 198cdf0e10cSrcweir objOleTest.testout_methodShort(outShort) 199cdf0e10cSrcweir objOleTest.testout_methodUShort(outUShort) 200cdf0e10cSrcweir objOleTest.testout_methodLong(outLong) 201cdf0e10cSrcweir objOleTest.testout_methodULong(outULong) 202cdf0e10cSrcweir objOleTest.testout_methodHyper(outHyper) 203cdf0e10cSrcweir objOleTest.testout_methodUHyper(outUHyper) 204cdf0e10cSrcweir objOleTest.testout_methodString(outString) 205cdf0e10cSrcweir objOleTest.testout_methodChar(outChar) 206cdf0e10cSrcweir 'outCharAsString is a string. Therfore the returned sal_Unicode value of 65 will be converted 207cdf0e10cSrcweir 'to a string "65" 208cdf0e10cSrcweir objOleTest.testout_methodChar(outCharAsString) 209cdf0e10cSrcweir objOleTest.testout_methodAny(outAny) 210cdf0e10cSrcweir objOleTest.testout_methodType(outType) 211cdf0e10cSrcweir 'objOleTest.in_methodXInterface (inXInterface) ' UNO object 212cdf0e10cSrcweir Call objOleTest.in_methodXInterface(inXInterface) ' UNO object 213cdf0e10cSrcweir objOleTest.testout_methodXInterface(outXInterface) 214cdf0e10cSrcweir Call objOleTest.in_methodXInterface(inXInterface2) ' COM object 215cdf0e10cSrcweir objOleTest.testout_methodXInterface(outXInterface2) 216cdf0e10cSrcweir 217cdf0e10cSrcweir If outByte <> inByte Or outFloat <> inFloat Or outDouble <> inDouble _ 218cdf0e10cSrcweir Or outBool <> inBool Or outShort <> inShort Or outUShort <> inUShort _ 219cdf0e10cSrcweir Or outLong <> inLong Or outULong <> inULong Or outHyper <> inHyper _ 220cdf0e10cSrcweir Or outUHyper <> inUHyper Or outString <> inString Or outChar <> inChar _ 221cdf0e10cSrcweir Or Not (outCharAsString = "65") Or outAny <> inAny _ 222cdf0e10cSrcweir Or Not (outType.Name = inType.Name) Or inXInterface IsNot outXInterface _ 223cdf0e10cSrcweir Or inXInterface2 IsNot outXInterface2 Then 224cdf0e10cSrcweir 225cdf0e10cSrcweir sError = "out - parameter test failed!" 226cdf0e10cSrcweir MsgBox(sError) 227cdf0e10cSrcweir End If 228cdf0e10cSrcweir 229cdf0e10cSrcweir 'Out Parameter simple types (VARIANT var) 230cdf0e10cSrcweir '==================================================== 231cdf0e10cSrcweir objOleTest.testout_methodByte(outVarByte) 232cdf0e10cSrcweir objOleTest.testout_methodBool(outVarBool) 233cdf0e10cSrcweir objOleTest.testout_methodChar(outVarChar) 234cdf0e10cSrcweir objOleTest.testout_methodShort(outVarShort) 235cdf0e10cSrcweir objOleTest.testout_methodUShort(outVarUShort) 236cdf0e10cSrcweir objOleTest.testout_methodLong(outVarLong) 237cdf0e10cSrcweir objOleTest.testout_methodULong(outVarULong) 238cdf0e10cSrcweir objOleTest.testout_methodString(outVarString) 239cdf0e10cSrcweir objOleTest.testout_methodFloat(outVarFloat) 240cdf0e10cSrcweir objOleTest.testout_methodDouble(outVarDouble) 241cdf0e10cSrcweir objOleTest.testout_methodAny(outVarAny) 242cdf0e10cSrcweir objOleTest.testout_methodType(outVarType) 243cdf0e10cSrcweir 244cdf0e10cSrcweir If outVarByte <> inByte Or outVarBool <> inBool Or outVarChar <> inChar _ 245cdf0e10cSrcweir Or outVarShort <> inShort Or outVarUShort <> inUShort _ 246cdf0e10cSrcweir Or outVarLong <> inLong Or outVarULong <> inULong Or outVarString <> inString _ 247cdf0e10cSrcweir Or outVarFloat <> inFloat Or outVarDouble <> inDouble Or outVarAny <> inAny _ 248cdf0e10cSrcweir Or Not (outVarType.Name = inType.Name) Then 249cdf0e10cSrcweir sError = "out - parameter (VARIANT) test failed!" 250cdf0e10cSrcweir MsgBox(sError) 251cdf0e10cSrcweir End If 252cdf0e10cSrcweir 253cdf0e10cSrcweir 'In/Out simple types 254cdf0e10cSrcweir '============================================ 255cdf0e10cSrcweir objOleTest.in_methodByte(0) 256cdf0e10cSrcweir objOleTest.in_methodBool(False) 257cdf0e10cSrcweir objOleTest.in_methodShort(0) 258cdf0e10cSrcweir objOleTest.in_methodUShort(0) 259cdf0e10cSrcweir objOleTest.in_methodLong(0) 260cdf0e10cSrcweir objOleTest.in_methodULong(0) 261cdf0e10cSrcweir objOleTest.in_methodHyper(0) 262cdf0e10cSrcweir objOleTest.in_methodUHyper(0) 263cdf0e10cSrcweir objOleTest.in_methodFloat(0) 264cdf0e10cSrcweir objOleTest.in_methodDouble(0) 265cdf0e10cSrcweir objOleTest.in_methodString(0) 266cdf0e10cSrcweir objOleTest.in_methodChar(0) 267cdf0e10cSrcweir objOleTest.in_methodAny(0) 268cdf0e10cSrcweir objOleTest.in_methodType(objServiceManager.Bridge_CreateType("boolean")) 269cdf0e10cSrcweir outXInterface = Nothing 270cdf0e10cSrcweir Call objOleTest.in_methodXInterface(outXInterface) 271cdf0e10cSrcweir 272cdf0e10cSrcweir outByte = 10 273cdf0e10cSrcweir retByte = outByte 274cdf0e10cSrcweir objOleTest.testinout_methodByte(retByte) 275cdf0e10cSrcweir objOleTest.testinout_methodByte(retByte) 276cdf0e10cSrcweir outBool = True 277cdf0e10cSrcweir retBool = outBool 278cdf0e10cSrcweir objOleTest.testinout_methodBool(retBool) 279cdf0e10cSrcweir objOleTest.testinout_methodBool(retBool) 280cdf0e10cSrcweir outShort = 10 281cdf0e10cSrcweir retShort = outShort 282cdf0e10cSrcweir objOleTest.testinout_methodShort(retShort) 283cdf0e10cSrcweir objOleTest.testinout_methodShort(retShort) 284cdf0e10cSrcweir outUShort = 20 285cdf0e10cSrcweir retUShort = outUShort 286cdf0e10cSrcweir objOleTest.testinout_methodUShort(retUShort) 287cdf0e10cSrcweir objOleTest.testinout_methodUShort(retUShort) 288cdf0e10cSrcweir outLong = 30 289cdf0e10cSrcweir retLong = outLong 290cdf0e10cSrcweir objOleTest.testinout_methodLong(retLong) 291cdf0e10cSrcweir objOleTest.testinout_methodLong(retLong) 292cdf0e10cSrcweir outULong = 40 293cdf0e10cSrcweir retULong = outULong 294cdf0e10cSrcweir objOleTest.testinout_methodULong(retLong) 295cdf0e10cSrcweir objOleTest.testinout_methodULong(retLong) 296cdf0e10cSrcweir outHyper = CDec("9223372036854775807") 'highest positiv value of int64 297cdf0e10cSrcweir retHyper = outHyper 298cdf0e10cSrcweir objOleTest.testinout_methodHyper(retHyper) 299cdf0e10cSrcweir objOleTest.testinout_methodHyper(retHyper) 300cdf0e10cSrcweir outUHyper = CDec("18446744073709551615") 'highest value of unsigned int64 301cdf0e10cSrcweir retUHyper = outUHyper 302cdf0e10cSrcweir objOleTest.testinout_methodUHyper(retUHyper) 303cdf0e10cSrcweir objOleTest.testinout_methodUHyper(retUHyper) 304cdf0e10cSrcweir outFloat = 3.14 305cdf0e10cSrcweir retFloat = outFloat 306cdf0e10cSrcweir objOleTest.testinout_methodFloat(retFloat) 307cdf0e10cSrcweir objOleTest.testinout_methodFloat(retFloat) 308cdf0e10cSrcweir outDouble = 4.14 309cdf0e10cSrcweir retDouble = outDouble 310cdf0e10cSrcweir objOleTest.testinout_methodDouble(retDouble) 311cdf0e10cSrcweir objOleTest.testinout_methodDouble(retDouble) 312cdf0e10cSrcweir outString = "Hello World!" 313cdf0e10cSrcweir retString = outString 314cdf0e10cSrcweir objOleTest.testinout_methodString(retString) 315cdf0e10cSrcweir objOleTest.testinout_methodString(retString) 316cdf0e10cSrcweir outChar = 66 317cdf0e10cSrcweir retChar = outChar 318cdf0e10cSrcweir objOleTest.testinout_methodChar(retChar) 319cdf0e10cSrcweir objOleTest.testinout_methodChar(retChar) 320cdf0e10cSrcweir outCharAsString = "H" 321cdf0e10cSrcweir retCharAsString = outCharAsString 322cdf0e10cSrcweir objOleTest.testinout_methodChar(retCharAsString) 323cdf0e10cSrcweir objOleTest.testinout_methodChar(retCharAsString) 324cdf0e10cSrcweir outAny = "Hello World 2!" 325cdf0e10cSrcweir retAny = outAny 326cdf0e10cSrcweir objOleTest.testinout_methodAny(retAny) 327cdf0e10cSrcweir objOleTest.testinout_methodAny(retAny) 328cdf0e10cSrcweir outType = objServiceManager.Bridge_CreateType("long") 329cdf0e10cSrcweir retType = outType 330cdf0e10cSrcweir objOleTest.testinout_methodType(retType) 331cdf0e10cSrcweir objOleTest.testinout_methodType(retType) 332cdf0e10cSrcweir 333cdf0e10cSrcweir outXInterface = objCoreReflection 334cdf0e10cSrcweir retXInterface = outXInterface 335cdf0e10cSrcweir objOleTest.testinout_methodXInterface2(retXInterface) 336cdf0e10cSrcweir 337cdf0e10cSrcweir If outByte <> retByte Or outBool <> retBool Or outShort <> retShort _ 338cdf0e10cSrcweir Or outUShort <> retUShort Or outLong <> retLong Or outULong <> retULong _ 339cdf0e10cSrcweir Or outHyper <> retHyper Or outUHyper <> outUHyper _ 340cdf0e10cSrcweir Or outFloat <> retFloat Or outDouble <> retDouble _ 341cdf0e10cSrcweir Or outString <> retString Or outChar <> retChar _ 342cdf0e10cSrcweir Or outCharAsString <> retCharAsString _ 343cdf0e10cSrcweir Or outAny <> retAny Or Not (outType.Name = retType.Name) _ 344cdf0e10cSrcweir Or outXInterface IsNot retXInterface Then 345cdf0e10cSrcweir sError = "in/out - parameter test failed!" 346cdf0e10cSrcweir MsgBox(sError) 347cdf0e10cSrcweir End If 348cdf0e10cSrcweir 349cdf0e10cSrcweir 'Attributes 350cdf0e10cSrcweir objOleTest.AByte = inByte 351cdf0e10cSrcweir retByte = 0 352cdf0e10cSrcweir retByte = objOleTest.AByte 353cdf0e10cSrcweir objOleTest.AFloat = inFloat 354cdf0e10cSrcweir retFloat = 0 355cdf0e10cSrcweir retFloat = objOleTest.AFloat 356cdf0e10cSrcweir objOleTest.AType = inType 357cdf0e10cSrcweir retType = Nothing 358cdf0e10cSrcweir 359cdf0e10cSrcweir retType = objOleTest.AType 360cdf0e10cSrcweir 361cdf0e10cSrcweir If inByte <> retByte Or inFloat <> retFloat Or Not (inType.Name = retType.Name) Then 362cdf0e10cSrcweir sError = "Attributes - test failed!" 363cdf0e10cSrcweir MsgBox(sError) 364cdf0e10cSrcweir End If 365cdf0e10cSrcweir 366cdf0e10cSrcweir End Function 367cdf0e10cSrcweir Function testHyper() As Object 368cdf0e10cSrcweir 369cdf0e10cSrcweir '====================================================================== 370cdf0e10cSrcweir ' Other Hyper tests 371cdf0e10cSrcweir Dim emptyVar As Object 372cdf0e10cSrcweir Dim retAny As Object 373cdf0e10cSrcweir 374cdf0e10cSrcweir retAny = emptyVar 375cdf0e10cSrcweir inHyper = CDec("9223372036854775807") 'highest positiv value of int64 376cdf0e10cSrcweir retAny = objOleTest.in_methodAny(inHyper) 377cdf0e10cSrcweir sError = "hyper test failed" 378cdf0e10cSrcweir If inHyper <> retAny Then 379cdf0e10cSrcweir MsgBox(sError) 380cdf0e10cSrcweir End If 381cdf0e10cSrcweir inHyper = CDec("-9223372036854775808") 'lowest negativ value of int64 382cdf0e10cSrcweir retAny = objOleTest.in_methodAny(inHyper) 383cdf0e10cSrcweir 384cdf0e10cSrcweir If inHyper <> retAny Then 385cdf0e10cSrcweir MsgBox(sError) 386cdf0e10cSrcweir End If 387cdf0e10cSrcweir inHyper = CDec("18446744073709551615") 'highest positiv value of unsigne int64 388cdf0e10cSrcweir retAny = objOleTest.in_methodAny(inHyper) 389cdf0e10cSrcweir 390cdf0e10cSrcweir If inHyper <> retAny Then 391cdf0e10cSrcweir MsgBox(sError) 392cdf0e10cSrcweir End If 393cdf0e10cSrcweir inHyper = CDec(-1) 394cdf0e10cSrcweir retAny = objOleTest.in_methodAny(inHyper) 395cdf0e10cSrcweir If inHyper <> retAny Then 396cdf0e10cSrcweir MsgBox(sError) 397cdf0e10cSrcweir End If 398cdf0e10cSrcweir inHyper = CDec(0) 399cdf0e10cSrcweir retAny = objOleTest.in_methodAny(inHyper) 400cdf0e10cSrcweir If inHyper <> retAny Then 401cdf0e10cSrcweir MsgBox(sError) 402cdf0e10cSrcweir End If 403cdf0e10cSrcweir 404cdf0e10cSrcweir '============================================================================== 405cdf0e10cSrcweir 406cdf0e10cSrcweir 407cdf0e10cSrcweir End Function 408cdf0e10cSrcweir Function testAny() As Object 409cdf0e10cSrcweir Dim outVAr As Object 410cdf0e10cSrcweir 411cdf0e10cSrcweir 'Any test. We pass in an any as value object. If it is not correct converted 412cdf0e10cSrcweir 'then the target component throws a RuntimeException 413cdf0e10cSrcweir Dim lengthInAny As Integer 414cdf0e10cSrcweir 415cdf0e10cSrcweir lengthInAny = 10 416cdf0e10cSrcweir Dim seqLongInAny(10) As Integer 417cdf0e10cSrcweir For i = 0 To lengthInAny - 1 418cdf0e10cSrcweir seqLongInAny(i) = i + 10 419cdf0e10cSrcweir Next 420cdf0e10cSrcweir Dim anySeqLong As Object 421cdf0e10cSrcweir anySeqLong = objOleTest.Bridge_GetValueObject() 422cdf0e10cSrcweir anySeqLong.Set("[]long", seqLongInAny) 423cdf0e10cSrcweir Dim anySeqRet As Object 424cdf0e10cSrcweir Err.Clear() 425cdf0e10cSrcweir On Error Resume Next 426cdf0e10cSrcweir anySeqRet = objOleTest.other_methodAny(anySeqLong, "[]long") 427cdf0e10cSrcweir 428cdf0e10cSrcweir If Err.Number <> 0 Then 429cdf0e10cSrcweir MsgBox("error") 430cdf0e10cSrcweir End If 431cdf0e10cSrcweir End Function 432cdf0e10cSrcweir 433cdf0e10cSrcweir Function testObjects() As Object 434cdf0e10cSrcweir ' COM obj 435cdf0e10cSrcweir Dim outVAr As Object 436cdf0e10cSrcweir Dim retObj As Object 437cdf0e10cSrcweir 'OleTest receives a COM object that implements XEventListener 438cdf0e10cSrcweir 'OleTest then calls a disposing on the object. The object then will be 439cdf0e10cSrcweir 'asked if it has been called 440cdf0e10cSrcweir objEventListener.setQuiet(True) 441cdf0e10cSrcweir objEventListener.resetDisposing() 442cdf0e10cSrcweir retObj = objOleTest.in_methodInvocation(objEventListener) 443cdf0e10cSrcweir Dim ret As Object 444cdf0e10cSrcweir ret = objEventListener.disposingCalled 445cdf0e10cSrcweir If ret = False Then 446cdf0e10cSrcweir MsgBox("Error") 447cdf0e10cSrcweir End If 448cdf0e10cSrcweir 449cdf0e10cSrcweir 'The returned object should be objEventListener, test it by calling disposing 450cdf0e10cSrcweir ' takes an IDispatch as Param ( EventObject).To provide a TypeMismatch 451cdf0e10cSrcweir 'we put in another IDispatch 452cdf0e10cSrcweir retObj.resetDisposing() 453cdf0e10cSrcweir retObj.disposing(objEventListener) 454cdf0e10cSrcweir If retObj.disposingCalled = False Then 455cdf0e10cSrcweir MsgBox("Error") 456cdf0e10cSrcweir End If 457cdf0e10cSrcweir 458cdf0e10cSrcweir ' out param gives out the OleTestComponent 459cdf0e10cSrcweir 'objOleTest.testout_methodXInterface retObj 460cdf0e10cSrcweir 'outVAr = Null 461cdf0e10cSrcweir 'retObj.testout_methodAny outVAr 462cdf0e10cSrcweir 'Debug.Print "test out Interface " & CStr(outVAr) 463cdf0e10cSrcweir 'If outVAr <> "I am a string in an any" Then 464cdf0e10cSrcweir ' MsgBox "error" 465cdf0e10cSrcweir 'End If 466cdf0e10cSrcweir 467cdf0e10cSrcweir 468cdf0e10cSrcweir 'in out 469cdf0e10cSrcweir ' in: UNO object, the same is expected as out param 470cdf0e10cSrcweir ' the function expects OleTest as parameter and sets a value 471cdf0e10cSrcweir 472cdf0e10cSrcweir Dim myAny As Object 473cdf0e10cSrcweir 474cdf0e10cSrcweir 475cdf0e10cSrcweir 476cdf0e10cSrcweir Dim objOleTest2 As Object 477cdf0e10cSrcweir objOleTest2 = objServiceManager.createInstance("oletest.OleTest") 478cdf0e10cSrcweir 'Set a value 479cdf0e10cSrcweir objOleTest2.AttrAny2 = "VBString " 480cdf0e10cSrcweir 481cdf0e10cSrcweir 'testinout_methodXInterfaces substitutes the argument with the object set in in_methodXInterface 482cdf0e10cSrcweir objOleTest.AttrAny2 = "VBString this string was written in the UNO component to the inout pararmeter" 483cdf0e10cSrcweir objOleTest.in_methodXInterface(objOleTest) 484cdf0e10cSrcweir objOleTest.testinout_methodXInterface2(objOleTest2) 485cdf0e10cSrcweir Dim tmpVar As Object 486cdf0e10cSrcweir tmpVar = System.DBNull.Value 487cdf0e10cSrcweir tmpVar = objOleTest2.AttrAny2 488cdf0e10cSrcweir Debug.Print("in: Uno out: the same object // " & CStr(tmpVar)) 489cdf0e10cSrcweir If tmpVar <> "VBString this string was written in the UNO component to the inout pararmeter" Then 490cdf0e10cSrcweir MsgBox("error") 491cdf0e10cSrcweir End If 492cdf0e10cSrcweir 493cdf0e10cSrcweir 494cdf0e10cSrcweir 'create a struct 495cdf0e10cSrcweir Dim structClass As Object 496cdf0e10cSrcweir structClass = objCoreReflection.forName("oletest.SimpleStruct") 497cdf0e10cSrcweir Dim structInstance As Object 498cdf0e10cSrcweir structClass.CreateObject(structInstance) 499cdf0e10cSrcweir structInstance.message = "Now we are in VB" 500cdf0e10cSrcweir Debug.Print("struct out " & structInstance.message) 501cdf0e10cSrcweir If structInstance.message <> "Now we are in VB" Then 502cdf0e10cSrcweir MsgBox("error") 503cdf0e10cSrcweir End If 504cdf0e10cSrcweir 505cdf0e10cSrcweir 'put the struct into OleTest. The same struct will be returned with an added String 506cdf0e10cSrcweir Dim structRet As Object 507cdf0e10cSrcweir structRet = objOleTest.in_methodStruct(structInstance) 508cdf0e10cSrcweir Debug.Print("struct in - return " & structRet.message) 509cdf0e10cSrcweir If structRet.message <> "Now we are in VBThis string was set in OleTest" Then 510cdf0e10cSrcweir MsgBox("error") 511cdf0e10cSrcweir End If 512cdf0e10cSrcweir 513cdf0e10cSrcweir 514cdf0e10cSrcweir End Function 515cdf0e10cSrcweir Function testGetStruct() As Object 516cdf0e10cSrcweir 'Bridge_GetStruct 517cdf0e10cSrcweir '======================================================== 518cdf0e10cSrcweir Dim objDocument As Object 519cdf0e10cSrcweir objDocument = createHiddenDocument() 520cdf0e10cSrcweir 'dispose not working i103353 521cdf0e10cSrcweir 'objDocument.dispose() 522cdf0e10cSrcweir objDocument.close(True) 523cdf0e10cSrcweir End Function 524cdf0e10cSrcweir 525cdf0e10cSrcweir Function testImplementedInterfaces() As Object 526cdf0e10cSrcweir 'Bridge_ImplementedInterfaces 527cdf0e10cSrcweir '================================================= 528cdf0e10cSrcweir ' call an UNO function that takes an XEventListener interface 529cdf0e10cSrcweir 'We provide a COM implementation (IDispatch) as EventListener 530cdf0e10cSrcweir 'Open a new empty writer document 531cdf0e10cSrcweir 532cdf0e10cSrcweir Dim objDocument As Object 533cdf0e10cSrcweir objDocument = createHiddenDocument() 534cdf0e10cSrcweir objEventListener.resetDisposing() 535cdf0e10cSrcweir objDocument.addEventListener(objEventListener) 536cdf0e10cSrcweir objDocument.dispose() 537cdf0e10cSrcweir If objEventListener.disposingCalled = False Then 538cdf0e10cSrcweir MsgBox("Error") 539cdf0e10cSrcweir End If 540cdf0e10cSrcweir End Function 541cdf0e10cSrcweir 542cdf0e10cSrcweir Function testGetValueObject() As Object 543cdf0e10cSrcweir 'Bridge_GetValueObject 544cdf0e10cSrcweir '================================================== 545cdf0e10cSrcweir Dim objVal As Object 546cdf0e10cSrcweir objVal = objOleTest.Bridge_GetValueObject() 547cdf0e10cSrcweir Dim arrByte(9) As Byte 548cdf0e10cSrcweir Dim countvar As Integer 549cdf0e10cSrcweir For countvar = 0 To 9 550cdf0e10cSrcweir arrByte(countvar) = countvar 551cdf0e10cSrcweir Next countvar 552cdf0e10cSrcweir 553cdf0e10cSrcweir objVal.Set("[]byte", arrByte) 554cdf0e10cSrcweir Dim ret As Object 555cdf0e10cSrcweir ret = 0 556cdf0e10cSrcweir ret = objOleTest.methodByte(objVal) 557cdf0e10cSrcweir 'Test if ret is the same array 558cdf0e10cSrcweir 559cdf0e10cSrcweir Dim key As Object 560cdf0e10cSrcweir key = 0 561cdf0e10cSrcweir For Each key In ret 562cdf0e10cSrcweir If ret(key) <> arrByte(key) Then 563cdf0e10cSrcweir MsgBox("Error") 564cdf0e10cSrcweir End If 565cdf0e10cSrcweir Debug.Print(ret(key)) 566cdf0e10cSrcweir Next key 567cdf0e10cSrcweir 568cdf0e10cSrcweir Dim outByte As Byte 569cdf0e10cSrcweir outByte = 77 570cdf0e10cSrcweir Dim retByte As Byte 571cdf0e10cSrcweir retByte = outByte 572cdf0e10cSrcweir objVal.InitInOutParam("byte", retByte) 573cdf0e10cSrcweir objOleTest.testinout_methodByte(objVal) 574cdf0e10cSrcweir objVal.InitInOutParam("byte", retByte) 575cdf0e10cSrcweir objOleTest.testinout_methodByte(objVal) 576cdf0e10cSrcweir 577cdf0e10cSrcweir ret = 0 578cdf0e10cSrcweir ret = objVal.Get() 579cdf0e10cSrcweir Debug.Print(ret) 580cdf0e10cSrcweir If ret <> outByte Then 581cdf0e10cSrcweir MsgBox("error") 582cdf0e10cSrcweir End If 583cdf0e10cSrcweir 584cdf0e10cSrcweir objVal.InitOutParam() 585cdf0e10cSrcweir Dim inChar As Short 586cdf0e10cSrcweir inChar = 65 587cdf0e10cSrcweir objOleTest.in_methodChar(inChar) 588cdf0e10cSrcweir objOleTest.testout_methodChar(objVal) 'Returns 'A' (65) 589cdf0e10cSrcweir ret = 0 590cdf0e10cSrcweir ret = objVal.Get() 591cdf0e10cSrcweir Debug.Print(ret) 592cdf0e10cSrcweir If ret <> inChar Then 593cdf0e10cSrcweir MsgBox("error") 594cdf0e10cSrcweir End If 595cdf0e10cSrcweir 596cdf0e10cSrcweir End Function 597cdf0e10cSrcweir 598cdf0e10cSrcweir Function testArrays() As Object 599cdf0e10cSrcweir 'Arrays 600cdf0e10cSrcweir '======================================== 601cdf0e10cSrcweir Dim arrLong(2) As Integer 602cdf0e10cSrcweir Dim arrObj(2) As Object 603cdf0e10cSrcweir Dim countvar As Integer 604cdf0e10cSrcweir For countvar = 0 To 2 605cdf0e10cSrcweir arrLong(countvar) = countvar + 10 606cdf0e10cSrcweir Debug.Print(countvar) 607cdf0e10cSrcweir arrObj(countvar) = CreateObject("VBasicEventListener.VBEventListener") 608cdf0e10cSrcweir arrObj(countvar).setQuiet(True) 609cdf0e10cSrcweir Next 610cdf0e10cSrcweir 611cdf0e10cSrcweir 'Arrays always contain VARIANTS 612cdf0e10cSrcweir Dim seq() As Object 613cdf0e10cSrcweir seq = objOleTest.methodLong(arrLong) 614cdf0e10cSrcweir 615cdf0e10cSrcweir For countvar = 0 To 2 616cdf0e10cSrcweir Debug.Print(CStr(seq(countvar))) 617cdf0e10cSrcweir If arrLong(countvar) <> seq(countvar) Then 618cdf0e10cSrcweir MsgBox("error") 619cdf0e10cSrcweir End If 620cdf0e10cSrcweir Next 621cdf0e10cSrcweir seq = objOleTest.methodXInterface(arrObj) 622cdf0e10cSrcweir Dim tmp As Object 623cdf0e10cSrcweir For countvar = 0 To 2 624cdf0e10cSrcweir seq(countvar).resetDisposing() 625cdf0e10cSrcweir seq(countvar).disposing(CObj(tmp)) 626cdf0e10cSrcweir If seq(countvar).disposingCalled = False Then 627cdf0e10cSrcweir MsgBox("Error") 628cdf0e10cSrcweir End If 629cdf0e10cSrcweir Next 630cdf0e10cSrcweir 631cdf0e10cSrcweir 'Array containing interfaces (element type is VT_DISPATCH) 632cdf0e10cSrcweir Dim arEventListener(2) As Object 633cdf0e10cSrcweir For countvar = 0 To 2 634cdf0e10cSrcweir arEventListener(countvar) = CreateObject("VBasicEventListener.VBEventListener") 635cdf0e10cSrcweir arEventListener(countvar).setQuiet(True) 636cdf0e10cSrcweir Next 637cdf0e10cSrcweir 638cdf0e10cSrcweir 'The function calls disposing on the listeners 639cdf0e10cSrcweir seq = objOleTest.methodXEventListeners(arEventListener) 640cdf0e10cSrcweir Dim count As Object 641cdf0e10cSrcweir For countvar = 0 To 2 642cdf0e10cSrcweir If arEventListener(countvar).disposingCalled = False Then 643cdf0e10cSrcweir MsgBox("Error") 644cdf0e10cSrcweir End If 645cdf0e10cSrcweir Next 646cdf0e10cSrcweir 'Array containing interfaces (element type is VT_VARIANT which contains VT_DISPATCH 647cdf0e10cSrcweir Dim arEventListener2(2) As Object 648cdf0e10cSrcweir For countvar = 0 To 2 649cdf0e10cSrcweir arEventListener2(countvar) = CreateObject("VBasicEventListener.VBEventListener") 650cdf0e10cSrcweir arEventListener2(countvar).setQuiet(True) 651cdf0e10cSrcweir Next 652cdf0e10cSrcweir seq = objOleTest.methodXEventListeners(arEventListener2) 653cdf0e10cSrcweir For countvar = 0 To 2 654cdf0e10cSrcweir If arEventListener2(countvar).disposingCalled = False Then 655cdf0e10cSrcweir MsgBox("Error") 656cdf0e10cSrcweir End If 657cdf0e10cSrcweir Next 658cdf0e10cSrcweir 659cdf0e10cSrcweir 'Variant containing Array containing interfaces (element type is VT_VARIANT which contains VT_DISPATCH 660cdf0e10cSrcweir Dim arEventListener3(2) As Object 661cdf0e10cSrcweir Dim var As Object 662cdf0e10cSrcweir For countvar = 0 To 2 663cdf0e10cSrcweir arEventListener3(countvar) = CreateObject("VBasicEventListener.VBEventListener") 664cdf0e10cSrcweir arEventListener3(countvar).setQuiet(True) 665cdf0e10cSrcweir Next 666cdf0e10cSrcweir Dim varContAr As Object 667cdf0e10cSrcweir varContAr = VB6.CopyArray(arEventListener3) 668cdf0e10cSrcweir seq = objOleTest.methodXEventListeners(varContAr) 669cdf0e10cSrcweir For countvar = 0 To 2 670cdf0e10cSrcweir If arEventListener3(countvar).disposingCalled = False Then 671cdf0e10cSrcweir MsgBox("Error") 672cdf0e10cSrcweir End If 673cdf0e10cSrcweir Next 674cdf0e10cSrcweir 675cdf0e10cSrcweir 'Get a sequence created in UNO, out param is Variant ( VT_BYREF|VT_VARIANT) 676cdf0e10cSrcweir Dim seqX As Object 677cdf0e10cSrcweir 678cdf0e10cSrcweir objOleTest.testout_methodSequence(seqX) 679cdf0e10cSrcweir Dim key As Object 680cdf0e10cSrcweir For Each key In seqX 681cdf0e10cSrcweir Debug.Print(CStr(seqX(key))) 682cdf0e10cSrcweir If seqX(key) <> key Then 683cdf0e10cSrcweir MsgBox("error") 684cdf0e10cSrcweir End If 685cdf0e10cSrcweir Next key 686cdf0e10cSrcweir 'Get a sequence created in UNO, out param is array Variant ( VT_BYREF|VT_VARIANT|VT_ARRAY) 687cdf0e10cSrcweir Dim seqX2() As Object 688cdf0e10cSrcweir objOleTest.testout_methodSequence(seqX2) 689cdf0e10cSrcweir 690cdf0e10cSrcweir For Each key In seqX2 691cdf0e10cSrcweir Debug.Print(CStr(seqX2(key))) 692cdf0e10cSrcweir Next key 693cdf0e10cSrcweir 694cdf0e10cSrcweir 'pass it to UNO and get it back 695cdf0e10cSrcweir Dim seq7() As Object 696cdf0e10cSrcweir seq7 = objOleTest.methodLong(seqX) 697cdf0e10cSrcweir Dim key2 As Object 698cdf0e10cSrcweir For Each key2 In seq7 699cdf0e10cSrcweir Debug.Print(CStr(seq7(key2))) 700cdf0e10cSrcweir If seqX2(key) <> key Then 701cdf0e10cSrcweir MsgBox("error") 702cdf0e10cSrcweir End If 703cdf0e10cSrcweir Next key2 704cdf0e10cSrcweir 705cdf0e10cSrcweir 'array with starting index != 0 706cdf0e10cSrcweir Dim seqIndex(2) As Integer 707cdf0e10cSrcweir Dim seq8() As Object 708cdf0e10cSrcweir Dim longVal1, longVal2 As Integer 709cdf0e10cSrcweir longVal1 = 1 710cdf0e10cSrcweir longVal2 = 2 711cdf0e10cSrcweir seqIndex(1) = longVal1 712cdf0e10cSrcweir seqIndex(2) = longVal2 713cdf0e10cSrcweir 'The bridge returns a Safearray of Variants. It does not yet convert to an _ 714cdf0e10cSrcweir 'array of a particular type! 715cdf0e10cSrcweir 'Comparing of elements from seq8 (Object) with long values worked without _ 716cdf0e10cSrcweir 'explicit cast as is necessary in VS 2008. Also arrays in VS 2008 start at _ 717cdf0e10cSrcweir 'index 0 718cdf0e10cSrcweir seq8 = objOleTest.methodLong(seqIndex) 719cdf0e10cSrcweir If longVal1 <> CInt(seq8(1)) And longVal2 <> CInt(seq8(2)) Then 720cdf0e10cSrcweir MsgBox("error") 721cdf0e10cSrcweir End If 722cdf0e10cSrcweir 723cdf0e10cSrcweir 'in out Array 724cdf0e10cSrcweir ' arrLong is Long Array 725cdf0e10cSrcweir Dim inoutVar(2) As Object 726cdf0e10cSrcweir 727cdf0e10cSrcweir For countvar = 0 To 2 728cdf0e10cSrcweir inoutVar(countvar) = countvar + 10 729cdf0e10cSrcweir Next 730cdf0e10cSrcweir 731cdf0e10cSrcweir objOleTest.testinout_methodSequence(inoutVar) 732cdf0e10cSrcweir 733cdf0e10cSrcweir countvar = 0 734cdf0e10cSrcweir For countvar = 0 To 2 735cdf0e10cSrcweir Debug.Print(CStr(inoutVar(countvar))) 736cdf0e10cSrcweir If inoutVar(countvar) <> countvar + 11 Then 737cdf0e10cSrcweir MsgBox("error") 738cdf0e10cSrcweir End If 739cdf0e10cSrcweir Next 740cdf0e10cSrcweir 741cdf0e10cSrcweir 'Multidimensional array 742cdf0e10cSrcweir '============================================================ 743cdf0e10cSrcweir ' Sequence< Sequence<long> > methodSequence( Sequence< Sequence long> >) 744cdf0e10cSrcweir ' Real multidimensional array Array 745cdf0e10cSrcweir ' 9 is Dim 1 (least significant) with C API 746cdf0e10cSrcweir Dim mulAr(9, 1) As Integer 747cdf0e10cSrcweir For i = 0 To 1 748cdf0e10cSrcweir For j = 0 To 9 749cdf0e10cSrcweir mulAr(j, i) = i * 10 + j 750cdf0e10cSrcweir Next j 751cdf0e10cSrcweir Next i 752cdf0e10cSrcweir 753cdf0e10cSrcweir Dim resMul As Object 754cdf0e10cSrcweir resMul = objOleTest.methodSequence(mulAr) 755cdf0e10cSrcweir 756cdf0e10cSrcweir Dim countDim1 As Integer 757cdf0e10cSrcweir Dim countDim2 As Integer 758cdf0e10cSrcweir Dim arr As Object 759cdf0e10cSrcweir For countDim2 = 0 To 1 760cdf0e10cSrcweir arr = resMul(countDim2) 761cdf0e10cSrcweir For countDim1 = 0 To 9 762cdf0e10cSrcweir Debug.Print(arr(countDim1)) 763cdf0e10cSrcweir If arr(countDim1) <> mulAr(countDim1, countDim2) Then 764cdf0e10cSrcweir MsgBox("Error Multidimensional Array") 765cdf0e10cSrcweir End If 766cdf0e10cSrcweir Next countDim1 767cdf0e10cSrcweir Next countDim2 768cdf0e10cSrcweir IsArray(resMul) 769cdf0e10cSrcweir 770cdf0e10cSrcweir 'Array of VARIANTs containing arrays 771cdf0e10cSrcweir Dim mulAr2(1) As Object 772cdf0e10cSrcweir Dim arr2(9) As Integer 773cdf0e10cSrcweir For i = 0 To 1 774cdf0e10cSrcweir ' Dim arr(9) As Long 775cdf0e10cSrcweir For j = 0 To 9 776cdf0e10cSrcweir arr2(j) = i * 10 + j 777cdf0e10cSrcweir Next j 778cdf0e10cSrcweir mulAr2(i) = VB6.CopyArray(arr2) 779cdf0e10cSrcweir Next i 780cdf0e10cSrcweir 781cdf0e10cSrcweir resMul = 0 782cdf0e10cSrcweir resMul = objOleTest.methodSequence(mulAr2) 783cdf0e10cSrcweir arr = 0 784cdf0e10cSrcweir Dim tmpVar As Object 785cdf0e10cSrcweir For countDim2 = 0 To 1 786cdf0e10cSrcweir arr = resMul(countDim2) 787cdf0e10cSrcweir tmpVar = mulAr2(countDim2) 788cdf0e10cSrcweir For countDim1 = 0 To 9 789cdf0e10cSrcweir Debug.Print(arr(countDim1)) 790cdf0e10cSrcweir If arr(countDim1) <> tmpVar(countDim1) Then 791cdf0e10cSrcweir MsgBox("Error Multidimensional Array") 792cdf0e10cSrcweir End If 793cdf0e10cSrcweir Next countDim1 794cdf0e10cSrcweir Next countDim2 795cdf0e10cSrcweir 796cdf0e10cSrcweir 'Array containing interfaces (element type is VT_DISPATCH) 797cdf0e10cSrcweir Dim arArEventListener(1, 2) As Object 798cdf0e10cSrcweir For i = 0 To 1 799cdf0e10cSrcweir For j = 0 To 2 800cdf0e10cSrcweir arArEventListener(i, j) = CreateObject("VBasicEventListener.VBEventListener") 801cdf0e10cSrcweir arArEventListener(i, j).setQuiet(True) 802cdf0e10cSrcweir Next 803cdf0e10cSrcweir Next 804cdf0e10cSrcweir 'The function calls disposing on the listeners 805cdf0e10cSrcweir seq = objOleTest.methodXEventListenersMul(arArEventListener) 806cdf0e10cSrcweir For i = 0 To 1 807cdf0e10cSrcweir For j = 0 To 2 808cdf0e10cSrcweir If arArEventListener(i, j).disposingCalled = False Then 809cdf0e10cSrcweir MsgBox("Error") 810cdf0e10cSrcweir End If 811cdf0e10cSrcweir Next 812cdf0e10cSrcweir Next 813cdf0e10cSrcweir 814cdf0e10cSrcweir 'Array containing interfaces (element type is VT_VARIANT containing VT_DISPATCH) 815cdf0e10cSrcweir Dim arArEventListener2(1, 2) As Object 816cdf0e10cSrcweir For i = 0 To 1 817cdf0e10cSrcweir For j = 0 To 2 818cdf0e10cSrcweir arArEventListener2(i, j) = CreateObject("VBasicEventListener.VBEventListener") 819cdf0e10cSrcweir arArEventListener2(i, j).setQuiet(True) 820cdf0e10cSrcweir Next 821cdf0e10cSrcweir Next 822cdf0e10cSrcweir 'The function calls disposing on the listeners 823cdf0e10cSrcweir seq = objOleTest.methodXEventListenersMul(arArEventListener2) 824cdf0e10cSrcweir For i = 0 To 1 825cdf0e10cSrcweir For j = 0 To 2 826cdf0e10cSrcweir If arArEventListener2(i, j).disposingCalled = False Then 827cdf0e10cSrcweir MsgBox("Error") 828cdf0e10cSrcweir End If 829cdf0e10cSrcweir Next 830cdf0e10cSrcweir Next 831cdf0e10cSrcweir 832cdf0e10cSrcweir ' SAFEARRAY of VARIANTS containing SAFEARRAYs 833cdf0e10cSrcweir 'The ultimate element type is VT_DISPATCH ( XEventListener) 834cdf0e10cSrcweir Dim arEventListener4(1) As Object 835cdf0e10cSrcweir Dim seq1(2) As Object 836cdf0e10cSrcweir Dim seq2(2) As Object 837cdf0e10cSrcweir For i = 0 To 2 838cdf0e10cSrcweir seq1(i) = CreateObject("VBasicEventListener.VBEventListener") 839cdf0e10cSrcweir seq2(i) = CreateObject("VBasicEventListener.VBEventListener") 840cdf0e10cSrcweir seq1(i).setQuiet(True) 841cdf0e10cSrcweir seq2(i).setQuiet(True) 842cdf0e10cSrcweir Next 843cdf0e10cSrcweir arEventListener4(0) = VB6.CopyArray(seq1) 844cdf0e10cSrcweir arEventListener4(1) = VB6.CopyArray(seq2) 845cdf0e10cSrcweir 'The function calls disposing on the listeners 846cdf0e10cSrcweir seq = objOleTest.methodXEventListenersMul(arEventListener4) 847cdf0e10cSrcweir For i = 0 To 2 848cdf0e10cSrcweir If seq1(i).disposingCalled = False Or seq2(i).disposingCalled = False Then 849cdf0e10cSrcweir MsgBox("Error") 850cdf0e10cSrcweir End If 851cdf0e10cSrcweir Next 852cdf0e10cSrcweir 853cdf0e10cSrcweir End Function 854cdf0e10cSrcweir 855cdf0e10cSrcweir Function createHiddenDocument() As Object 856cdf0e10cSrcweir 'Try to create a hidden document 857cdf0e10cSrcweir Dim objPropValue As Object 858cdf0e10cSrcweir objPropValue = objOleTest.Bridge_GetStruct("com.sun.star.beans.PropertyValue") 859cdf0e10cSrcweir 'Set the members. If this fails then there is an Error 860cdf0e10cSrcweir objPropValue.Name = "Hidden" 861cdf0e10cSrcweir objPropValue.Handle = -1 862cdf0e10cSrcweir objPropValue.Value = True 863cdf0e10cSrcweir 864cdf0e10cSrcweir 'create a hidden document 865cdf0e10cSrcweir 'Create the Desktop 866cdf0e10cSrcweir Dim objDesktop As Object 867cdf0e10cSrcweir objDesktop = objServiceManager.createInstance("com.sun.star.frame.Desktop") 868cdf0e10cSrcweir 'Open a new empty writer document 869cdf0e10cSrcweir Dim args(0) As Object 870cdf0e10cSrcweir args(0) = objPropValue 871cdf0e10cSrcweir createHiddenDocument = objDesktop.loadComponentFromURL("private:factory/swriter", "_blank", 0, args) 872cdf0e10cSrcweir End Function 873cdf0e10cSrcweirEnd Module 874