extensions/test/ole/VisualBasic/Module1.vb

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