' ************************************************************* | |
' | |
' 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 | |
' | |
' Unless required by applicable law or agreed to in writing, | |
' software distributed under the License is distributed on an | |
' "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY | |
' KIND, either express or implied. See the License for the | |
' specific language governing permissions and limitations | |
' under the License. | |
' | |
' ************************************************************* | |
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. Therfore 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 positiv 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 positiv value of int64 | |
retAny = objOleTest.in_methodAny(inHyper) | |
sError = "hyper test failed" | |
If inHyper <> retAny Then | |
MsgBox(sError) | |
End If | |
inHyper = CDec("-9223372036854775808") 'lowest negativ value of int64 | |
retAny = objOleTest.in_methodAny(inHyper) | |
If inHyper <> retAny Then | |
MsgBox(sError) | |
End If | |
inHyper = CDec("18446744073709551615") 'highest positiv value of unsigne 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 pararmeter" | |
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 pararmeter" 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 an 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 |