Very interesting article, Replace RESTful APIs with JSON-Pure saying that REST Apis as strictly described by Roy Fielding are probably not a good idea. Definitely worth a read and has influenced my design.
I want to write a web service that takes information scanned for a VBA project and uploads it to a web server for analysis. Initially, I had thought I'd make a network call for each method I'd find but then that adds up to tons of ntwork calls, also I'd have to expose my URLs to the user and finally I'd have to force fit my data to a REST url paradigm which I found quite challenging. This initial approach could be described as an atomic approach making many individual network calls. An alternative approach is to build up a whole document and post this document all in one network call.
In case you're interested the code that was used as the subject of the experiment is available here, Creating an SVG file with VBA .
So the following is a program that will use the Microsoft Visual Basic for Applications Extensibility 5.3 (VBIDE) library to scan a VBA project attached a workbook for classes and modules and procedures found therein.
The code uses simple string concatenation to build the JSON document but still uses the ScriptControl to debug malformed JSON.
The resultant JSON document is found below as well as the list of atomic calls for comparison. I'm opting for document driven approach for now on.
Option Explicit
Option Private Module
'* Tools->References
' MSScriptControl Microsoft Script Control 1.0 C:\Windows\SysWow64\msscript.ocx
' MSXML2 Microsoft XML, v6.0 C:\Windows\SysWOW64\msxml6.dll
' Scripting Microsoft Scripting Runtime C:\Windows\SysWOW64\scrrun.dll
' VBIDE Microsoft Visual Basic for App's Extensibility 5.3 C:\Program Files (x86)\Common Files\Microsoft Shared\VBA\VBA6\VBE6EXT.OLB
'******************************************************************************
'* This block implements the debug boolean (plus a default)
Private Const mbDEBUGJSONDEFAULT As Boolean = True
Private mvDebugJSON As Variant
Private Property Let DebugJSON(ByVal bRHS As Boolean)
mvDebugJSON = bRHS
End Property
Private Property Get DebugJSON() As Boolean
If IsEmpty(mvDebugJSON) Then mvDebugJSON = mbDEBUGJSONDEFAULT
DebugJSON = mvDebugJSON
End Property
'******************************************************************************
Private Sub TestConvertArtefactsToModellerJSON()
'*
'* Main entry point, tests the code and shows the JSON parsed into an object
'* of course one does not have to parse it here, one can just pass JSON string on to a webservice
'*
Dim wb As Excel.Workbook
Set wb = Workbooks.Item("SVG.xlsm") '<--- put your own workbook in here!
DebugJSON = False '* this controls interim parsing, useful for debugging the document's components
Dim sJSON As String
sJSON = ReadComponentsWithVBIDE(wb)
Debug.Print sJSON
Dim objParsed As Object
Set objParsed = SC.Run("JSON_parse", sJSON)
Stop '* inspect objParsed in Locals Window
End Sub
Private Function ReadComponentsWithVBIDE(ByVal wb As Excel.Workbook) As String
'*
'* This function scans through all the classes and modules and reports on procedures found therein
'*
If wb Is Nothing Then Err.Raise vbObjectError, , "#Null wb!"
Dim vbp As VBIDE.VBProject
Set vbp = wb.VBProject
Dim sJSON As String
sJSON = VBA.Replace("{'projectName':'%foo%'", "%foo%", vbp.Name)
Dim sJSONClasses As String
sJSONClasses = "["
Dim sJSONModules As String
sJSONModules = "["
Dim vbcLoop As VBIDE.VBComponent
For Each vbcLoop In vbp.VBComponents
If vbcLoop.Type = vbext_ct_ClassModule Or vbcLoop.Type = vbext_ct_StdModule Then
Dim sJSONComponent As String
sJSONComponent = ScanComponent(vbcLoop)
Select Case vbcLoop.Type
Case vbext_ct_ClassModule:
sJSONClasses = sJSONClasses & VBA.IIf(Len(sJSONClasses) > 1, ",", "") & sJSONComponent
Case vbext_ct_StdModule:
sJSONModules = sJSONModules & VBA.IIf(Len(sJSONModules) > 1, ",", "") & sJSONComponent
End Select
End If
Next
sJSONClasses = sJSONClasses & "]"
sJSONModules = sJSONModules & "]"
Call ParseAndStringify(sJSONClasses)
Call ParseAndStringify(sJSONModules)
sJSON = sJSON & ",'classes':" & sJSONClasses
sJSON = sJSON & ",'modules':" & sJSONModules
sJSON = sJSON & "}"
ReadComponentsWithVBIDE = ParseAndStringify(sJSON)
End Function
Private Function ScanComponent(ByVal vbc As VBIDE.VBComponent) As String
'*
'* This function will scan the source code of a component and report on any procedures found therein
'*
Dim dicProcs As Scripting.Dictionary
Set dicProcs = New Scripting.Dictionary
Dim dotnetlistProcs As Object
Set dotnetlistProcs = VBA.CreateObject("System.Collections.ArrayList") '* need for sorting
Dim cm As VBIDE.CodeModule
Set cm = vbc.CodeModule
Dim lLineLoop As Long
For lLineLoop = 1 To cm.CountOfLines
Dim sProc As String
Dim eProcKind As VBIDE.vbext_ProcKind
sProc = cm.ProcOfLine(lLineLoop, eProcKind)
If Not dicProcs.Exists(sProc) Then
dicProcs.Add sProc, VBA.Switch(eProcKind = vbext_pk_Get, "get", eProcKind = vbext_pk_Let, "let", _
eProcKind = vbext_pk_Set, "set", eProcKind = vbext_pk_Proc, "proc")
End If
If Not dotnetlistProcs.contains(sProc) Then
dotnetlistProcs.Add sProc
End If
Next lLineLoop
dotnetlistProcs.Sort
Dim sJSON As String
sJSON = VBA.Replace("{'compName':'%foo%','procs':[", "%foo%", vbc.Name)
Dim l As Long
For l = 0 To dotnetlistProcs.Count - 1
sJSON = sJSON & "{'procName':" & "'" & VBA.IIf(Len(dotnetlistProcs.Item(l)) = 0, "(Declarations)", dotnetlistProcs.Item(l)) & "',"
sJSON = sJSON & "'procKind':" & "'" & dicProcs.Item(dotnetlistProcs.Item(l)) & "'}" & VBA.IIf(l <> dotnetlistProcs.Count - 1, ",", "")
Next l
sJSON = sJSON & "]}"
ScanComponent = ParseAndStringify(sJSON)
End Function
Private Function ParseAndStringify(ByVal sJSON As String) As String
'*
'* this function callable by any code that concatenates JSON will parse and restringify (to reformat) if the module level debug
'* flag is set to True
'*
If DebugJSON Then
Dim oSC As ScriptControl
Set oSC = SC
Dim objParsed As Object
Set objParsed = oSC.Run("JSON_parse", VBA.Replace(sJSON, "'", """")) '* JSON strictly has double quotes not single quotes
Dim sReStringified As String
ParseAndStringify = oSC.Run("JSON_stringify", objParsed)
Debug.Print ParseAndStringify
Else
ParseAndStringify = VBA.Replace(sJSON, "'", """")
End If
End Function
Private Function SC() As ScriptControl
'*
'* This ScriptControl hosts javascript fragments, some added here, some downloaded from web
'*
Static soSC As ScriptControl
If soSC Is Nothing Then
Set soSC = New ScriptControl
soSC.Language = "JScript"
soSC.AddCode GetJavaScriptLibrary("https://raw.githubusercontent.com/douglascrockford/JSON-js/master/json2.js")
soSC.AddCode "function JSON_stringify(jsonObj) { return JSON.stringify(jsonObj); } "
soSC.AddCode "function JSON_parse(sJson) { return JSON.parse(sJson); } "
soSC.AddCode "function deleteValueByKey(obj,keyName) { delete obj[keyName]; } "
soSC.AddCode "function setValueByKey(obj,keyName, newValue) { obj[keyName]=newValue; } "
soSC.AddCode "function enumKeysToMsDict(jsonObj,msDict) { for (var i in jsonObj) { msDict.Add(i,0); } } "
End If
Set SC = soSC
End Function
Private Function GetJavaScriptLibrary(ByVal sURL As String) As String
'*
'* This assists the ScriptControl to download javascript library
'*
Dim xHTTPRequest As MSXML2.XMLHTTP60
Set xHTTPRequest = New MSXML2.XMLHTTP60
xHTTPRequest.Open "GET", sURL, False
xHTTPRequest.send
GetJavaScriptLibrary = xHTTPRequest.responseText
End FunctionSo the output of the program is a JSON string, if I pretty print this with the help of https://jsonformatter.curiousconcept.com/ .
{
"projectName":"SVGHelper",
"classes":[
{
"compName":"Point",
"procs":[
{
"procName":"(Declarations)",
"procKind":"proc"
},
{
"procName":"SetPoint",
"procKind":"proc"
},
{
"procName":"x",
"procKind":"get"
},
{
"procName":"y",
"procKind":"get"
}
]
},
{
"compName":"Points",
"procs":[
{
"procName":"(Declarations)",
"procKind":"proc"
},
{
"procName":"AddPoint",
"procKind":"proc"
},
{
"procName":"Class_Initialize",
"procKind":"proc"
},
{
"procName":"Count",
"procKind":"proc"
},
{
"procName":"CreatePoint",
"procKind":"proc"
},
{
"procName":"Item",
"procKind":"proc"
},
{
"procName":"LastPoint",
"procKind":"proc"
}
]
},
{
"compName":"SVGPath",
"procs":[
{
"procName":"(Declarations)",
"procKind":"proc"
},
{
"procName":"AddPoint",
"procKind":"proc"
},
{
"procName":"Class_Initialize",
"procKind":"proc"
},
{
"procName":"ClosePath",
"procKind":"proc"
},
{
"procName":"D_Attribute",
"procKind":"proc"
},
{
"procName":"ReflectInBothXAndY",
"procKind":"proc"
},
{
"procName":"ReflectInX",
"procKind":"proc"
},
{
"procName":"ReflectInY",
"procKind":"proc"
},
{
"procName":"SetMove",
"procKind":"proc"
}
]
},
{
"compName":"UnionJack",
"procs":[
{
"procName":"(Declarations)",
"procKind":"proc"
},
{
"procName":"BlueTriangle",
"procKind":"proc"
},
{
"procName":"Class_Initialize",
"procKind":"proc"
},
{
"procName":"EnglishCross",
"procKind":"proc"
},
{
"procName":"MyLargerBlueTriangle",
"procKind":"proc"
},
{
"procName":"MySmallerBlueTriangle",
"procKind":"proc"
},
{
"procName":"StPatricksCrossBlade",
"procKind":"proc"
}
]
},
{
"compName":"SVGTextMessageLengthCalculator",
"procs":[
{
"procName":"(Declarations)",
"procKind":"proc"
},
{
"procName":"CalculateChunks",
"procKind":"proc"
},
{
"procName":"Class_Initialize",
"procKind":"proc"
},
{
"procName":"CycleThroughTextMessage",
"procKind":"proc"
},
{
"procName":"Initialise",
"procKind":"proc"
},
{
"procName":"NavigateToTextMessageAndMeasureWidth",
"procKind":"proc"
},
{
"procName":"Terminate",
"procKind":"proc"
},
{
"procName":"WriteSVGTextFile",
"procKind":"proc"
}
]
},
{
"compName":"SVGTextMessageHeightCalculator",
"procs":[
{
"procName":"(Declarations)",
"procKind":"proc"
},
{
"procName":"ComputeHeight",
"procKind":"proc"
}
]
}
],
"modules":[
{
"compName":"modUnionJack",
"procs":[
{
"procName":"(Declarations)",
"procKind":"proc"
},
{
"procName":"CreateFromScratch",
"procKind":"proc"
}
]
},
{
"compName":"tstSVGTextMessageCal",
"procs":[
{
"procName":"(Declarations)",
"procKind":"proc"
},
{
"procName":"TestHeight",
"procKind":"proc"
},
{
"procName":"TestLengthCalculator",
"procKind":"proc"
}
]
},
{
"compName":"Module1",
"procs":[
]
}
]
}
The previous iteration of code took each class method and converted into to a REST url but this means (i) tons more network calls; (ii) exposing URLs ; (iii) forcing into REST url paradigm. (Code not given).
http://localhost:1337/VBAModeller/SVGHelper/Classes/Point/
http://localhost:1337/VBAModeller/SVGHelper/Classes/Point/SetPoint
http://localhost:1337/VBAModeller/SVGHelper/Classes/Point/x_propget
http://localhost:1337/VBAModeller/SVGHelper/Classes/Point/y_propget
http://localhost:1337/VBAModeller/SVGHelper/Classes/Points/
http://localhost:1337/VBAModeller/SVGHelper/Classes/Points/AddPoint
http://localhost:1337/VBAModeller/SVGHelper/Classes/Points/Class_Initialize
http://localhost:1337/VBAModeller/SVGHelper/Classes/Points/Count
http://localhost:1337/VBAModeller/SVGHelper/Classes/Points/CreatePoint
http://localhost:1337/VBAModeller/SVGHelper/Classes/Points/Item
http://localhost:1337/VBAModeller/SVGHelper/Classes/Points/LastPoint
http://localhost:1337/VBAModeller/SVGHelper/Classes/SVGPath/
http://localhost:1337/VBAModeller/SVGHelper/Classes/SVGPath/AddPoint
http://localhost:1337/VBAModeller/SVGHelper/Classes/SVGPath/Class_Initialize
http://localhost:1337/VBAModeller/SVGHelper/Classes/SVGPath/ClosePath
http://localhost:1337/VBAModeller/SVGHelper/Classes/SVGPath/D_Attribute
http://localhost:1337/VBAModeller/SVGHelper/Classes/SVGPath/ReflectInBothXAndY
http://localhost:1337/VBAModeller/SVGHelper/Classes/SVGPath/ReflectInX
http://localhost:1337/VBAModeller/SVGHelper/Classes/SVGPath/ReflectInY
http://localhost:1337/VBAModeller/SVGHelper/Classes/SVGPath/SetMove
http://localhost:1337/VBAModeller/SVGHelper/Classes/UnionJack/
http://localhost:1337/VBAModeller/SVGHelper/Classes/UnionJack/BlueTriangle
http://localhost:1337/VBAModeller/SVGHelper/Classes/UnionJack/Class_Initialize
http://localhost:1337/VBAModeller/SVGHelper/Classes/UnionJack/EnglishCross
http://localhost:1337/VBAModeller/SVGHelper/Classes/UnionJack/MyLargerBlueTriangle
http://localhost:1337/VBAModeller/SVGHelper/Classes/UnionJack/MySmallerBlueTriangle
http://localhost:1337/VBAModeller/SVGHelper/Classes/UnionJack/StPatricksCrossBlade
http://localhost:1337/VBAModeller/SVGHelper/Classes/SVGTextMessageLengthCalculator/
http://localhost:1337/VBAModeller/SVGHelper/Classes/SVGTextMessageLengthCalculator/CalculateChunks
http://localhost:1337/VBAModeller/SVGHelper/Classes/SVGTextMessageLengthCalculator/Class_Initialize
http://localhost:1337/VBAModeller/SVGHelper/Classes/SVGTextMessageLengthCalculator/CycleThroughTextMessage
http://localhost:1337/VBAModeller/SVGHelper/Classes/SVGTextMessageLengthCalculator/Initialise
http://localhost:1337/VBAModeller/SVGHelper/Classes/SVGTextMessageLengthCalculator/NavigateToTextMessageAndMeasureWidth
http://localhost:1337/VBAModeller/SVGHelper/Classes/SVGTextMessageLengthCalculator/Terminate
http://localhost:1337/VBAModeller/SVGHelper/Classes/SVGTextMessageLengthCalculator/WriteSVGTextFile
http://localhost:1337/VBAModeller/SVGHelper/Classes/SVGTextMessageHeightCalculator/
http://localhost:1337/VBAModeller/SVGHelper/Classes/SVGTextMessageHeightCalculator/ComputeHeight
http://localhost:1337/VBAModeller/SVGHelper/Modules/modUnionJack/
http://localhost:1337/VBAModeller/SVGHelper/Modules/modUnionJack/CreateFromScratch
http://localhost:1337/VBAModeller/SVGHelper/Modules/tstSVGTextMessageCal/
http://localhost:1337/VBAModeller/SVGHelper/Modules/tstSVGTextMessageCal/TestHeight
http://localhost:1337/VBAModeller/SVGHelper/Modules/tstSVGTextMessageCal/TestLengthCalculator
No comments:
Post a Comment