Showing posts with label Serialization. Show all posts
Showing posts with label Serialization. Show all posts

Tuesday, 28 April 2020

VBA, Named Pipes (& JavaScript) - binary serialization revisited

In this post I revisit the matter of the serialization of VBA Variant arrays to bytes and back again. This can be used VBA to VBA or interoperating with other technologies that can be sequence bytes, in this post I demonstrate JavaScript to VBA. I incorporate a better serialization technique code that uses Windows OS Named Pipes as written by VBForums.com contributor Olaf Schmidt.

Background

This is a revisit of an earlier article where I saved and loaded a Variant array to disk using VBA’s Open File For Binary, Put and Get statements. Whilst the code did what I wanted, I had complained that my code required a disk operation which carries a performance penalty.

I am indebted to a commenter (who gives no name) who tipped me off as to some code on VBForums written by Olaf Schmidt; Olaf’s code serializes using Windows OS Named Pipes and not a disk write. The Named Pipes are purely in memory and so this makes his code faster.

Moreover, the Named Pipes serialization yields a leading sequence of bytes that describes the number of dimensions in the array and the size and bounds of each dimension. This was something formally missing from disk write version my code and which I had had to implement manually, something of a nuisance.

I am thus doubly indebted to Olaf Schmidt’s code and to the commenter who tipped me off. Thank you. Do please keep the comments coming.

VBA Class Module - cPipedVariants

So with Olaf Schmidt's code as a starting point I have modified it to handle the use case of VBA variant arrays, i.e. a two dimensional array which is ready for pasting onto a worksheet. Olaf's original code demonstrated the serialization of user-defined types and these data structures are more prevalent in Visual Basic 6 (VB6) whereas Excel developers (I would argue) are more likely to deal with grids drawn from a worksheet or grids to be pasted onto a worksheet.

If you want the original version that deals with the serialization of UDTs it is on this link here to vb6forums.com.

So what follows in cPipedVariants, a modification on Olaf's original class cPipedUDTs. Much of the code is easy to follow but I will comment on the ‘secret sauce’ of the InitializePipe function.

The two key lines of code are the call to CreateNamedPipeW and then the Open "\\.\pipe\foo" For Binary statement. If I switch the order of these two around then the code fails. Internally, in its implementation the Open For Binary Statement must have a special case where it identifies the "\\.\pipe\ " prefix and then looks up in the list of created named pipes. This is not documented in any Microsoft documentation, or indeed StackOverflow. Only the VB6Forums.com users and specifically Olaf Schmidt understand this lore, it must be a throw back to the era of VB6. Anyway, it does work and I am grateful.

Add a class to your VBA project, call it cPipedVariants and then paste in the following code

Option Explicit

'* Pipe-based helper to serialize/deserialize VB-Variants InMemory ... [based on original code by Olaf Schmidt 2015]
'* Based on code by Olaf Schmidt 2015, http://www.vbforums.com/showthread.php?807205-VB6-pipe-based-UDT-serializing-deserializing-InMemory


'* https://docs.microsoft.com/en-us/windows/win32/api/winbase/nf-winbase-createnamedpipea
Private Declare Function CreateNamedPipeW& Lib "kernel32" (ByVal lpName As Long, ByVal dwOpenMode&, ByVal dwPipeMode&, _
            ByVal nMaxInstances&, ByVal nOutBufferSize&, ByVal nInBufferSize&, _
            ByVal nDefaultTimeOut&, ByVal lpSecurityAttributes&)

'* https://docs.microsoft.com/en-us/windows/win32/api/fileapi/nf-fileapi-writefile
Private Declare Function WriteFile& Lib "kernel32" (ByVal hFile&, lpBuffer As Any, _
            ByVal nNumberOfBytesToWrite&, lpNumberOfBytesWritten&, ByVal lpOverlapped&)

'* https://docs.microsoft.com/en-us/windows/win32/api/fileapi/nf-fileapi-readfile
Private Declare Function ReadFile& Lib "kernel32" (ByVal hFile&, lpBuffer As Any, _
            ByVal nNumberOfBytesToRead&, lpNumberOfBytesRead&, ByVal lpOverlapped&)

'* https://docs.microsoft.com/en-us/windows/win32/api/namedpipeapi/nf-namedpipeapi-peeknamedpipe
Private Declare Function PeekNamedPipe& Lib "kernel32" (ByVal hNamedPipe&, lpBuffer As Any, _
            ByVal nBufferSize&, lpBytesRead&, lpTotalBytesAvail&, lpBytesLeftThisMessage&)

'* https://docs.microsoft.com/en-us/windows/win32/api/namedpipeapi/nf-namedpipeapi-disconnectnamedpipe
Private Declare Function DisconnectNamedPipe& Lib "kernel32" (ByVal hPipe&)

Private Declare Function CloseHandle& Lib "kernel32" (ByVal hObject&)

Private mhPipe As Long
Private mlFileNumber As Long
Private mabytSerialized() As Byte

Private Enum eOpenMode
    PIPE_ACCESS_INBOUND = 1
    PIPE_ACCESS_OUTBOUND = 2
    PIPE_ACCESS_DUPLEX = 3
End Enum

Private Enum ePipeMode
    PIPE_TYPE_BYTE = 0
    PIPE_TYPE_MESSAGE = 4

    PIPE_READMODE_BYTE = 0
    PIPE_READMODE_MESSAGE = 2
   
    PIPE_WAIT = 0
    PIPE_NOWAIT = 1
End Enum

Private Enum ePipeInstances
    PIPE_UNLIMITED_INSTANCES = 255
End Enum

Public Function InitializePipe(Optional sPipeNameSuffix As String = "vbaPipedVariantArrays") As Boolean
    Const csPipeNamePrefix As String = "\\.\pipe\"
    CleanUp
   
    Dim sPipeName As String
    sPipeName = csPipeNamePrefix & sPipeNameSuffix
   
    '* Must call CreateNamedPipe first before calling Open <<pathname>> For Binary otherwise you get bad file number
    mhPipe = CreateNamedPipeW(StrPtr(sPipeName), PIPE_ACCESS_DUPLEX, PIPE_TYPE_BYTE + PIPE_READMODE_BYTE + PIPE_WAIT, _
            PIPE_UNLIMITED_INSTANCES, -1, -1, 0, 0)
           
    If mhPipe = -1 Then mhPipe = 0 'reset from InvalidHandleValue to "no Handle"
   
    If mhPipe Then
        '* only try to find a free VB-FileNumber when mhPipe is valid (i.e. pipe has been created)
        mlFileNumber = FreeFile
        If mlFileNumber Then
            Open sPipeName For Binary As mlFileNumber  'open only, when we got an mlFileNumber
        End If
    End If
   
    InitializePipe = mhPipe <> 0 And mlFileNumber <> 0
End Function

Public Function SerializeToBytes(ByRef vSrc As Variant, ByRef pabytSerialized() As Byte) As Long

    Dim lBytesAvail As Long

    Debug.Assert IsArray(vSrc)

    If mlFileNumber <> 0 Then
   
        '* this next line writes the Variant array to the pipe
        Put mlFileNumber, 1, vSrc
       
        '* we should now have some bytes to read out of the pipe, use PeekNamedPipe to verify there are bytes available
        PeekNamedPipe mhPipe, ByVal 0&, 0, ByVal 0&, lBytesAvail, 0
       
        If lBytesAvail > 0 Then
           
            '* so now we can dimension the byte array
            ReDim Preserve pabytSerialized(0 To lBytesAvail - 1)
           
            '* and now we can read the bytes out of the pipe and into the byte array
            ReadFile mhPipe, pabytSerialized(0), lBytesAvail, lBytesAvail, ByVal 0&
           
            '* return number of bytes as a courtesy (not actually required)
            SerializeToBytes = lBytesAvail
        End If
    End If
End Function

Public Function DeserializeFromBytes(ByRef abytSerialized() As Byte, ByRef pvDest As Variant) As Long
   
    Dim lBytesWritten As Long
   
    If mhPipe <> 0 And mlFileNumber <> 0 Then

        '* write the byte array to the pipe
        WriteFile mhPipe, abytSerialized(0), UBound(abytSerialized) + 1, lBytesWritten, 0
       
        If lBytesWritten = UBound(abytSerialized) + 1 Then
            '* the pipe contains a byte array serialization of a variant array
            '* we can use VBA's Get statement to read it directly into a variant array variable
            Get mlFileNumber, 1, pvDest
           
            '* report the amount of deserialized Bytes as a courtesy (not actually required)
            DeserializeFromBytes = Loc(mlFileNumber)
        End If
    End If
End Function

Private Sub CleanUp()
    If mlFileNumber Then Close mlFileNumber: mlFileNumber = 0
    If mhPipe Then DisconnectNamedPipe mhPipe
    If mhPipe Then CloseHandle mhPipe: mhPipe = 0
End Sub

Private Sub Class_Terminate()
    CleanUp
End Sub

VBA Standard Module - tstPipedVariants

So now we need some client code. Add a standard module to your VBA project and paste in the following code. I called this module tstPipedVariants.

Sub SamePipeForSerializeAndDeserialize()
    Dim oPipe As cPipedVariants
    Set oPipe = New cPipedVariants
   
    If oPipe.InitializePipe Then
        Dim vSource As Variant
        vSource = TestData

        Dim abytSerialized() As Byte

        Call oPipe.SerializeToBytes(vSource, abytSerialized)

        Stop '* at this point vSource is populated but vDestination is empty

        Dim vDestination As Variant
        oPipe.DeserializeFromBytes abytSerialized, vDestination
   
        Stop
    End If
End Sub

Function TestData() As Variant
    Dim vSource(1 To 2, 1 To 4) As Variant
    vSource(1, 1) = "Hello World"
    vSource(1, 2) = True
    vSource(1, 3) = False
    vSource(1, 4) = Null
    vSource(2, 1) = 65535
    vSource(2, 2) = 7.5
    vSource(2, 3) = CDate("12:00:00 16-Sep-1989") 'now()
    vSource(2, 4) = CVErr(xlErrNA)
    TestData = vSource
End Function

In the module tstPipedVariants run the test code subroutine SamePipeForSerializeAndDeserialize() by navigating and pressing F5 to reach the first Stop statement. On the first Stop statement vSource is populated but vDestination isn’t.

However, the byte array abytSerialized() is populated and we can go inspect this. The first twenty bytes are similar to SafeArray and SafeArrayBounds structures. The first two bytes represent a vbVarType of vbArray+vbVariant in low byte, high byte order. Next, two bytes gives the count of dimensions. Then for each dimension there are 8 bytes, giving a 4 byte dimension size and a 4 byte lower bound. This abridged SafeArray descriptor is most welcome. When VBA code writes a variant array to disk it omits such a descriptor which meant I had to augment the code to manually write in the dimensions. I am very much pleased that the Named Pipes implementation does this automatically for me.

After the first twenty bytes of abridged SafeArray descriptor the rest of the data follows. I wrote this up in the original blog post so I’ll refer you to that and skip the rest.

Returning to the test code, press F5 again to get the second Stop statement and behold in the Locals window the vDestination variable is now populated exactly the same as the vSource variable. Note how we did not need to dimension the vDestination variable before populating it, excellent!

This completes the VBA to VBA demo. We can move onto the JavaScript to VBA use case.

Revisiting the Javascript to VBA use case

JavaScript Changes

In the original article I gave some Javascript code to serialize a Javascript array to a byte array that can then be deserialized to a VBA variant array. This JavaScript code needs modifying to interoperate with the new Named Pipes VBA code given above. The change required is to give a correctly formatted abridged safe array descriptor. This is a simple change found at the top of the JavaScriptToVBAVariantArray.prototype.persistGrid function. All other code remains the same, so no further explanation is required. The JavaScript module remains something loadable into both browser and server JavaScript environments. The Node.js project given in the original blog post can still be used.

I have only included the function that has changed, JavaScriptToVBAVariantArray.prototype.persistGrid; for rest of the JavaScript module listing see the original blog post.

JavaScriptToVBAVariantArray.prototype.persistGrid = function persistGrid(grid, rows, columns) {
	try {
		/* Opening sequence of bytes is a reduced form of SAFEARRAY and SAFEARRAYBOUND
		 * SAFEARRAY       https://docs.microsoft.com/en-gb/windows/win32/api/oaidl/ns-oaidl-safearray
		 * SAFEARRAYBOUND  https://docs.microsoft.com/en-gb/windows/win32/api/oaidl/ns-oaidl-safearraybound
		 */

		var payloadEncoded = new Uint8Array(20);

		// vbArray + vbVariant, lo byte, hi byte
		payloadEncoded[0] = 12; payloadEncoded[1] = 32;

		// number of dimensions, lo byte, hi byte
		payloadEncoded[2] = 2; payloadEncoded[3] = 0;

		// number of columns, 4 bytes, least significant byte first
		payloadEncoded[4] = columns % 256; payloadEncoded[5] = Math.floor(columns / 256);
		payloadEncoded[6] = 0; payloadEncoded[7] = 0;

		// columns lower bound (safearray)
		payloadEncoded[8] = 1; payloadEncoded[9] = 0;
		payloadEncoded[10] = 0; payloadEncoded[11] = 0;

		// number of rows, 4 bytes, least significant byte first
		payloadEncoded[12] = rows % 256; payloadEncoded[13] = Math.floor(rows / 256);
		payloadEncoded[14] = 0; payloadEncoded[15] = 0;

		// rows lower bound (safearray)
		payloadEncoded[16] = 1; payloadEncoded[17] = 0;
		payloadEncoded[18] = 0; payloadEncoded[19] = 0;

		var elementBytes;
		for (var colIdx = 0; colIdx < columns; colIdx++) {
			for (var rowIdx = 0; rowIdx < rows; rowIdx++) {
				elementBytes = this.persistVar(grid[rowIdx][colIdx]);
				var arr = [payloadEncoded, elementBytes];

				payloadEncoded = this.concatArrays(arr); // Browser
			}
		}
		return payloadEncoded;
	}
	catch (err) {
		console.log(err.message);
	}
};

VBA web client code

Turning to the client VBA code we can greatly simplify the code now that the dimensioning is done for us. The resulting code is now trivial, here it is below. Add the following code to the tstPipedVariants module you added earlier. This code below requires you to add a Tools->Reference to Microsoft WinHTTP Services, version 5.1...
Sub TestByWinHTTP()
    '* this calls the Node.js project with the new JavaScript serialization
    Dim oWinHttp As WinHttp.WinHttpRequest '* Tools->References->Microsoft WinHTTP Services, version 5.1
    Set oWinHttp = New WinHttp.WinHttpRequest
    oWinHttp.Open "GET", "http://localhost:1337/", False
    oWinHttp.send
   
    If oWinHttp.Status = 200 Then
        If IsEmpty(oWinHttp.ResponseBody) Then Err.Raise vbObjectError, , "No bytes returned!"
        If UBound(oWinHttp.ResponseBody) = 0 Then Err.Raise vbObjectError, , "No bytes returned!"
       
        Dim oPipedVariants As cPipedVariants
        Set oPipedVariants = New cPipedVariants
        If oPipedVariants.InitializePipe Then
       
            Dim vGrid As Variant
            oPipedVariants.DeserializeFromBytes oWinHttp.ResponseBody, vGrid
           
            Stop '* Observe vGrid in the Locals window
           
            '* vGrid is now ready to paste on a worksheet
        End If
    End If
End Sub

So run this code with the Node.js project running and the vGrid should be populated. That's all folks. Enjoy!

Thanks again

Thanks once again to Olaf Schmidt and the anonymous tipper! Getting help to fix my code is very welcome.

Monday, 23 March 2020

Javascript - Serialize Object to XML on both server and in browser

In this post I give some JavaScript code that takes a JavaScript object variable and serializes it to XML. The code works both on Node.js and in the browser. JavaScript developers frown on XML and will advocate JSON. So an XML solution is difficult to find, I have based this code on a StackOverflow answer.

Background

So, I am again contemplating serialization formats. I want to do some web-scraping and I reiterate that Excel Developers should not do this in VBA but instead in a Chrome Extension which is a JavaScript program running in the Chrome Browser. A Chrome Extension can scrape some information and then pass this along as a payload to a web server by calling out with an HTTP POST request. The receiving web server ought to a simple local server dedicated to listening for that particular Chrome Extension. Previously on this blog, I have given code where a C# component running in Excel can serve as a web server; in that example the payload was in JSON format.

A while back on this blog I went crazy for JavaScript once I found the ScriptControl can parse JSON into an object query-able by VBA code. I have since cooled on this JSON/ScriptControl design pattern and have realised I still have a soft spot for XML, mainly for the inbuilt XML parser with which all VBA developers will be familiar. But as mentioned above Javascript developers prefer JSON and so you won't find many examples of serialization to XML out there. So below is some working code based on a StackOverflow answer.

Unifying Browser and Node.js development

I find JavaScript development quite challenging as I'm never sure I'm using the optimal development environment. Using Node.js in Visual Studio is very good but I do not know how to get Visual Studio to attach and debug client side code. To debug client side code I use Chrome's good debugger tools and Notepad++ (I know) or Visual Studio Code. I find I write code in two different styles for each environment. I'd like to write code once for both client and server and for that I have a trick to show you.

By modularizing the code in separate files or modules a JavaScript project can be broken up into more manageable pieces. To control visibility of a module's code to outside callers we use the module.exports construct but this is not available in the browser so we have to add the code to the browser's Window object instead. This is all explained in this article Writing JavaScript modules for both Browser and Node.js by Matteo Agosti.

In the article Matteo Agosti gives a JavaScript class (don't be misled by JavaScript's odd class-by-prototype syntax) in a separate file and it uses the module.exports to make it visible to other files/modules. The code Matteo gives has an encompassing IIFE (Immediately Invoked Function Expression) to determine if running in a browser or not. This IIFE syntax and also the class-by-prototype syntax can be a little confusing and I'd recommend copying, pasting and editing for your own purposes and this is what I did for me.

The code

Node.js dependencies

The code below adds value in that it will run in a Node.js project as well as a browser. Any Node.js project will require the following npm packages installed:

  • xmldom
  • xmlserializer

Test object

An object called foo is created in JavaScriptObjectToXml.prototype.testJavascriptObjectToXml()

                var foo = new Object();
                foo.prop1 = "bar";
                foo.prop2 = "baz";

                foo.objectArray = [];
                var subObject = new Object();
                subObject.laugh = "haha";
                foo.objectArray.push(subObject);
                var subObject1 = new Object();
                subObject1.greeting = "hello";
                foo.objectArray.push(subObject1);

                foo.numberArray = [];
                foo.numberArray.push(0);
                foo.numberArray.push(1);
                foo.numberArray.push(2);

and a JSON representation of this object would be

{"prop1":"bar","prop2":"baz","objectArray":[{"laugh":"haha"},{"greeting":"hello"}],"numberArray":[0,1,2]}

but an XML reprentation would be

<foo xmlns="null" prop1="bar" prop2="baz">
<objectArray>
<objectArray-0 laugh="haha"/>
<objectArray-1 greeting="hello"/>
</objectArray>
<numberArray numberArray-0="0" numberArray-1="1" numberArray-2="2"/>
</foo>

Code Listings

And so here are the full listings:

JavaScriptObjectToXml.js - this is the serialization logic

'use strict';

// module exporting for node.js and browsers with thanks to
// https://www.matteoagosti.com/blog/2013/02/24/writing-javascript-modules-for-both-browser-and-node/

(function () {
    var JavaScriptObjectToXml = (function () {
        var JavaScriptObjectToXml = function (options) {
            var pass; //...
        };

        JavaScriptObjectToXml.prototype.testJavascriptObjectToXml = function testJavascriptObjectToXml() {
            try {
                // debugger;  /* uncomment this line for a breakpoint for both node.js and the browser */
                var foo = new Object();
                foo.prop1 = "bar";
                foo.prop2 = "baz";

                foo.objectArray = [];
                var subObject = new Object();
                subObject.laugh = "haha";
                foo.objectArray.push(subObject);
                var subObject1 = new Object();
                subObject1.greeting = "hello";
                foo.objectArray.push(subObject1);

                foo.numberArray = [];
                foo.numberArray.push(0);
                foo.numberArray.push(1);
                foo.numberArray.push(2);

                //console.log(JSON.stringify(foo));

                var retval = this.javascriptObjectToXml(foo, 'foo');
                console.log(retval);
                return retval;
            }
            catch (err) {
                console.log(err.message);
            }
        };

        JavaScriptObjectToXml.prototype.javascriptObjectToXml = function javascriptObjectToXml(obj, objName) {
            try {
                var rootNodeName = 'root';
                var xmlDoc = this.createXmlDocumentRoot(rootNodeName);
                this.serializeNestedNodeXML(xmlDoc, xmlDoc.documentElement, objName, obj);
                return this.getXmlSerializer().serializeToString(xmlDoc.documentElement.firstChild);
            }
            catch (err) {
                console.log(err.message);
            }
        };

        JavaScriptObjectToXml.prototype.createXmlDocumentRoot = function createXmlDocumentRoot(rootNodeName) {
            try {
                var xmlDoc;
                if (typeof document !== 'undefined') {
                    /* for browsers where document is available */
                    xmlDoc = document.implementation.createDocument(null, rootNodeName, null);
                }
                else {
                    /* for node.js code, needs npm install xmldom */
                    var DOMParser = require('xmldom').DOMParser;
                    xmlDoc = new DOMParser().parseFromString('<' + rootNodeName + '/>');
                }
                return xmlDoc;
            }
            catch (err) {
                console.log(err.message);
            }
        };

        JavaScriptObjectToXml.prototype.getXmlSerializer = function getXmlSerializer() {
            try {
                if (typeof document !== 'undefined') {
                    /* for browsers */
                    return new XMLSerializer();
                }
                else {
                    /* for node.js code, needs npm install xmlserializer */
                    return require('xmlserializer');
                }
            }
            catch (err) {
                console.log(err.message);
            }
        };

        JavaScriptObjectToXml.prototype.serializeNestedNodeXML = function serializeNestedNodeXML (xmlDoc, parentNode, newNodeName, obj) {
            /* based on StackOverflow answer
            /  https://stackoverflow.com/questions/19772917/how-to-convert-or-serialize-javascript-data-object-or-model-to-xml-using-ext#answer-48967287
            /  by StackOverflow user https://stackoverflow.com/users/355272/martin   */
            try {
                if (Array.isArray(obj)) {
                    var xmlArrayNode = xmlDoc.createElement(newNodeName);
                    parentNode.appendChild(xmlArrayNode);

                    for (var idx = 0, length = obj.length; idx < length; idx++) {
                        serializeNestedNodeXML(xmlDoc, xmlArrayNode, newNodeName + '-' + idx, obj[idx]);
                        //console.log(obj[idx]);
                    }

                    return;     // Do not process array properties
                } else if (typeof obj !== 'undefined') {
                    var objType = typeof obj;
                    switch (objType) {
                        case 'string': case 'number': case 'boolean':
                            parentNode.setAttribute(newNodeName, obj);
                            break;
                        case 'object':
                            var xmlProp = xmlDoc.createElement(newNodeName);
                            parentNode.appendChild(xmlProp);
                            for (var prop in obj) {
                                serializeNestedNodeXML(xmlDoc, xmlProp, prop, obj[prop]);
                            }
                            break;
                    }
                }
            }
            catch (err) {
                console.log(err.message);
            }
        };

        return JavaScriptObjectToXml;
    })();

    if (typeof module !== 'undefined' && typeof module.exports !== 'undefined')
        module.exports = JavaScriptObjectToXml;
    else
        window.JavaScriptObjectToXml = JavaScriptObjectToXml;
})();

server.js - this is web server file

'use strict';

{
    try {
        var JavaScriptObjectToXml = require('./JavaScriptObjectToXml');
        var v = new JavaScriptObjectToXml();
        var fooAsXml = v.testJavascriptObjectToXml();
    }
    catch (err) {
        console.log('Could not find JavaScripObjectToXml.js module:' + err.message);
    }
}

require('http').createServer(function (req, res) {
    try {
        var q = require('url').parse(req.url, true);
        if (q.pathname === '/') {
            /* it's the request for our serialized xml */
            res.writeHead(200, { 'Content-Type': 'text/xml' });
            res.end(fooAsXml + 'n');
        }
        else {
            var filename = "." + q.pathname;
            var fs = require('fs');
            fs.readFile(filename, function (err, data) {
                if (err) {
                    res.writeHead(404, { 'Content-Type': 'text/html' });
                    return res.end("404 Not Found");
                }
                res.writeHead(200, { 'Content-Type': 'text/html' });
                res.write(data);
                return res.end();
            });
        }
    }
    catch (err) {
        console.log(err.message);
    }
}).listen(process.env.PORT || 1337);

HtmlPage.html - this is for serving to the client

<!DOCTYPE html>

<html xmlns="http://www.w3.org/1999/xhtml">
<head>
    <meta charset="utf-8" />
    <title></title>
</head>
<body>
    <p><span style="font-family:Courier New, Courier, monospace">Look in the console!  
        Do this by right-click menu and then Inspect to get the DevTools window 
        then click on the Console tab</span></p>
    <script src="JavaScriptObjectToXml.js"></script>
    <script>
        var v = new JavaScriptObjectToXml();
        var fooAsXml = v.testJavascriptObjectToXml();
    </script>
</body>
</html>

Some VBA test client code to ensure XML does parse in VBA/MSXML parser library.

Option Explicit

Sub Test()

    Dim xhr As MSXML2.XMLHTTP60
    Set xhr = New MSXML2.XMLHTTP60
    xhr.Open "GET", "http://localhost:1337/", False
    xhr.send
    
    Debug.Print xhr.responseText
    Dim xmlDoc As MSXML2.DOMDocument60
    Set xmlDoc = New MSXML2.DOMDocument60
    Debug.Assert xmlDoc.LoadXML(xhr.responseText) '* true means it parsed fine

End Sub

Running the code

So the above files are to be placed into a Visual Studio instance with a blank Node.js project and press F5 and the Xml representation should appear in both the command line window spawned by Visual Studio and in the browser spawned by Visual Studio. This proves it works on the server. To see it working on the client side change the address in the browser to point to http://localhost:1337/HtmlPage.html and then look in Chrome's console (instructions are on the web page).

Final Thoughts

I'm still not totally happy with serialization formats. I'd love to get something from a webservice and paste directly onto an Excel worksheet. I need to think about this.

Unifying browser and server code should be a good win that will pay dividends in the long run so I am happy about that.

In the meantime, enjoy!

Friday, 20 October 2017

VBA - Fast Serialization of Cells to JSON

As a counterpart to the previous post serializing cells to Excel's array literal string here I present serialization to JSON.

We ought to remind ourselves how to parse a JSON array with built in Microsoft ScriptControl thus ...


Sub IllustratingJSONParsing()
    '* Tools->References->Microsoft Script Control 1.0   (msscript.ocx)
    Dim oScriptControl As MSScriptControl.ScriptControl
    Set oScriptControl = New MSScriptControl.ScriptControl
    oScriptControl.Language = "javascript"
    
    Dim oParsed As Object
    Set oParsed = oScriptControl.Eval("([[""a"",""b"",3],[""d"",5.1,""f""]])")
    
    Debug.Assert CallByName(oParsed, "length", VbGet) = 2
    
    Dim oRow0 As Object
    Set oRow0 = CallByName(oParsed, 0, VbGet)
    Debug.Assert CallByName(oRow0, "length", VbGet) = 3
    Debug.Assert CallByName(oRow0, "0", VbGet) = "a"
    Debug.Assert CallByName(oRow0, "1", VbGet) = "b"
    Debug.Assert CallByName(oRow0, "2", VbGet) = 3
    
    Dim oRow1 As Object
    Set oRow1 = CallByName(oParsed, 1, VbGet)
    Debug.Assert CallByName(oRow1, "length", VbGet) = 3
    Debug.Assert CallByName(oRow1, "0", VbGet) = "d"
    Debug.Assert CallByName(oRow1, "1", VbGet) = 5.1
    Debug.Assert CallByName(oRow1, "2", VbGet) = "f"
End Sub

And the code to serialize is very similar to the previous post and is fast because it uses Mid$ as a left hand side operator. Enjoy!


Option Explicit

'VBA - Fast Serialization of Cells to JSON


Function GetRangeJSON(ByVal rngSource As Excel.Range)
    Const CELL_LENGTH = 257 'Add 2 for double quotes
    
    With rngSource
        Dim lRows As Long
        lRows = .Rows.Count
        
        Dim lColumns As Long
        lColumns = .Columns.Count
        
        Dim lBufferSize As Long
        lBufferSize = CELL_LENGTH * .Cells.Count + lRows + (lRows * lColumns)
    End With
    
    '* initialise the buffer with spaces then start opening brace
    Dim sText As String
    sText = VBA.Space(lBufferSize)
    
    Dim lCursor As Long
    lCursor = 1
    Mid$(sText, lCursor, 1) = "["
    
    Dim vData()
    vData = rngSource.Value

    Dim lRow As Long
    For lRow = 1 To lRows
    
    
        '* if past first row then we need a row continuation
        If lRow > 1 Then
            lCursor = lCursor + 1
            Mid$(sText, lCursor, 1) = ","
        End If

        lCursor = lCursor + 1
        Mid$(sText, lCursor, 1) = "["


        Dim lColumn As Long
        For lColumn = 1 To lColumns
            
            Dim vCell As Variant
            vCell = vData(lRow, lColumn)
            
            Dim lCellLength As Long
            lCellLength = Len(vCell)
            
            '* extend buffer if necessary
            If lCursor + lCellLength + 2 > Len(sText) Then sText = sText & Space(CDbl(lBufferSize / 4))
            
            '* if past first column then we need a cell continuation
            If lColumn > 1 Then
                lCursor = lCursor + 1
                Mid(sText, lCursor, 1) = ","
            End If

    
            '* write in value directly into buffer, wrap quotes around strings
            If (VBA.TypeName(vCell) = "String") Then
                lCellLength = lCellLength + 2
                Mid$(sText, lCursor + 1, lCellLength) = """" & vCell & """"
            Else
                Mid$(sText, lCursor + 1, lCellLength) = vCell
            End If
            
            '* increment cursor
            lCursor = lCursor + lCellLength
        Next
        
        lCursor = lCursor + 1
        Mid$(sText, lCursor, 1) = "]"
        
    Next

    GetRangeJSON = Left$(sText, lCursor) & "]"
End Function

Function TestGetRangeJson()
    
    Dim rng As Excel.Range
    Set rng = ThisWorkbook.Worksheets.Item(4).Range("c3:e4")
    rng.Cells(1, 1) = "a"
    rng.Cells(1, 2) = "b"
    rng.Cells(1, 3) = 3
    rng.Cells(2, 1) = "d"
    rng.Cells(2, 2) = 5.1
    rng.Cells(2, 3) = "f"
    
    Dim sRange As String
    sRange = GetRangeJSON(rng)
    
    Debug.Assert sRange = "[[""a"",""b"",3],[""d"",5.1,""f""]]"
    
    Dim oScriptControl As MSScriptControl.ScriptControl
    Set oScriptControl = New MSScriptControl.ScriptControl
    oScriptControl.Language = "javascript"
    
    Dim oParsed As Object
    Set oParsed = oScriptControl.Eval(sRange)
    
    
    Debug.Assert CallByName(oParsed, "length", VbGet) = 2
    
    Dim oRow0 As Object
    Set oRow0 = CallByName(oParsed, 0, VbGet)
    Debug.Assert CallByName(oRow0, "length", VbGet) = 3
    Debug.Assert CallByName(oRow0, "0", VbGet) = "a"
    Debug.Assert CallByName(oRow0, "1", VbGet) = "b"
    Debug.Assert CallByName(oRow0, "2", VbGet) = 3
    
    Dim oRow1 As Object
    Set oRow1 = CallByName(oParsed, 1, VbGet)
    Debug.Assert CallByName(oRow1, "length", VbGet) = 3
    Debug.Assert CallByName(oRow1, "0", VbGet) = "d"
    Debug.Assert CallByName(oRow1, "1", VbGet) = 5.1
    Debug.Assert CallByName(oRow1, "2", VbGet) = "f"
    
    
End Function


Wednesday, 18 October 2017

VBA - Fast Serialization of Cells to Array Literal String

Today on StackOverflow I saw a great answer which utilizes Mid$() as a left hand operator to write into a string buffer. Concatenating strings is always slow and this is why languages such as C# and Java have a StringBuilder class. Using Mid$() on the left hand side of an assignment is VBA's equivalent of StringBuilder.

We can use this Mid$ (StringBuilder) to very quickly serialize a block of cells to an array literal which can be used to save fragments to file or for marshalling across to a web service

As a reminder array literal strings can be passed to Application.Evaluate and so parsed into an array ready to be pasted to cells. They are quite a simple format, the columns are comma separated and the rows semi-colon sepated, strings are quoted and the whole block is wrapped into curly brackets thus ...


Sub IllustratingApplicationEvaluateAndLiterals()
    
    Dim v As Variant
    v = Application.Evaluate("{""a"",""b"",3;""d"",5.1,""f""}")
    
    Debug.Assert v(1, 1) = "a"
    Debug.Assert v(1, 2) = "b"
    Debug.Assert v(1, 3) = 3
    Debug.Assert v(2, 1) = "d"
    Debug.Assert v(2, 2) = 5.1
    Debug.Assert v(2, 3) = "f"
    
End Sub

So now some code to take cells and serialize into an array literal string



Function GetRangeLiteral(ByVal rngSource As Excel.Range)
    Const CELL_LENGTH = 257 'Add 2 for double quotes
    
    With rngSource
        Dim lRows As Long
        lRows = .Rows.Count
        
        Dim lColumns As Long
        lColumns = .Columns.Count
        
        Dim lBufferSize As Long
        lBufferSize = CELL_LENGTH * .Cells.Count + lRows + (lRows * lColumns)
    End With
    
    '* initialise the buffer with spaces then start opening brace
    Dim sText As String
    sText = VBA.Space(lBufferSize)
    Mid$(sText, 1, 1) = "{"
    
    Dim lCursor As Long
    lCursor = 1
    
    Dim vData()
    vData = rngSource.Value

    Dim lRow As Long
    For lRow = 1 To lRows
    
        '* if past first row then we need a row continuation
        If lRow > 1 Then
            lCursor = lCursor + 1
            Mid$(sText, lCursor, 1) = ";"
        End If

        Dim lColumn As Long
        For lColumn = 1 To lColumns
            
            Dim vCell As Variant
            vCell = vData(lRow, lColumn)
            
            Dim lCellLength As Long
            lCellLength = Len(vCell)
            
            '* extend buffer if necessary
            If lCursor + lCellLength + 2 > Len(sText) Then sText = sText & Space(CDbl(lBufferSize / 4))
            
            '* if past first column then we need a cell continuation
            If lColumn > 1 Then
                lCursor = lCursor + 1
                Mid(sText, lCursor, 1) = ","
            End If

    
            '* write in value directly into buffer, wrap quotes around strings
            If (VBA.TypeName(vCell) = "String") Then
                lCellLength = lCellLength + 2
                Mid$(sText, lCursor + 1, lCellLength) = """" & vCell & """"
            Else
                Mid$(sText, lCursor + 1, lCellLength) = vCell
            End If
            
            '* increment cursor
            lCursor = lCursor + lCellLength
        Next
    Next

    GetRangeLiteral = Left$(sText, lCursor) & "}"
End Function

Function TestGetRangeLiteral()
    
    Dim rng As Excel.Range
    Set rng = ThisWorkbook.Worksheets.Item(4).Range("c3:e4")
    rng.Cells(1, 1) = "a"
    rng.Cells(1, 2) = "b"
    rng.Cells(1, 3) = 3
    rng.Cells(2, 1) = "d"
    rng.Cells(2, 2) = 5.1
    rng.Cells(2, 3) = "f"
    
    Dim sRange As String
    sRange = GetRangeLiteral(rng)
    
    Debug.Assert sRange = "{""a"",""b"",3;""d"",5.1,""f""}"
    
    Dim v As Variant
    v = Application.Evaluate(sRange)
    Debug.Assert v(1, 1) = "a"
    Debug.Assert v(1, 2) = "b"
    Debug.Assert v(1, 3) = 3
    Debug.Assert v(2, 1) = "d"
    Debug.Assert v(2, 2) = 5.1
    Debug.Assert v(2, 3) = "f"
    
End Function