This is nothing to do with Shannon Noll's song, What about Me. No, it's about Method Chaining, the mechanism described in Fluent Javascript and making that same mechanism available to the VB6 programmer.
But first, kudos. I am grateful to Vidar Løvbrekke Sømme. On his zbz5.net blog, he posted an article called Bending Vb6 in the functional direction. In that article, he gives his take on method chaining. What follows is my take on the subject.
Having found a way to get VB6 running without emulation in 64bit Windows 10, I've been encouraged to get back into it and revisit some of my older projects.
So what's this got to do "What about Me"? Well, the thing that makes method chaining possible in JavaScript is the this keyword. The VB6 equivalent keyword is Me.
The challenge is to create a mechanism which allows something like Vidar'sconcatenated = List.From(originalCollection).SelectProperty("Property").Concat(",")— But this isn't too bad, is it?
What I've done doesn't use Map or Reduce (I have implemented those but differently and I'll deal with both in a subsequent post.)
First, launch the VB6 IDE, create a new project and remove the default form. Next create a class and call it SelectorObject. In the code editor for the class enter class variables, vizDim cWorking As Collection
Dim dWorking As Dictionary
Dim aWorking() As Variant
Dim iWorking As Integer
Dim cOriginal As Collection
Dim dOriginal As Dictionary
Dim aOriginal() As Variant
Dim sPattern As String
Dim bPatternDefined As Boolean
Dim oScript As ScriptControl
Private Enum FROMS
FromCollection = 1
FromDictionary = 2
FromArray = 3
Fromstring = 4
End Enum
Dim source As FROMS
The above is out of my own project so there's extra stuff in there that goes beyond Vidar's original. Ultimately I'd like to be able to hand a Collection, Dictionary, Array or String to the class and be able to pull out of it a Collection, Dictionary, Array or String. The code you'll see is part way to realising that.
Notice also the Dim oScript As ScriptControl. To make an element selection mechanism, I'm calling in the MSScript OCX object (as a Project Reference).
Next comes the class initialisationPrivate Sub Class_Initialize()
Set cWorking = New Collection
Set dWorking = New Dictionary
sPattern = vbNullString
bPatternDefined = False
iWorking = -1
Set oScript = New ScriptControl
oScript.Language = "VBScript"
oScript.UseSafeSubset = True
End Sub
Next the first public function Selecting which will introduce the selection statement. I'd love to be able to use Select, but that's a VB6 reserved word. Notice the use of the Me keyword. Because it's an object, it has to be assigned to the function name (as a return value) using Set.Public Function Selecting() As SelectorObject
Set Selecting = Me
End Function
Next the From public function. This ascertains the type of the incoming variable and assigns it to a relevant worker object. An enum takes care of letting the class know what was passed in.Public Function From(c As Variant) As SelectorObject
If TypeName(c) = "Collection" Then
Set cOriginal = c
source = FromCollection
ElseIf TypeName(c) = "Dictionary" Then
Set dOriginal = c
source = FromDictionary
Else
If VarType(c) = vbArray Then
aOriginal = c
source = FromArray
Else
aOriginal = Split(c, "")
source = Fromstring
End If
End If
Set From = Me
End Function
Next comes the Where function. Rather that doing any further processing, the Where simply accepts the 'where' text (a script fragment for MSScript to use later) and a flag to say we have it is set.Public Function Where(pattern As String) As SelectorObject
sPattern = pattern
bPatternDefined = True
Set Where = Me
End Function
Next a helper function which puts double quotes around strings and leaves other data types undecorated. This exists because the current element in the Collection/Dictionary/Array/String is assigned to a VBScript variable before the Where script is evaluated. Being a VBScript assignment statement, double quotes need to be around strings. At this point there is no special handling for booleans and dates etc.Private Function WrapData(data As Variant) As String
If VarType(data) = vbString Then
WrapData = Chr$(34) & data & Chr$(34)
Else
WrapData = CStr(data)
End If
End Function
Finally, one of the three output routines. This is where all the hard work is done. Notice that these functions don't specify SelectorObject as the return type. In this first case, a Collection is returned. The Dictionary output routine has not been written.
Notice also that, if a Where clause has been specified, the current item is set as a variable to the MSScript engine, and then the 'where' text is evaluated by MSScript, using the VBScript language. The result is interpreted as a boolean to decide whether or not to include the current item in the output collection. Otherwise, everything that went in comes out.Public Function asCollection() As Collection
Dim i As Integer
Dim b As Boolean
For i = 1 To cOriginal.Count
If bPatternDefined Then
oScript.ExecuteStatement "Value = " & WrapData(cOriginal.Item(i))
b = CBool(oScript.Eval(sPattern))
If b Then
cWorking.Add cOriginal.Item(i)
End If
Else
cWorking.Add cOriginal.Item(i)
End If
Next
Set asCollection = cWorking
End Function
Next, a string output routine, with an optional argument to supply an inter-item separator.Public Function asStringSeparatedBy(Optional separator As String = vbNullString) As String
Dim i As Integer
Dim b As Boolean
Dim answer As String
For i = 1 To cOriginal.Count
If bPatternDefined Then
oScript.ExecuteStatement "Value = " & WrapData(cOriginal.Item(i))
b = CBool(oScript.Eval(sPattern))
If b Then
answer = answer & cOriginal.Item(i)
If i < cOriginal.Count Then
answer = answer & separator
End If
End If
Else
cWorking.Add cOriginal.Item(i)
If i < cOriginal.Count Then
answer = answer & separator
End If
End If
Next
If bPatternDefined And Right$(answer, 1) = separator Then
answer = Mid$(answer, 1, Len(answer) - 1)
End If
asStringSeparatedBy = answer
End Function
And finally, an output routine returning an array. The array element variable, iWorking, was initialised as -1, thus the pre-increment. Perhaps something else could be done about array initialisation to make things more efficient than a ReDim Preserve for each element.Public Function asArray() As Variant
Dim i As Integer
Dim b As Boolean
For i = 1 To cOriginal.Count
If bPatternDefined Then
oScript.ExecuteStatement "Value = " & WrapData(cOriginal.Item(i))
b = CBool(oScript.Eval(sPattern))
If b Then
iWorking = iWorking + 1
ReDim Preserve aWorking(iWorking)
aWorking(iWorking) = cOriginal.Item(i)
End If
Else
iWorking = iWorking + 1
ReDim Preserve aWorking(iWorking)
aWorking(iWorking) = cOriginal.Item(i)
End If
Next
asArray = aWorking
End Function
That's all that's currently in the SelectorObject.
Now, out in the main module, in the Main subroutine, a couple of tests.Dim words As New Collection
words.Add "cat"
words.Add "dog"
words.Add "cow"
words.Add "wolf"
words.Add "rat"
Dim S As New SelectorObject
Debug.Print S.Selecting().From(words).Where("instr(Value,""o"") > 0").asStringSeparatedBy(",")
Debug.Print Join(S.Selecting().From(words).Where("instr(Value,""a"") > 0").asArray(), "|")
The output beingdog,cow,wolf
cat|rat
So that's my take on Fluent VB6.
In my experimentations I have used this technique to re-implement Google Adwords SOAP request code that I originally wrote in JScript, vizDim pred As String
Dim sele As String
Dim campaignID As Long
campaignID = 1000222
Dim OPE As New OperationObject
Dim PRE As New PredicateObject
Dim SEL As New SelectObject
pred = PRE.Field("CampaignId").Operator("=").Value(campaignID).toXML()
sele = SEL.Fields("BudgetId").Fields("Amount").Predicates(pred).toXML()
'sele = SEL.Fields("BudgetId").Fields("Amount").Predicates(PRE.Field("CampaignId").Operator("=").Value(campaignID).toXML()).toXML()
Dim bid As Long
bid = 2199199
Dim amt As Long
amt = 1000000
Dim oper As String
oper = OPE.Operator("SET").Field("budgetId").Value(bid).Amount(amt).toXML()
Debug.Print pred
Debug.Print sele
Debug.Print oper
outputting<field>CampaignId</field><operator>EQUALS</operator><values>1000222</values>
<fields>BudgetId</fields><fields>Amount</fields><predicates><field>CampaignId</field><operator>EQUALS</operator><values>1000222</values></predicates>
<operations><operator>SET</operator><operand><budgetId>2199199</budgetId><amount><microAmount>1000000</microAmount></amount></operand></operations>
Okay, that's it. A long-winded posting, this one. If you have any questions, use the comments.
Enjoy!© Copyright Bruce M. Axtens, 2015
