diff options
author | Vladimir Glazounov <vg@openoffice.org> | 2003-05-22 09:00:32 +0000 |
---|---|---|
committer | Vladimir Glazounov <vg@openoffice.org> | 2003-05-22 09:00:32 +0000 |
commit | 7168d7de0e9f39c79c3ac07f8890e09aa8daa883 (patch) | |
tree | 97848d8577baeda0b8be70b4e622d05980c5bed9 /extensions/test | |
parent | a18150155e7ae2a27ff5f94b0c2ba5c939280823 (diff) |
INTEGRATION: CWS uno4 (1.5.2); FILE ADDED
2003/05/07 15:51:21 jl 1.5.2.1: *** empty log message ***
Diffstat (limited to 'extensions/test')
-rw-r--r-- | extensions/test/ole/VisualBasic/Module1.bas | 743 |
1 files changed, 743 insertions, 0 deletions
diff --git a/extensions/test/ole/VisualBasic/Module1.bas b/extensions/test/ole/VisualBasic/Module1.bas new file mode 100644 index 000000000000..e3ab7b34e46e --- /dev/null +++ b/extensions/test/ole/VisualBasic/Module1.bas @@ -0,0 +1,743 @@ +Attribute VB_Name = "Module1" +Option Explicit + +Private objServiceManager +Private objCoreReflection +Private objOleTest +Private objEventListener + +Sub Main() + Set objServiceManager = CreateObject("com.sun.star.ServiceManager") + Set objCoreReflection = objServiceManager.createInstance("com.sun.star.reflection.CoreReflection") + ' extensions/test/ole/cpnt + Set objOleTest = objServiceManager.createInstance("oletest.OleTest") + ' extensions/test/ole/EventListenerSample/VBEventListener + Set objEventListener = CreateObject("VBasicEventListener.VBEventListener") + Debug.Print TypeName(objOleTest) + +' In Parameter, simple types +'============================================ +Dim tmpVar As Variant +Dim ret As Variant +Dim bError As Boolean +ret = objOleTest.in_methodByte(10) +Debug.Print TypeName(ret) & " " & CStr(ret) +If ret <> 10 Then + MsgBox "error" +End If + +ret = objOleTest.in_methodFloat(3.14) +Debug.Print TypeName(ret) & " " & CStr(ret) +If ret <> 3.14 Then + MsgBox "error" +End If +Dim d As Double 'try conversion +d = 3.14 +ret = objOleTest.in_methodFloat(3.14) +Debug.Print TypeName(ret) & " " & CStr(ret) +If ret <> 3.14 Then + MsgBox "error" +End If + +ret = objOleTest.in_methodDouble(4.14) +Debug.Print TypeName(ret) & " " & CStr(ret) +If ret <> 4.14 Then + MsgBox "error" +End If +Dim s As Single +s = 4.14 +ret = objOleTest.in_methodDouble(s) +Debug.Print TypeName(ret) & " " & CStr(ret) +If (ret < 4.13) And (ret > 4.15) Then + MsgBox "error" +End If + +ret = objOleTest.in_methodBool(True) +Debug.Print TypeName(ret) & " " & CStr(ret) +If ret <> True Then + MsgBox "error" +End If + +ret = objOleTest.in_methodBool(False) +Debug.Print TypeName(ret) & " " & CStr(ret) +If ret <> False Then + MsgBox "error" +End If + +ret = objOleTest.in_methodShort(-10) +Debug.Print TypeName(ret) & " " & CStr(ret) +If ret <> -10 Then + MsgBox "error" +End If +ret = objOleTest.in_methodUShort(10) +Debug.Print TypeName(ret) & " " & CStr(ret) +If ret <> 10 Then + MsgBox "error" +End If +ret = objOleTest.in_methodLong(-1000000) +Debug.Print TypeName(ret) & " " & CStr(ret) +If ret <> -1000000 Then + MsgBox "error" +End If + +ret = objOleTest.in_methodULong(1000000) +Debug.Print TypeName(ret) & " " & CStr(ret) +If ret <> 1000000 Then + MsgBox "error" +End If + +ret = objOleTest.in_methodString("This is a String") +Debug.Print TypeName(ret) & " " & CStr(ret) +If CStr(ret) <> "This is a String" Then + MsgBox "error" +End If + +'different character tests +ret = objOleTest.in_methodChar("A") +Debug.Print TypeName(ret) & " " & CStr(ret) +If ret <> 65 Then + MsgBox "error" +End If +'!!!Function returns char, i.e sal_Unicode which VB converts to String +Dim ret1 As String +ret1 = objOleTest.in_methodChar("A") +Debug.Print TypeName(ret1) & " " & CStr(ret1) +If ret <> 65 Then + MsgBox "error" +End If + +ret1 = objOleTest.in_methodChar(65) +Debug.Print TypeName(ret1) & " " & CStr(ret1) +If ret <> 65 Then + MsgBox "error" +End If + +ret = objOleTest.in_methodAny("input string") +Debug.Print TypeName(ret) & " " & CStr(ret) +If ret <> "input string" Then + MsgBox "error" +End If + +'Call objOleTest.in_methodAll(10, 10.1, 10.111, True, 10, 11, 12, 13, _ +' "A String", "A", "A String in an Any") + +'Out Parameter simple types +'================================================ +Dim outByte As Byte +objOleTest.testout_methodByte outByte +Debug.Print "out byte " & CStr(outByte) +If outByte <> 111 Then + MsgBox "error" +End If + +Dim outFloat As Single +objOleTest.testout_methodFloat outFloat +Debug.Print "out float " & CStr(outFloat) +If outFloat <> 3.14 Then + MsgBox "error" +End If + +Dim outDouble As Double +objOleTest.testout_methodDouble outDouble +Debug.Print "out double " & CStr(outDouble) +If outDouble <> 3.14 Then + MsgBox "error" +End If + +Dim outBool As Boolean +objOleTest.testout_methodBool outBool +Debug.Print "out bool " & CStr(outBool) +If outBool <> True Then + MsgBox "error" +End If + +Dim outInt As Integer +objOleTest.testout_methodShort outInt +Debug.Print "out short " & CStr(outInt) +If outInt <> 222 Then + MsgBox "error" +End If + +objOleTest.testout_methodUShort outInt +Debug.Print "out unsignedshort " & CStr(outInt) +If outInt <> 333 Then + MsgBox "error" +End If + +Dim outLong As Long +objOleTest.testout_methodLong outLong +Debug.Print "out long " & CStr(outLong) +If outLong <> 444 Then + MsgBox "error" +End If + +objOleTest.testout_methodULong outLong +Debug.Print "out unsigned long " & CStr(outLong) +If outLong <> 555 Then + MsgBox "error" +End If + +Dim outString As String +objOleTest.testout_methodString outString +Debug.Print "out string " & CStr(outString) +If outString <> "a little string" Then + MsgBox "error" +End If + +Dim outChar As Integer +objOleTest.testout_methodChar outChar +Debug.Print "out char " & CStr(outChar) +If outChar <> 65 Then + MsgBox "error" +End If + +Dim outCharS As String +objOleTest.testout_methodChar outCharS +Debug.Print "out char (String) " & CStr(outCharS) +If outCharS <> "A" Then + MsgBox "error" +End If + +objOleTest.testout_methodAny outString +Debug.Print "out Any " & CStr(outString) + +'Out Parameter simple types (VARIANT var) +Dim outVar As Variant +objOleTest.testout_methodByte outVar +Debug.Print "out Byte (VARIANT) " & CStr(outVar) +If outVar <> 111 Then + MsgBox "error" +End If + +objOleTest.testout_methodFloat outVar +Debug.Print "out float (VARIANT) " & CStr(outVar) +If outVar <> 3.14 Then + MsgBox "error" +End If + +objOleTest.testout_methodDouble outVar +Debug.Print "out double (VARIANT) " & CStr(outVar) +If outVar <> 3.14 Then + MsgBox "error" +End If + +objOleTest.testout_methodBool outVar +Debug.Print "out bool (VARIANT) " & CStr(outVar) +If outVar <> True Then + MsgBox "error" +End If + +objOleTest.testout_methodShort outVar +Debug.Print "out short (VARIANT) " & CStr(outVar) +If outVar <> 222 Then + MsgBox "error" +End If + +objOleTest.testout_methodUShort outVar +Debug.Print "out unsigned short (VARIANT) " & CStr(outVar) +If outVar <> 333 Then + MsgBox "error" +End If + +objOleTest.testout_methodLong outVar +Debug.Print "out long (VARIANT) " & CStr(outVar) +If outVar <> 444 Then + MsgBox "error" +End If + +objOleTest.testout_methodULong outVar +Debug.Print "out unsigned long (VARIANT) " & CStr(outVar) +If outVar <> 555 Then + MsgBox "error" +End If + +objOleTest.testout_methodString outVar +Debug.Print "out string (VARIANT) " & CStr(outVar) +If outVar <> "a little string" Then + MsgBox "error" +End If + +objOleTest.testout_methodChar outVar +Debug.Print "out char (VARIANT) " & CStr(outVar) +If outVar <> 65 Then + MsgBox "error" +End If + +objOleTest.testout_methodAny outVar +Debug.Print "out any (VARIANT) " & CStr(outVar) +If outVar <> "I am a string in an any" Then + MsgBox "error" +End If + +'In/Out simple types +'============================================ +outByte = 10 +objOleTest.testinout_methodByte outByte +Debug.Print "inout byte " & CStr(outByte) +If outByte <> 11 Then + MsgBox "error" +End If + +outFloat = 3.14 +objOleTest.testinout_methodFloat outFloat +Debug.Print "inout float " & CStr(outFloat) +If (outFloat > 4.15) And (outFloat < 4.13) Then + MsgBox "error" +End If + +outDouble = 4.14 +objOleTest.testinout_methodDouble outDouble +Debug.Print "inout double " & CStr(outDouble) +If outDouble <> 5.14 Then + MsgBox "error" +End If + +outBool = True +objOleTest.testinout_methodBool outBool +Debug.Print "inout bool " & CStr(outBool) +If outBool <> False Then + MsgBox "error" +End If + +outInt = 10 +objOleTest.testinout_methodShort outInt +Debug.Print "inout short " & CStr(outInt) +If outInt <> 11 Then + MsgBox "error" +End If + +outInt = 20 +objOleTest.testinout_methodUShort outInt +Debug.Print "inout unsignedshort " & CStr(outInt) +If outInt <> 21 Then + MsgBox "error" +End If + +outLong = 30 +objOleTest.testinout_methodLong outLong +Debug.Print "inout long " & CStr(outLong) +If outLong <> 31 Then + MsgBox "error" +End If + +outLong = 40 +objOleTest.testinout_methodULong outLong +Debug.Print "inout unsigned long " & CStr(outLong) +If outLong <> 41 Then + MsgBox "error" +End If + +outString = "this is an in string" +objOleTest.testinout_methodString outString +Debug.Print "inout string " & CStr(outString) +If outString <> "this is an in string out string" Then + MsgBox "error" +End If + +'different Char conversions +objOleTest.testout_methodChar outString +Debug.Print "out char (in: String)" & CStr(outString) +If outString <> "A" Then + MsgBox "error" +End If + +objOleTest.testout_methodChar outInt +Debug.Print "out char (in: Int)" & CStr(outInt) +If outInt <> 65 Then + MsgBox "error" +End If + +'-- +outString = "this is another in out string" +objOleTest.testout_methodAny outString +Debug.Print "out Any " & CStr(outString) +If outString <> "I am a string in an any" Then + MsgBox "error" +End If + +'Objects +' +'========================================================== +' COM obj +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 +Set retObj = objOleTest.in_methodInvocation(objEventListener) +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 objOleTest2 As Object +Set objOleTest2 = objServiceManager.createInstance("oletest.OleTest") +'Set a value +objOleTest2.AttrAny2 = "VBString " +objOleTest.testinout_methodXInterface2 objOleTest2 +tmpVar = Null +tmpVar = objOleTest2.AttrAny2 +Debug.Print "in: Uno out: the same object // " & CStr(tmpVar) +If tmpVar <> "VBString this string was written in the UNO component to the inout pararmeter" Then + MsgBox "error" +End If + + +'create a struct +Dim structClass As Object +Set 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 +Set 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 + +'inout later + +'Arrays +'======================================== +Dim arrLong(2) As Long +Dim arrObj(2) As Object +Dim countvar As Long +For countvar = 0 To 2 + arrLong(countvar) = countvar + 10 + Debug.Print countvar + Set arrObj(countvar) = CreateObject("VBasicEventListener.VBEventListener") + arrObj(countvar).setQuiet True +Next + +'Arrays always contain VARIANTS +Dim seq() As Variant +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) +For countvar = 0 To 2 + Dim tmp As Object + seq(countvar).resetDisposing + seq(countvar).disposing 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 + Set arEventListener(countvar) = CreateObject("VBasicEventListener.VBEventListener") + arEventListener(countvar).setQuiet True +Next + +'The function calls disposing on the listeners +seq = objOleTest.methodXEventListeners(arEventListener) +Dim count +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 Variant +For countvar = 0 To 2 + Set 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 Variant +For countvar = 0 To 2 + Dim var As Variant + Set arEventListener3(countvar) = CreateObject("VBasicEventListener.VBEventListener") + arEventListener3(countvar).setQuiet True +Next +Dim varContAr As Variant +varContAr = 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 Variant + +objOleTest.testout_methodSequence seqX +Dim key +For Each key In seqX + Debug.Print CStr(seqX(key)) + If seqX(key) <> key Then + MsgBox "error" + End If +Next +'Get a sequence created in UNO, out param is array Variant ( VT_BYREF|VT_VARIANT|VT_ARRAY) +Dim seqX2() As Variant +objOleTest.testout_methodSequence seqX2 + +For Each key In seqX2 + Debug.Print CStr(seqX2(key)) +Next + +'pass it to UNO and get it back +Dim seq7() As Variant +seq7 = objOleTest.methodLong(seqX) +Dim key2 +For Each key2 In seq7 + Debug.Print CStr(seq7(key2)) + If seqX2(key) <> key Then + MsgBox "error" + End If +Next + +'in out Array +' arrLong is Long Array +Dim inoutVar(2) As Variant + +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 Long +Dim i As Long, j As Long +For i = 0 To 1 + For j = 0 To 9 + mulAr(j, i) = i * 10 + j + Next j +Next i + +Dim resMul As Variant +resMul = objOleTest.methodSequence(mulAr) + +Dim countDim1 As Long +Dim countDim2 As Long +For countDim2 = 0 To 1 + Dim arr + 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 Variant +Dim arr2(9) As Long +For i = 0 To 1 + ' Dim arr(9) As Long + For j = 0 To 9 + arr2(j) = i * 10 + j + Next j + mulAr2(i) = arr2 +Next i + +resMul = 0 +resMul = objOleTest.methodSequence(mulAr2) +arr = 0 +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 + Set 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 Variant +For i = 0 To 1 + For j = 0 To 2 + Set 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 Variant +Dim seq1(2) As Object +Dim seq2(2) As Object +For i = 0 To 2 + Set seq1(i) = CreateObject("VBasicEventListener.VBEventListener") + Set seq2(i) = CreateObject("VBasicEventListener.VBEventListener") + seq1(i).setQuiet True + seq2(i).setQuiet True +Next +arEventListener4(0) = seq1 +arEventListener4(1) = 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 + +'Bridge_GetStruct +'======================================================== +'Try to create a hidden document +Dim objPropValue +Set 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 +Set objDesktop = objServiceManager.createInstance("com.sun.star.frame.Desktop") +'Open a new empty writer document +Dim args(0) As Object +Set args(0) = objPropValue +Dim objDocument As Object +Set objDocument = objDesktop.loadComponentFromURL("private:factory/swriter", "_blank", 0, args()) +'Create a text object +Dim objText As Object +Set objText = objDocument.GetText + +'Bridge_ImplementedInterfaces +'================================================= +' call an UNO function that takes an XEventListener interface +'We provide a COM implementation (IDispatch) as EventListener +objEventListener.resetDisposing +objDocument.addEventListener objEventListener +objDocument.dispose +If objEventListener.disposingCalled = False Then + MsgBox "Error" +End If + + +'Bridge_GetValueObject +'================================================== +Dim objVal As Object +Set objVal = objOleTest.Bridge_GetValueObject() +Dim arrByte(9) As Byte +For countvar = 0 To 9 + arrByte(countvar) = countvar +Next countvar + +objVal.Set "[]byte", arrByte +ret = 0 +ret = objOleTest.methodByte(objVal) +'Test if ret is the same array + +key = 0 +For Each key In ret + If ret(key) <> arrByte(key) Then + MsgBox "Error" + End If + Debug.Print ret(key) +Next key + + +objVal.InitInOutParam "byte", 10 +objOleTest.testinout_methodByte objVal + +ret = 0 +ret = objVal.Get() +Debug.Print ret +If ret <> 11 Then + MsgBox "error" +End If + +objVal.InitOutParam +objOleTest.testout_methodChar objVal 'Returns 'A' (65) +ret = 0 +ret = objVal.Get() +Debug.Print ret +If ret <> 65 Then + MsgBox "error" +End If + +End Sub |