[VB6] What about Me a.k.a. Method Chaining a.k.a. Fluent VB6

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's

concatenated = 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, viz

Dim 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 initialisation

Private 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 being

dog,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, viz

Dim 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