Quelle  Module1.vb   Sprache: unbekannt

'
' This file is part of the LibreOffice project.
'
' This Source Code Form is subject to the terms of the Mozilla Public
' License, v. 2.0. If a copy of the MPL was not distributed with this
' file, You can obtain one at http://mozilla.org/MPL/2.0/.
'
' This file incorporates work covered by the following license notice:
'
'   Licensed to the Apache Software Foundation (ASF) under one or more
'   contributor license agreements. See the NOTICE file distributed
'   with this work for additional information regarding copyright
'   ownership. The ASF licenses this file to you under the Apache
'   License, Version 2.0 (the "License"); you may not use this file
'   except in compliance with the License. You may obtain a copy of
'   the License at http://www.apache.org/licenses/LICENSE-2.0 .
'

Option Strict Off
Option Explicit On
Module Module1

Private objServiceManager As Object
Private objCoreReflection As Object
Private objOleTest As Object
Private objEventListener As Object
'General counter
Dim i As Integer
Dim j As Integer
Dim sError As String
Dim outHyper, inHyper, retHyper As Object

Public Sub Main()
        objServiceManager = CreateObject("com.sun.star.ServiceManager")
        objCoreReflection = objServiceManager.createInstance("com.sun.star.reflection.CoreReflection")
        ' extensions/test/ole/cpnt
        objOleTest = objServiceManager.createInstance("oletest.OleTest")
        ' extensions/test/ole/EventListenerSample/VBEventListener
        objEventListener = CreateObject("VBasicEventListener.VBEventListener")
        Debug.Print(TypeName(objOleTest))


        testBasics()
        testHyper()
        testAny()
        testObjects()
        testGetStruct()
        ''dispose not working i103353
        'testImplementedInterfaces()
        testGetValueObject()
        testArrays()
        testProps()

    End Sub
 Function testProps() As Object

  Dim aToolbarItemProp1 As Object
        aToolbarItemProp1 = objOleTest.Bridge_GetStruct("com.sun.star.beans.PropertyValue")
  Dim aToolbarItemProp2 As Object
        aToolbarItemProp2 = objOleTest.Bridge_GetStruct("com.sun.star.beans.PropertyValue")
  Dim aToolbarItemProp3 As Object
        aToolbarItemProp3 = objOleTest.Bridge_GetStruct("com.sun.star.beans.PropertyValue")
  Dim properties(2) As Object

        aToolbarItemProp1.Name = "CommandURL"
        aToolbarItemProp1.Value = "macro:///standard.module1.TestIt"
        aToolbarItemProp2.Name = "Label"
        aToolbarItemProp2.Value = "Test"
        aToolbarItemProp3.Name = "Type"
        aToolbarItemProp3.Value = 0

  properties(0) = aToolbarItemProp1
  properties(1) = aToolbarItemProp2
  properties(2) = aToolbarItemProp3


        Dim dummy(-1) As Object
        
        Dim Desktop As Object
        Desktop = objServiceManager.createInstance("com.sun.star.frame.Desktop")
  Dim Doc As Object
        Doc = Desktop.loadComponentFromURL("private:factory/swriter", "_blank", 2, dummy)
  Dim LayoutManager As Object
        LayoutManager = Doc.currentController.Frame.LayoutManager

        LayoutManager.createElement("private:resource/toolbar/user_toolbar1")
        LayoutManager.showElement("private:resource/toolbar/user_toolbar1")
  Dim ToolBar As Object
        ToolBar = LayoutManager.getElement("private:resource/toolbar/user_toolbar1")
  Dim settings As Object
        settings = ToolBar.getSettings(True)

  'the changes are here:
  Dim aany As Object
        aany = objServiceManager.Bridge_GetValueObject()
        Call aany.Set("[]com.sun.star.beans.PropertyValue", properties)
        Call settings.insertByIndex(0, aany)
        Call ToolBar.setSettings(settings)


 End Function


 Function testBasics() As Object
  ' In Parameter, simple types
  '============================================
  Dim tmpVar As Object
  Dim ret As Object
  Dim outByte, inByte, retByte As Byte
  Dim outBool, inBool, retBool As Boolean
  Dim outShort, inShort, retShort As Short
  Dim outUShort, inUShort, retUShort As Short
  Dim outLong, inLong, retLong As Integer
  Dim outULong, inULong, retULong As Integer
  Dim outHyper, inHyper, retHyper As Object
  Dim outUHyper, inUHyper, retUHyper As Object
  Dim outFloat, inFloat, retFloat As Single
  Dim outDouble, inDouble, retDouble As Double
  Dim outString, inString, retString As String
  Dim retChar, inChar, outChar, retChar2 As Short
  Dim outCharAsString, inCharAsString, retCharAsString As String
  Dim outAny, inAny, retAny As Object
  Dim outType, inType, retType As Object
  Dim outXInterface, inXInterface, retXInterface As Object
  Dim outXInterface2, inXInterface2, retXInterface2 As Object


  Dim outVarByte As Object
  Dim outVarBool As Object
  Dim outVarShort As Object
  Dim outVarUShort As Object
  Dim outVarLong As Object
  Dim outVarULong As Object
  Dim outVarFloat As Object
  Dim outVarDouble As Object
  Dim outVarString As Object
  Dim outVarChar As Object
  Dim outVarAny As Object
  Dim outVarType As Object

  inByte = 10
  inBool = True
  inShort = -10
  inUShort = -100
  inLong = -1000
        inHyper = CDec("-9223372036854775808") 'lowest int64
        inUHyper = CDec("18446744073709551615") ' highest unsigned int64
  inULong = 10000
  inFloat = 3.14
  inDouble = 3.14
  inString = "Hello World!"
  inChar = 65
  inCharAsString = "A"
        inAny = "Hello World"
        inType = objServiceManager.Bridge_CreateType("[]long")
  inXInterface = objCoreReflection
  inXInterface2 = objEventListener

        retByte = objOleTest.in_methodByte(inByte)
        retBool = objOleTest.in_methodBool(inBool)
        retShort = objOleTest.in_methodShort(inShort)
        retUShort = objOleTest.in_methodUShort(inUShort)
        retLong = objOleTest.in_methodLong(inLong)
        retULong = objOleTest.in_methodULong(inULong)
        retHyper = objOleTest.in_methodHyper(inHyper)
        retUHyper = objOleTest.in_methodUHyper(inUHyper)
        retFloat = objOleTest.in_methodFloat(inFloat)
        retDouble = objOleTest.in_methodDouble(inDouble)
        retString = objOleTest.in_methodString(inString)
        retChar = objOleTest.in_methodChar(inChar)
        retChar2 = objOleTest.in_methodChar(inCharAsString)
        retAny = objOleTest.in_methodAny(inAny)
        retType = objOleTest.in_methodType(inType)
        retXInterface = objOleTest.in_methodXInterface(inXInterface) ' UNO object
        retXInterface2 = objOleTest.in_methodXInterface(inXInterface2)

        If retByte <> inByte Or retBool <> inBool Or retShort <> inShort Or retUShort <> inUShort _
            Or retLong <> inLong Or retULong <> inULong Or retHyper <> inHyper _
            Or retUHyper <> inUHyper Or retFloat <> inFloat Or retDouble <> inDouble _
            Or retString <> inString Or retChar <> inChar Or retChar2 <> Asc(inCharAsString) _
            Or retAny <> inAny Or Not (retType.Name = inType.Name) _
            Or inXInterface IsNot retXInterface Or inXInterface2 IsNot retXInterface2 Then
            sError = "in - parameter and return value test failed"
            MsgBox(sError)

        End If
 
        'Out Parameter simple types
        '================================================


        objOleTest.testout_methodByte(outByte)
        objOleTest.testout_methodFloat(outFloat)
        objOleTest.testout_methodDouble(outDouble)
        objOleTest.testout_methodBool(outBool)
        objOleTest.testout_methodShort(outShort)
        objOleTest.testout_methodUShort(outUShort)
        objOleTest.testout_methodLong(outLong)
        objOleTest.testout_methodULong(outULong)
        objOleTest.testout_methodHyper(outHyper)
        objOleTest.testout_methodUHyper(outUHyper)
        objOleTest.testout_methodString(outString)
        objOleTest.testout_methodChar(outChar)
        'outCharAsString is a string. Therefore the returned sal_Unicode value of 65 will be converted
        'to a string "65"
        objOleTest.testout_methodChar(outCharAsString)
        objOleTest.testout_methodAny(outAny)
        objOleTest.testout_methodType(outType)
        'objOleTest.in_methodXInterface (inXInterface) ' UNO object
        Call objOleTest.in_methodXInterface(inXInterface) ' UNO object
        objOleTest.testout_methodXInterface(outXInterface)
        Call objOleTest.in_methodXInterface(inXInterface2) ' COM object
        objOleTest.testout_methodXInterface(outXInterface2)

        If outByte <> inByte Or outFloat <> inFloat Or outDouble <> inDouble _
            Or outBool <> inBool Or outShort <> inShort Or outUShort <> inUShort _
            Or outLong <> inLong Or outULong <> inULong Or outHyper <> inHyper _
            Or outUHyper <> inUHyper Or outString <> inString Or outChar <> inChar _
            Or Not (outCharAsString = "65") Or outAny <> inAny _
            Or Not (outType.Name = inType.Name) Or inXInterface IsNot outXInterface _
            Or inXInterface2 IsNot outXInterface2 Then

            sError = "out - parameter test failed!"
            MsgBox(sError)
        End If

        'Out Parameter simple types (VARIANT var)
        '====================================================
        objOleTest.testout_methodByte(outVarByte)
        objOleTest.testout_methodBool(outVarBool)
        objOleTest.testout_methodChar(outVarChar)
        objOleTest.testout_methodShort(outVarShort)
        objOleTest.testout_methodUShort(outVarUShort)
        objOleTest.testout_methodLong(outVarLong)
        objOleTest.testout_methodULong(outVarULong)
        objOleTest.testout_methodString(outVarString)
        objOleTest.testout_methodFloat(outVarFloat)
        objOleTest.testout_methodDouble(outVarDouble)
        objOleTest.testout_methodAny(outVarAny)
        objOleTest.testout_methodType(outVarType)

        If outVarByte <> inByte Or outVarBool <> inBool Or outVarChar <> inChar _
            Or outVarShort <> inShort Or outVarUShort <> inUShort _
            Or outVarLong <> inLong Or outVarULong <> inULong Or outVarString <> inString _
            Or outVarFloat <> inFloat Or outVarDouble <> inDouble Or outVarAny <> inAny _
            Or Not (outVarType.Name = inType.Name) Then
            sError = "out - parameter (VARIANT) test failed!"
            MsgBox(sError)
        End If

        'In/Out simple types
        '============================================
        objOleTest.in_methodByte(0)
        objOleTest.in_methodBool(False)
        objOleTest.in_methodShort(0)
        objOleTest.in_methodUShort(0)
        objOleTest.in_methodLong(0)
        objOleTest.in_methodULong(0)
        objOleTest.in_methodHyper(0)
        objOleTest.in_methodUHyper(0)
        objOleTest.in_methodFloat(0)
        objOleTest.in_methodDouble(0)
        objOleTest.in_methodString(0)
        objOleTest.in_methodChar(0)
        objOleTest.in_methodAny(0)
        objOleTest.in_methodType(objServiceManager.Bridge_CreateType("boolean"))
        outXInterface = Nothing
        Call objOleTest.in_methodXInterface(outXInterface)

        outByte = 10
        retByte = outByte
        objOleTest.testinout_methodByte(retByte)
        objOleTest.testinout_methodByte(retByte)
        outBool = True
        retBool = outBool
        objOleTest.testinout_methodBool(retBool)
        objOleTest.testinout_methodBool(retBool)
        outShort = 10
        retShort = outShort
        objOleTest.testinout_methodShort(retShort)
        objOleTest.testinout_methodShort(retShort)
        outUShort = 20
        retUShort = outUShort
        objOleTest.testinout_methodUShort(retUShort)
        objOleTest.testinout_methodUShort(retUShort)
        outLong = 30
        retLong = outLong
        objOleTest.testinout_methodLong(retLong)
        objOleTest.testinout_methodLong(retLong)
        outULong = 40
        retULong = outULong
        objOleTest.testinout_methodULong(retLong)
        objOleTest.testinout_methodULong(retLong)
        outHyper = CDec("9223372036854775807") 'highest positive value of int64
        retHyper = outHyper
        objOleTest.testinout_methodHyper(retHyper)
        objOleTest.testinout_methodHyper(retHyper)
        outUHyper = CDec("18446744073709551615") 'highest value of unsigned int64
        retUHyper = outUHyper
        objOleTest.testinout_methodUHyper(retUHyper)
        objOleTest.testinout_methodUHyper(retUHyper)
        outFloat = 3.14
        retFloat = outFloat
        objOleTest.testinout_methodFloat(retFloat)
        objOleTest.testinout_methodFloat(retFloat)
        outDouble = 4.14
        retDouble = outDouble
        objOleTest.testinout_methodDouble(retDouble)
        objOleTest.testinout_methodDouble(retDouble)
        outString = "Hello World!"
        retString = outString
        objOleTest.testinout_methodString(retString)
        objOleTest.testinout_methodString(retString)
        outChar = 66
        retChar = outChar
        objOleTest.testinout_methodChar(retChar)
        objOleTest.testinout_methodChar(retChar)
        outCharAsString = "H"
        retCharAsString = outCharAsString
        objOleTest.testinout_methodChar(retCharAsString)
        objOleTest.testinout_methodChar(retCharAsString)
        outAny = "Hello World 2!"
        retAny = outAny
        objOleTest.testinout_methodAny(retAny)
        objOleTest.testinout_methodAny(retAny)
        outType = objServiceManager.Bridge_CreateType("long")
        retType = outType
        objOleTest.testinout_methodType(retType)
        objOleTest.testinout_methodType(retType)

        outXInterface = objCoreReflection
        retXInterface = outXInterface
        objOleTest.testinout_methodXInterface2(retXInterface)

        If outByte <> retByte Or outBool <> retBool Or outShort <> retShort _
            Or outUShort <> retUShort Or outLong <> retLong Or outULong <> retULong _
            Or outHyper <> retHyper Or outUHyper <> outUHyper _
            Or outFloat <> retFloat Or outDouble <> retDouble _
            Or outString <> retString Or outChar <> retChar _
            Or outCharAsString <> retCharAsString _
            Or outAny <> retAny Or Not (outType.Name = retType.Name) _
            Or outXInterface IsNot retXInterface Then
            sError = "in/out - parameter test failed!"
            MsgBox(sError)
        End If

        'Attributes
        objOleTest.AByte = inByte
        retByte = 0
        retByte = objOleTest.AByte
        objOleTest.AFloat = inFloat
        retFloat = 0
        retFloat = objOleTest.AFloat
        objOleTest.AType = inType
        retType = Nothing

        retType = objOleTest.AType

        If inByte <> retByte Or inFloat <> retFloat Or Not (inType.Name = retType.Name) Then
            sError = "Attributes - test failed!"
            MsgBox(sError)
        End If

    End Function
 Function testHyper() As Object

  '======================================================================
  ' Other Hyper tests
  Dim emptyVar As Object
  Dim retAny As Object

  retAny = emptyVar
  inHyper = CDec("9223372036854775807") 'highest positive value of int64
  retAny = objOleTest.in_methodAny(inHyper)
  sError = "hyper test failed"
  If inHyper <> retAny Then
   MsgBox(sError)
  End If
  inHyper = CDec("-9223372036854775808") 'lowest negative value of int64
  retAny = objOleTest.in_methodAny(inHyper)

  If inHyper <> retAny Then
   MsgBox(sError)
  End If
  inHyper = CDec("18446744073709551615") 'highest positive value of unsigned int64
  retAny = objOleTest.in_methodAny(inHyper)

  If inHyper <> retAny Then
   MsgBox(sError)
  End If
  inHyper = CDec(-1)
  retAny = objOleTest.in_methodAny(inHyper)
  If inHyper <> retAny Then
   MsgBox(sError)
  End If
  inHyper = CDec(0)
  retAny = objOleTest.in_methodAny(inHyper)
  If inHyper <> retAny Then
   MsgBox(sError)
  End If

  '==============================================================================


 End Function
 Function testAny() As Object
  Dim outVAr As Object

  'Any test. We pass in an any as value object. If it is not correct converted
  'then the target component throws a RuntimeException
  Dim lengthInAny As Integer

  lengthInAny = 10
  Dim seqLongInAny(10) As Integer
  For i = 0 To lengthInAny - 1
   seqLongInAny(i) = i + 10
  Next 
  Dim anySeqLong As Object
  anySeqLong = objOleTest.Bridge_GetValueObject()
  anySeqLong.Set("[]long", seqLongInAny)
  Dim anySeqRet As Object
  Err.Clear()
  On Error Resume Next
  anySeqRet = objOleTest.other_methodAny(anySeqLong, "[]long")

  If Err.Number <> 0 Then
   MsgBox("error")
  End If
 End Function

 Function testObjects() As Object
  ' COM obj
  Dim outVAr As Object
  Dim retObj As Object
  'OleTest receives a COM object that implements XEventListener
  'OleTest then calls a disposing on the object. The object then will be
  'asked if it has been called
  objEventListener.setQuiet(True)
  objEventListener.resetDisposing()
  retObj = objOleTest.in_methodInvocation(objEventListener)
  Dim ret As Object
  ret = objEventListener.disposingCalled
  If ret = False Then
   MsgBox("Error")
  End If

  'The returned object should be objEventListener, test it by calling disposing
  ' takes an IDispatch as Param ( EventObject).To provide a TypeMismatch
  'we put in another IDispatch
  retObj.resetDisposing()
  retObj.disposing(objEventListener)
  If retObj.disposingCalled = False Then
   MsgBox("Error")
  End If

  ' out param gives out the OleTestComponent
  'objOleTest.testout_methodXInterface retObj
  'outVAr = Null
  'retObj.testout_methodAny outVAr
  'Debug.Print "test out Interface " & CStr(outVAr)
  'If outVAr <> "I am a string in an any" Then
  '    MsgBox "error"
  'End If


  'in out
  ' in: UNO object, the same is expected as out param
  ' the function expects OleTest as parameter and sets a value

  Dim myAny As Object



  Dim objOleTest2 As Object
  objOleTest2 = objServiceManager.createInstance("oletest.OleTest")
  'Set a value
  objOleTest2.AttrAny2 = "VBString "

  'testinout_methodXInterfaces substitutes the argument with the object set in in_methodXInterface
  objOleTest.AttrAny2 = "VBString  this string was written in the UNO component to the inout parameter"
  objOleTest.in_methodXInterface(objOleTest)
  objOleTest.testinout_methodXInterface2(objOleTest2)
  Dim tmpVar As Object
  tmpVar = System.DBNull.Value
  tmpVar = objOleTest2.AttrAny2
  Debug.Print("in: Uno out: the same object // " & CStr(tmpVar))
  If tmpVar <> "VBString  this string was written in the UNO component to the inout parameter" Then
   MsgBox("error")
  End If


  'create a struct
  Dim structClass As Object
  structClass = objCoreReflection.forName("oletest.SimpleStruct")
  Dim structInstance As Object
  structClass.CreateObject(structInstance)
  structInstance.message = "Now we are in VB"
  Debug.Print("struct out " & structInstance.message)
  If structInstance.message <> "Now we are in VB" Then
   MsgBox("error")
  End If

  'put the struct into OleTest. The same struct will be returned with an added String
  Dim structRet As Object
  structRet = objOleTest.in_methodStruct(structInstance)
  Debug.Print("struct in - return " & structRet.message)
  If structRet.message <> "Now we are in VBThis string was set in OleTest" Then
   MsgBox("error")
  End If


 End Function
 Function testGetStruct() As Object
  'Bridge_GetStruct
  '========================================================
  Dim objDocument As Object
        objDocument = createHiddenDocument()
        'dispose not working i103353
        'objDocument.dispose()
        objDocument.close(True)
 End Function

 Function testImplementedInterfaces() As Object
  'Bridge_ImplementedInterfaces
  '=================================================
  ' call a UNO function that takes an XEventListener interface
  'We provide a COM implementation (IDispatch) as EventListener
  'Open a new empty writer document

  Dim objDocument As Object
  objDocument = createHiddenDocument()
  objEventListener.resetDisposing()
  objDocument.addEventListener(objEventListener)
  objDocument.dispose()
  If objEventListener.disposingCalled = False Then
   MsgBox("Error")
  End If
 End Function

 Function testGetValueObject() As Object
  'Bridge_GetValueObject
  '==================================================
  Dim objVal As Object
  objVal = objOleTest.Bridge_GetValueObject()
  Dim arrByte(9) As Byte
  Dim countvar As Integer
  For countvar = 0 To 9
   arrByte(countvar) = countvar
  Next countvar

  objVal.Set("[]byte", arrByte)
  Dim ret As Object
  ret = 0
  ret = objOleTest.methodByte(objVal)
  'Test if ret is the same array

  Dim key As Object
  key = 0
  For Each key In ret
   If ret(key) <> arrByte(key) Then
    MsgBox("Error")
   End If
   Debug.Print(ret(key))
  Next key

  Dim outByte As Byte
  outByte = 77
  Dim retByte As Byte
  retByte = outByte
  objVal.InitInOutParam("byte", retByte)
  objOleTest.testinout_methodByte(objVal)
  objVal.InitInOutParam("byte", retByte)
  objOleTest.testinout_methodByte(objVal)

  ret = 0
  ret = objVal.Get()
  Debug.Print(ret)
  If ret <> outByte Then
   MsgBox("error")
  End If

  objVal.InitOutParam()
  Dim inChar As Short
  inChar = 65
  objOleTest.in_methodChar(inChar)
  objOleTest.testout_methodChar(objVal) 'Returns 'A' (65)
  ret = 0
  ret = objVal.Get()
  Debug.Print(ret)
  If ret <> inChar Then
   MsgBox("error")
  End If

 End Function

 Function testArrays() As Object
  'Arrays
  '========================================
  Dim arrLong(2) As Integer
  Dim arrObj(2) As Object
  Dim countvar As Integer
  For countvar = 0 To 2
   arrLong(countvar) = countvar + 10
   Debug.Print(countvar)
   arrObj(countvar) = CreateObject("VBasicEventListener.VBEventListener")
   arrObj(countvar).setQuiet(True)
  Next 

  'Arrays always contain VARIANTS
  Dim seq() As Object
  seq = objOleTest.methodLong(arrLong)

  For countvar = 0 To 2
   Debug.Print(CStr(seq(countvar)))
   If arrLong(countvar) <> seq(countvar) Then
    MsgBox("error")
   End If
  Next 
  seq = objOleTest.methodXInterface(arrObj)
  Dim tmp As Object
  For countvar = 0 To 2
   seq(countvar).resetDisposing()
            seq(countvar).disposing(CObj(tmp))
   If seq(countvar).disposingCalled = False Then
    MsgBox("Error")
   End If
  Next 

  'Array containing interfaces (element type is VT_DISPATCH)
  Dim arEventListener(2) As Object
  For countvar = 0 To 2
   arEventListener(countvar) = CreateObject("VBasicEventListener.VBEventListener")
   arEventListener(countvar).setQuiet(True)
  Next 

  'The function calls disposing on the listeners
  seq = objOleTest.methodXEventListeners(arEventListener)
  Dim count As Object
  For countvar = 0 To 2
   If arEventListener(countvar).disposingCalled = False Then
    MsgBox("Error")
   End If
  Next 
  'Array containing interfaces (element type is VT_VARIANT which contains VT_DISPATCH
  Dim arEventListener2(2) As Object
  For countvar = 0 To 2
   arEventListener2(countvar) = CreateObject("VBasicEventListener.VBEventListener")
   arEventListener2(countvar).setQuiet(True)
  Next 
  seq = objOleTest.methodXEventListeners(arEventListener2)
  For countvar = 0 To 2
   If arEventListener2(countvar).disposingCalled = False Then
    MsgBox("Error")
   End If
  Next 

  'Variant containing Array containing interfaces (element type is VT_VARIANT which contains VT_DISPATCH
  Dim arEventListener3(2) As Object
  Dim var As Object
  For countvar = 0 To 2
   arEventListener3(countvar) = CreateObject("VBasicEventListener.VBEventListener")
   arEventListener3(countvar).setQuiet(True)
  Next 
  Dim varContAr As Object
  varContAr = VB6.CopyArray(arEventListener3)
  seq = objOleTest.methodXEventListeners(varContAr)
  For countvar = 0 To 2
   If arEventListener3(countvar).disposingCalled = False Then
    MsgBox("Error")
   End If
  Next 

  'Get a sequence created in UNO, out param is Variant ( VT_BYREF|VT_VARIANT)
  Dim seqX As Object

  objOleTest.testout_methodSequence(seqX)
  Dim key As Object
  For Each key In seqX
   Debug.Print(CStr(seqX(key)))
   If seqX(key) <> key Then
    MsgBox("error")
   End If
  Next key
  'Get a sequence created in UNO, out param is array Variant ( VT_BYREF|VT_VARIANT|VT_ARRAY)
  Dim seqX2() As Object
  objOleTest.testout_methodSequence(seqX2)

  For Each key In seqX2
   Debug.Print(CStr(seqX2(key)))
  Next key

  'pass it to UNO and get it back
  Dim seq7() As Object
  seq7 = objOleTest.methodLong(seqX)
  Dim key2 As Object
  For Each key2 In seq7
   Debug.Print(CStr(seq7(key2)))
   If seqX2(key) <> key Then
    MsgBox("error")
   End If
  Next key2

  'array with starting index != 0
  Dim seqIndex(2) As Integer
        Dim seq8() As Object
  Dim longVal1, longVal2 As Integer
  longVal1 = 1
  longVal2 = 2
  seqIndex(1) = longVal1
        seqIndex(2) = longVal2
        'The bridge returns a Safearray of Variants. It does not yet convert to an _
        'array of a particular type!
        'Comparing of elements from seq8 (Object) with long values worked without _
        'explicit cast as is necessary in VS 2008. Also arrays in VS 2008 start at _
        'index 0
        seq8 = objOleTest.methodLong(seqIndex)
        If longVal1 <> CInt(seq8(1)) And longVal2 <> CInt(seq8(2)) Then
            MsgBox("error")
        End If

  'in out Array
  ' arrLong is Long Array
  Dim inoutVar(2) As Object

  For countvar = 0 To 2
   inoutVar(countvar) = countvar + 10
  Next 

  objOleTest.testinout_methodSequence(inoutVar)

  countvar = 0
  For countvar = 0 To 2
   Debug.Print(CStr(inoutVar(countvar)))
   If inoutVar(countvar) <> countvar + 11 Then
    MsgBox("error")
   End If
  Next 

  'Multidimensional array
  '============================================================
  ' Sequence< Sequence<long> > methodSequence( Sequence< Sequence long> >)
  ' Real multidimensional array Array
  ' 9 is Dim 1 (least significant) with C API
  Dim mulAr(9, 1) As Integer
  For i = 0 To 1
   For j = 0 To 9
    mulAr(j, i) = i * 10 + j
   Next j
  Next i

  Dim resMul As Object
  resMul = objOleTest.methodSequence(mulAr)

  Dim countDim1 As Integer
  Dim countDim2 As Integer
  Dim arr As Object
  For countDim2 = 0 To 1
   arr = resMul(countDim2)
   For countDim1 = 0 To 9
    Debug.Print(arr(countDim1))
    If arr(countDim1) <> mulAr(countDim1, countDim2) Then
     MsgBox("Error Multidimensional Array")
    End If
   Next countDim1
  Next countDim2
  IsArray(resMul)

  'Array of VARIANTs containing arrays
  Dim mulAr2(1) As Object
  Dim arr2(9) As Integer
  For i = 0 To 1
   ' Dim arr(9) As Long
   For j = 0 To 9
    arr2(j) = i * 10 + j
   Next j
   mulAr2(i) = VB6.CopyArray(arr2)
  Next i

  resMul = 0
  resMul = objOleTest.methodSequence(mulAr2)
  arr = 0
  Dim tmpVar As Object
  For countDim2 = 0 To 1
   arr = resMul(countDim2)
   tmpVar = mulAr2(countDim2)
   For countDim1 = 0 To 9
    Debug.Print(arr(countDim1))
    If arr(countDim1) <> tmpVar(countDim1) Then
     MsgBox("Error Multidimensional Array")
    End If
   Next countDim1
  Next countDim2

  'Array containing interfaces (element type is VT_DISPATCH)
  Dim arArEventListener(1, 2) As Object
  For i = 0 To 1
   For j = 0 To 2
    arArEventListener(i, j) = CreateObject("VBasicEventListener.VBEventListener")
    arArEventListener(i, j).setQuiet(True)
   Next 
  Next 
  'The function calls disposing on the listeners
  seq = objOleTest.methodXEventListenersMul(arArEventListener)
  For i = 0 To 1
   For j = 0 To 2
    If arArEventListener(i, j).disposingCalled = False Then
     MsgBox("Error")
    End If
   Next 
  Next 

  'Array containing interfaces (element type is VT_VARIANT containing VT_DISPATCH)
  Dim arArEventListener2(1, 2) As Object
  For i = 0 To 1
   For j = 0 To 2
    arArEventListener2(i, j) = CreateObject("VBasicEventListener.VBEventListener")
    arArEventListener2(i, j).setQuiet(True)
   Next 
  Next 
  'The function calls disposing on the listeners
  seq = objOleTest.methodXEventListenersMul(arArEventListener2)
  For i = 0 To 1
   For j = 0 To 2
    If arArEventListener2(i, j).disposingCalled = False Then
     MsgBox("Error")
    End If
   Next 
  Next 

  ' SAFEARRAY of VARIANTS containing SAFEARRAYs
  'The ultimate element type is VT_DISPATCH ( XEventListener)
  Dim arEventListener4(1) As Object
  Dim seq1(2) As Object
  Dim seq2(2) As Object
  For i = 0 To 2
   seq1(i) = CreateObject("VBasicEventListener.VBEventListener")
   seq2(i) = CreateObject("VBasicEventListener.VBEventListener")
   seq1(i).setQuiet(True)
   seq2(i).setQuiet(True)
  Next 
  arEventListener4(0) = VB6.CopyArray(seq1)
  arEventListener4(1) = VB6.CopyArray(seq2)
  'The function calls disposing on the listeners
  seq = objOleTest.methodXEventListenersMul(arEventListener4)
  For i = 0 To 2
   If seq1(i).disposingCalled = False Or seq2(i).disposingCalled = False Then
    MsgBox("Error")
   End If
  Next 

 End Function

 Function createHiddenDocument() As Object
  'Try to create a hidden document
  Dim objPropValue As Object
  objPropValue = objOleTest.Bridge_GetStruct("com.sun.star.beans.PropertyValue")
  'Set the members. If this fails then there is an Error
        objPropValue.Name = "Hidden"
  objPropValue.Handle = -1
  objPropValue.Value = True

  'create a hidden document
  'Create the Desktop
  Dim objDesktop As Object
  objDesktop = objServiceManager.createInstance("com.sun.star.frame.Desktop")
  'Open a new empty writer document
  Dim args(0) As Object
  args(0) = objPropValue
  createHiddenDocument = objDesktop.loadComponentFromURL("private:factory/swriter", "_blank", 0, args)
 End Function
End Module