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