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.
thiskeyword. The VB6 equivalent keyword is
The challenge is to create a mechanism which allows something like Vidar's
concatenated = List.From(originalCollection).SelectProperty("Property").Concat(",")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 FROMSThe 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 SubNext the first public function
Selectingwhich 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
Mekeyword. Because it's an object, it has to be assigned to the function name (as a return value) using
Public Function Selecting() As SelectorObject Set Selecting = Me End FunctionNext the
Frompublic 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 FunctionNext comes the
Wherefunction. Rather that doing any further processing, the
Wheresimply 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 FunctionNext 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
Wherescript 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 FunctionFinally, one of the three output routines. This is where all the hard work is done. Notice that these functions don't specify
SelectorObjectas the return type. In this first case, a Collection is returned. The Dictionary output routine has not been written.
Notice also that, if a
Whereclause 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 FunctionNext, 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 FunctionAnd 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 Preservefor 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 FunctionThat's all that's currently in the
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|ratSo 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 operoutputting
<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.
© Copyright Bruce M. Axtens, 2015