Adding upstream version 4:24.2.0.upstream/4%24.2.0

Signed-off-by: Daniel Baumann <daniel.baumann@progress-linux.org>

5 files changed, 1049 insertions, 0 deletions

diff --git a/extensions/test/ole/VisualBasic/AssemblyInfo.vb b/extensions/test/ole/VisualBasic/AssemblyInfo.vb
new file mode 100644
index 0000000000..c4b1d4ff50
--- /dev/null
+++ b/extensions/test/ole/VisualBasic/AssemblyInfo.vb
@@ -0,0 +1,51 @@
+'

+' 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 .

+'

+

+Imports System.Reflection

+Imports System.Runtime.CompilerServices

+Imports System.Runtime.InteropServices

+

+' General Information about an assembly is controlled through the following

+' set of attributes. Change these attribute values to modify the information

+' associated with an assembly.

+

+

+' TODO: Review the values of the assembly attributes

+

+

+<Assembly: AssemblyTitle("")>

+<Assembly: AssemblyDescription("")>

+<Assembly: AssemblyCompany("StarOffice")>

+<Assembly: AssemblyProduct("")>

+<Assembly: AssemblyCopyright("")>

+<Assembly: AssemblyTrademark("")>

+<Assembly: AssemblyCulture("")>

+

+' Version information for an assembly consists of the following four values:

+

+'	Major version

+'	Minor Version

+'	Build Number

+'	Revision

+

+' You can specify all the values or you can default the Build and Revision Numbers

+' by using the '*' as shown below:

+

+<Assembly:  AssemblyVersion("1.0.*")>

+

+

diff --git a/extensions/test/ole/VisualBasic/Module1.vb b/extensions/test/ole/VisualBasic/Module1.vb
new file mode 100644
index 0000000000..56b83beb3c
--- /dev/null
+++ b/extensions/test/ole/VisualBasic/Module1.vb
@@ -0,0 +1,871 @@
+'

+' 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

diff --git a/extensions/test/ole/VisualBasic/Project1.sln b/extensions/test/ole/VisualBasic/Project1.sln
new file mode 100644
index 0000000000..bea3e0edff
--- /dev/null
+++ b/extensions/test/ole/VisualBasic/Project1.sln
@@ -0,0 +1,19 @@
+Microsoft Visual Studio Solution File, Format Version 10.00

+# Visual Studio 2008

+Project("{F184B08F-C81C-45F6-A57F-5ABD9991F28F}") = "Project1", "Project1.vbproj", "{F62D440E-8976-4A6D-91A8-89F09701074F}"

+EndProject

+Global

+	GlobalSection(SolutionConfigurationPlatforms) = preSolution

+		Debug|Any CPU = Debug|Any CPU

+		Release|Any CPU = Release|Any CPU

+	EndGlobalSection

+	GlobalSection(ProjectConfigurationPlatforms) = postSolution

+		{F62D440E-8976-4A6D-91A8-89F09701074F}.Debug|Any CPU.ActiveCfg = Debug|Any CPU

+		{F62D440E-8976-4A6D-91A8-89F09701074F}.Debug|Any CPU.Build.0 = Debug|Any CPU

+		{F62D440E-8976-4A6D-91A8-89F09701074F}.Release|Any CPU.ActiveCfg = Release|Any CPU

+		{F62D440E-8976-4A6D-91A8-89F09701074F}.Release|Any CPU.Build.0 = Release|Any CPU

+	EndGlobalSection

+	GlobalSection(SolutionProperties) = preSolution

+		HideSolutionNode = FALSE

+	EndGlobalSection

+EndGlobal

diff --git a/extensions/test/ole/VisualBasic/Project1.vbproj b/extensions/test/ole/VisualBasic/Project1.vbproj
new file mode 100644
index 0000000000..4fd617432f
--- /dev/null
+++ b/extensions/test/ole/VisualBasic/Project1.vbproj
@@ -0,0 +1,90 @@
+<Project DefaultTargets="Build" ToolsVersion="3.5" xmlns="http://schemas.microsoft.com/developer/msbuild/2003">

+  <PropertyGroup>

+    <ProjectType>Local</ProjectType>

+    <MyType>WindowsFormsWithCustomSubMain</MyType>

+    <ProductVersion>9.0.21022</ProductVersion>

+    <SchemaVersion>2.0</SchemaVersion>

+    <ProjectGuid>{F62D440E-8976-4A6D-91A8-89F09701074F}</ProjectGuid>

+    <Configuration Condition=" '$(Configuration)' == '' ">Debug</Configuration>

+    <Platform Condition=" '$(Platform)' == '' ">AnyCPU</Platform>

+    <AssemblyName>Project1</AssemblyName>

+    <OutputType>WinExe</OutputType>

+    <StartupObject>Project1.Module1</StartupObject>

+    <AssemblyMajorVersion>1</AssemblyMajorVersion>

+    <AssemblyMinorVersion>0</AssemblyMinorVersion>

+    <AssemblyRevisionNumber>0</AssemblyRevisionNumber>

+    <GenerateRevisionNumber>False</GenerateRevisionNumber>

+    <AssemblyCompanyName>StarOffice</AssemblyCompanyName>

+    <RootNamespace>Project1</RootNamespace>

+    <FileUpgradeFlags>

+    </FileUpgradeFlags>

+  </PropertyGroup>

+  <PropertyGroup Condition=" '$(Configuration)|$(Platform)' == 'Debug|AnyCPU' ">

+    <OutputPath>.\bin\</OutputPath>

+    <DocumentationFile>Project1.xml</DocumentationFile>

+    <DebugSymbols>True</DebugSymbols>

+    <DefineDebug>True</DefineDebug>

+    <DefineTrace>True</DefineTrace>

+    <DefineConstants>Win32=True</DefineConstants>

+    <PlatformTarget>x86</PlatformTarget>

+    <NoWarn>42016,42017,42018,42019,42032</NoWarn>

+    <DebugType>full</DebugType>

+  </PropertyGroup>

+  <PropertyGroup Condition=" '$(Configuration)|$(Platform)' == 'Release|AnyCPU' ">

+    <OutputPath>.\bin\</OutputPath>

+    <DocumentationFile>Project1.xml</DocumentationFile>

+    <DebugSymbols>False</DebugSymbols>

+    <DefineDebug>False</DefineDebug>

+    <DefineTrace>True</DefineTrace>

+    <DefineConstants>Win32=True</DefineConstants>

+    <PlatformTarget>x86</PlatformTarget>

+    <NoWarn>42016,42017,42018,42019,42032</NoWarn>

+    <DebugType>none</DebugType>

+  </PropertyGroup>

+  <ItemGroup>

+    <Reference Include="Microsoft.VisualBasic.Compatibility">

+      <Name>Microsoft.VisualBasic.Compatibility</Name>

+    </Reference>

+    <Reference Include="System">

+      <Name>System</Name>

+    </Reference>

+    <Reference Include="System.Data">

+      <Name>System.Data</Name>

+    </Reference>

+    <Reference Include="System.Drawing">

+      <Name>System.Drawing</Name>

+    </Reference>

+    <Reference Include="System.Windows.Forms">

+      <Name>System.Windows.Forms</Name>

+    </Reference>

+    <Reference Include="System.XML">

+      <Name>System.XML</Name>

+    </Reference>

+  </ItemGroup>

+  <ItemGroup>

+    <Import Include="Microsoft.VisualBasic" />

+    <Import Include="Microsoft.VisualBasic.Compatibility" />

+    <Import Include="System" />

+    <Import Include="System.Collections" />

+    <Import Include="System.Data" />

+    <Import Include="System.Diagnostics" />

+    <Import Include="System.Drawing" />

+    <Import Include="System.Windows.Forms" />

+  </ItemGroup>

+  <ItemGroup>

+    <Compile Include="AssemblyInfo.vb" />

+    <Compile Include="Module1.vb">

+      <SubType>Code</SubType>

+    </Compile>

+  </ItemGroup>

+  <ItemGroup>

+    <Folder Include="My Project\" />

+  </ItemGroup>

+  <Import Project="$(MSBuildBinPath)\Microsoft.VisualBasic.targets" />

+  <PropertyGroup>

+    <PreBuildEvent>

+    </PreBuildEvent>

+    <PostBuildEvent>

+    </PostBuildEvent>

+  </PropertyGroup>

+</Project>
\ No newline at end of file
diff --git a/extensions/test/ole/VisualBasic/readme.txt b/extensions/test/ole/VisualBasic/readme.txt
new file mode 100644
index 0000000000..0b18430fca
--- /dev/null
+++ b/extensions/test/ole/VisualBasic/readme.txt
@@ -0,0 +1,18 @@
+Runs a test written in VisualBasic. If no error message appears then the test was ok.

+

+Requirements:

+Installed office

+Component oletest.Oletest (extensions/test/ole/cpnt)

+Component VBasicEventListener.VBEventListener (extensions/test/ole/EventListenerSample/VBEventListener

+

+

+OleTest is a UNO component. It needs to be registered with the office rdb. Also there are additional

+types (oletest.rdb in wntmsci7/bin/) which must be merged with the rdb.

+VBEventListener is an ActiveX component. The directory contains a Visual Basic Project and also

+the binary VBasicEventListener.dll. This is necessary because the dll contains the type library

+which is needed by VB. Otherwise VB would generate a new CLSID on a new build.

+The dll must be registered on the system. This is done by

+regsvr32 VBasicEventListener.dll

+or

+by a rebuild of the project.

+