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