From 2005 the clsObjectExtender was a fine class for late binding objects with events. But how we can use if we have our own object which raise events and we want that object to be present on a VBScript script?
The problem with the old clsObjectExtender was the use of Variants VT_VARIANT + VT_REF. So this new version refresh the old code to do the job properly.
Also I test the code for leaks, using a 100000 loop.
The program is in main() in a module. The events comes from an array of clsObjectExtender, in a module (so we can't use WithEvents), and we attach ShinkEvent, a class which have events and some subs as methods. So we place some SinkEvent objects, in a VBScript object, using names like Debug and Sum. At the execution of the VbScript script the code fire events from ShinkEvents objects and through clsObjectExtender (in an array), they call the same sub, in Module1.bas: EventRaised, with for parameters:
oTarget is the object (ShinkEvent) who fires the event
ID is a number which we give to clsObjectExtender for Identificarion in this sub.
strName is the event name
params() is a Variant type array to hold parameters. Although is a Variant type array, if the parameter isn't variant we have to keep the same type. But if the parameter is a variant type then we can change type. From the test the VBScript for numbers use automatic adjustment, so if we have variable j with a value 1 then this have a sub-type Integer. So if we get that by reference there are a chance to alter the type, in our code, and then return the new type. That can be done with this version. Also we can pass by reference Variant Arrays.
In the Module1 there are some TestX subs where X=1 to 5. There are two globals, pr as boolean to switch the debug.print on or off, so for a lengthy run we use pr=false, and sum, a variable which alter between calls to Test sub, through events.
Try the code. Any suggestions or improvements will be appreciated.
The problem with the old clsObjectExtender was the use of Variants VT_VARIANT + VT_REF. So this new version refresh the old code to do the job properly.
Also I test the code for leaks, using a 100000 loop.
The program is in main() in a module. The events comes from an array of clsObjectExtender, in a module (so we can't use WithEvents), and we attach ShinkEvent, a class which have events and some subs as methods. So we place some SinkEvent objects, in a VBScript object, using names like Debug and Sum. At the execution of the VbScript script the code fire events from ShinkEvents objects and through clsObjectExtender (in an array), they call the same sub, in Module1.bas: EventRaised, with for parameters:
oTarget is the object (ShinkEvent) who fires the event
ID is a number which we give to clsObjectExtender for Identificarion in this sub.
strName is the event name
params() is a Variant type array to hold parameters. Although is a Variant type array, if the parameter isn't variant we have to keep the same type. But if the parameter is a variant type then we can change type. From the test the VBScript for numbers use automatic adjustment, so if we have variable j with a value 1 then this have a sub-type Integer. So if we get that by reference there are a chance to alter the type, in our code, and then return the new type. That can be done with this version. Also we can pass by reference Variant Arrays.
Code:
Public Sub EventRaised(oTarget As Object, ByVal ID As Long, ByVal strName As String, params() As Variant)
On Error Resume Next
Dim i As Long
Dim Resp()
If ID = 1001 Then
If strName = "GetData" Then
Resp() = oTarget.GetData()
here:
For i = LBound(Resp) To UBound(Resp) - 1
If pr Then Debug.Print Resp(i),
Next i
If i = UBound(Resp) Then
If pr Then Debug.Print Resp(i)
End If
ElseIf strName = "GetString" Then
params(1) = "1234"
ElseIf strName = "GetNumber" Then
params(1) = params(1) * params(1)
ElseIf strName = "GetArray" Then
sum = sum + params(1)(2)
params(1)(0) = sum
Resp() = params(1)
GoTo here
ElseIf strName = "GetCalc" Then
If params(1) = "multiply" Then
params(2) = params(3) * params(4)
End If
Else
GoTo error1
End If
ElseIf ID = 1002 Then
If strName = "GetNumber" Then
params(1) = sum
Else
GoTo error1
End If
ElseIf ID = 1003 Then
If strName = "GetVBString" Then
params(1) = params(1) + "1234"
ElseIf strName = "GetString" Then
params(1) = params(1) + "123456"
ElseIf strName = "GetDecimal" Then
params(1) = params(1) + CDec("50000000000000000000000000")
ElseIf strName = "GetData" Then
Resp() = oTarget.GetData()
GoTo here
ElseIf strName = "GetCurrency" Then
params(1) = params(1) + CCur("9999999999999")
Else
GoTo error1
End If
Else
If pr Then Debug.Print "ID Event " & ID & " has no code for Events"
End If
Exit Sub
error1:
If pr Then Debug.Print "Event " + strName + " has no code"
End SubIn the Module1 there are some TestX subs where X=1 to 5. There are two globals, pr as boolean to switch the debug.print on or off, so for a lengthy run we use pr=false, and sum, a variable which alter between calls to Test sub, through events.
Try the code. Any suggestions or improvements will be appreciated.