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