forked from amazingfate/loongoffice
c8eb695574
Change-Id: I41ca7f8c9b998436f0b2810236161697e9f501c8 Reviewed-on: https://gerrit.libreoffice.org/c/core/+/153675 Tested-by: Jenkins Reviewed-by: Julien Nabet <serval2412@yahoo.fr>
872 lines
30 KiB
VB.net
872 lines
30 KiB
VB.net
'
|
|
' 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
|