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