Monday 12 March 2018

VBA - C# - Excel as a Web Server with REST interface

Summary: Use a C# addin to give the multi-threading necessary to turn Excel into a web server and build logic in Excel VBA to handle REST requests.

So I am quite proud of this piece of work, I am interested in Excel VBA inter-operating with the Internet as a client and so using MSXML2.XMLHTTP60 for XHR and Internet Explorer for web-scraping. But this piece of work turns the tables, and Excel.exe becomes a web server. It uses a C# addin which serves static files and also forwards REST requests to Excel VBA.

Because this is a larger than normal piece of work I thought I'd make videos instead of typing out a very long script. The videos can be found here on Youtube. But here on this page one can find the source files.

Home.html


<!DOCTYPE html>

<html lang="en" xmlns="http://www.w3.org/1999/xhtml">
<head>
    <script src="https://ajax.googleapis.com/ajax/libs/angularjs/1.6.9/angular.min.js"></script>
    <style>

        .noselect {
            -webkit-touch-callout: none; 
            -webkit-user-select: none; 
            -moz-user-select: none; 
            -ms-user-select: none; 
            user-select: none; 
        }


        .flex-container {
            display: flex;
            flex-direction: column;
            background-color: goldenrod;
            width: 320px;
        }

            .flex-container > div {
                background-color: darkgoldenrod;
                width: 96%;
                margin: 2%;
            }

                .flex-container > div > div {
                    width: 96%;
                    margin: 2%;
                }


    </style>
    <title>Welcome to the Foo Bar!</title>
</head>
<body class="noselect" style="cursor: default">
    <div class="flex-container" ng-app="myApp" ng-controller="myCtrl">
        <!--* ng-init="beers=[{"Brand":"Bud","Country":"US"},{"Brand":"Coors","Country":"canada"}]" */-->
        <div >
            <div>
                <h2>Welcome to the Foo Bar!</h2>
            </div>
        </div>
        <div>
            <div>
                <div style="width:100%">Today's top beer is: <span ng-bind="todaysTopBeers"></span><br /></div>
                <div>news:<span ng-bind="status"></span><br /></div>
                <div><button ng-click="takeDelivery()">Take Delivery</button></div>
            </div>
        </div>
        <div>
            <table class="beerTable" style="background-color:darkgoldenrod; width:300px">
                <tr>
                    <th>Brand</th>
                    <th>Country</th>
                </tr>
                <thead></thead>
                <tbody>
                    <tr ng-repeat="beer in beers">
                        <td>{{ beer.Brand }}</td>
                        <td>{{ beer.Country }}</td>
                        <td ng-click="deleteBeer(beer.Brand)" onmouseover="this.style.color='red';"
                            onmouseout="this.style.color='black';">
                            ×
                        </td>
                    </tr>
                </tbody>
            </table>
        </div>
        <div>
            <div>
                <span>Add another beer</span>
                <table>
                    <tr><td style="width:80px">Brand:</td><td><input type="text" ng-model="addBeer.Brand"></td></tr>
                    <tr><td style="width:80px">Country:</td><td><input type="text" ng-model="addBeer.Country"></td></tr>
                </table>
                <br>
                <button ng-click="postBeer()">Add</button>
            </div>
        </div>
    </div>

    <script>
        var app = angular.module('myApp', []);
        app.controller('myCtrl', function ($scope, $http) {

            $scope.takeDelivery = function () {
                $http.post("/theFooBar/deliveries/")
                    .then(function successCallback(response) {

                        $scope.status = "a delivery has been made";
                        $scope.getBeers();

                    }, function errorCallback(data) {
                        $scope.status = data;
                        console.log("error");
                    });
            };

            $scope.postBeer = function () {
                var data = $scope.addBeer;
                $http.post("/theFooBar/beers/", data)
                    .then(function successCallback(response) {

                        $scope.status = "updated beer";
                        $scope.getBeers();

                    }, function errorCallback(data) {
                        $scope.status = data;
                        console.log("error");
                    });
            };

            $scope.putBeer = function () {
                var data = $scope.addBeer;
                $http.put("/theFooBar/beers/", data)
                    .then(function successCallback(response) {

                        $scope.status = "updated beer";

                    }, function errorCallback(data) {
                        $scope.status = data;
                        console.log("error");
                    });
            };

            $scope.getBeers = function () {
                $http.get("/theFooBar/beers/")
                    .then(function successCallback(response) {

                        
                        $scope.beers = response.data;
                        $scope.todaysTopBeers = $scope.beers[0].Brand + ' ' + $scope.beers[0].Country + '!';

                    }, function errorCallback(data) {
                        $scope.status = data;
                        console.log("error");
                    });
            }
            $scope.getBeers(); // run this first time

            $scope.deleteBeer = function (beerName) {
                $http.delete("/theFooBar/beers/" + beerName)
                    .then(function successCallback(response) {

                        $scope.status = beerName + " is finished";

                        var lookupBeer = $scope.lookupBeer($scope.beers, beerName);
                        if (lookupBeer !== -1) { $scope.beers.splice(lookupBeer, 1); }
                        if ($scope.beers.length > 0) {
                            $scope.todaysTopBeers = $scope.beers[0].Brand + ' ' + $scope.beers[0].Country + '!';
                        } else {
                            $scope.todaysTopBeers = "";
                        }

                    }, function errorCallback(data) {
                        $scope.status = data;
                        console.log("error");
                    });
            }

            $scope.lookupBeer =
                function lookupBeer(beers, beerBrand) {
                    for (var i = 0; i < beers.length; i++) {
                        var beerLoop = beers[i];
                        if (beerLoop.Brand === beerBrand) {
                            return i;
                        }
                    }
                    return -1;
                }
        });
    </script>
</body>
</html>

VBA standard module modHttpRequest.bas


Option Explicit

'* Tools->References
'MSScriptControl    Microsoft Script Control 1.0    C:\Windows\SysWOW64\msscript.ocx
'Scripting          Microsoft Scripting Runtime     C:\Windows\SysWOW64\scrrun.dll
'MSXML2             Microsoft XML, v6.0             C:\Windows\SysWOW64\msxml6.dll

Private moBeers As Object '*JScriptTypeInfo


'---------------------------------------------------------------------------------------
' Procedure : HttpRequest
' DateTime  : 02/03/2018 08:39
' Author    : Simon
' Purpose   : This is called by the ExcelWebAddin, it features all that you'd expect
'             for servicing a web request:
'             * the url (parsed into components)
'             * the query string (parsed into key value pairs)
'             * any posted data
'             * the request headers and cookies
'             * the response headers and cookies
'
'             The query string, request headers and request cookies dictionaries are purely
'             informational only, adding entries to any of these does nothing.
'
'             The response headers and response cookies dictionaries are to be written to
'             but there is no need to create a new Dictionary, simply add entries to
'             those that have been passed
'
'---------------------------------------------------------------------------------------
' Arguments :
'   dicUrl[in]                  : a dictionary of properties relating to the url and its components
'   sHttpMethod[in]             : the HTTP method, GET, PUT, POST, DELETE etc.
'   dicQueryString[in]          : a dictionary containing the query string as key-value pairs
'   bHasBody[in]                : a boolean to signal presence of posted data
'   abBody[in]                  : a byte array containing any posted data
'   dicRequestHeaders[in]       : a dictionary containing request headers
'   dicRequestCookies[in]       : a dictionary containing request cookies
'   dicResponseHeaders[in,out]  : a dictionary to be written to in order to set response headers
'   dicResponseCookies[in,out]  : a dictionary to be written to in order to set response cookies
'   dicStatusCode[in,out]       : a dictionary to be written to in order to set response status code
'   retval[out,retval]          : a string, the HTML, XML, JSON or text that fulfils the request
'
Public Function HttpRequest(ByVal dicUrl As Dictionary, ByVal sHttpMethod As String, _
                    ByVal dicQueryString As Dictionary, _
                    ByVal bHasBody As Boolean, ByRef abBody() As Byte, _
                    ByVal dicRequestHeaders As Dictionary, ByVal dicRequestCookies As Dictionary, _
                    ByVal dicResponseHeaders As Dictionary, ByVal dicResponseCookies As Dictionary, _
                    ByVal dicStatusCode As Dictionary) As String
    
    Dim vUrlSegments As Variant
    vUrlSegments = dicUrl.Item("Segments").Items()
    
    If bHasBody Then
        Dim sBody As String
        sBody = StrConv(abBody, vbUnicode)
    End If
    
    '* next line can be commented out, it is here to demonstrate the richness of the request parameters
    DumpRequestInfo dicUrl, sHttpMethod, dicQueryString, dicRequestHeaders, dicRequestCookies


    '* next lines sets the return value, it contains the document that fulfiles the webrequest
    '* choose one

'    HttpRequest = "Hello world"  '* plain text
'    dicResponseHeaders.Add "Content-Type", "text/plain"
    
'    HttpRequest = "<html><body>Hello world</body></html>"  '* Html
'    dicResponseHeaders.Add "Content-Type", "text/html"

'    HttpRequest = "<xmlDoc><xmlEle>Hello world</xmlEle></xmlDoc>"  '* Xml
'    dicResponseHeaders.Add "Content-Type", "application/xml"
    
    If StrComp(Left$(dicUrl.Item("AbsolutePath"), Len("/theFooBar/beers/")), "/theFooBar/beers/", vbTextCompare) = 0 Then
        '* we're here for the beer :)
        
        '* response governed by https://tools.ietf.org/html/rfc7231#section-4.3
        
        Select Case sHttpMethod
        Case "GET":
        
            HttpRequest = ScriptControl.Run("JSON_stringify", moBeers)
            
            dicResponseHeaders.Add "Content-Type", "application/json"
            dicStatusCode.Add 200, 0
        Case "POST":
            Dim oNewBeer As Object
            Set oNewBeer = ScriptControl.Run("JSON_parse", sBody)
        
            Call ScriptControl.Run("addBeer", moBeers, oNewBeer)
            'Stop
            dicStatusCode.Add 201, 0
        
        Case "PUT":
        
            Dim oUpdateBeer As Object
            Set oUpdateBeer = ScriptControl.Run("JSON_parse", sBody)
    
            Call ScriptControl.Run("updateBeer", moBeers, oUpdateBeer)
        
            'Stop
            dicStatusCode.Add 200, 0
        Case "DELETE":

            Call ScriptControl.Run("deleteBeer", moBeers, CStr(vUrlSegments(3))) '* seems to need CStr()
            HttpRequest = vbNullString '* empty https://stackoverflow.com/questions/25970523/restful-what-should-a-delete-response-body-contain#25970628
            dicStatusCode.Add 204, 0
            'Stop
        End Select
    ElseIf StrComp(Left$(dicUrl.Item("AbsolutePath"), Len("/theFooBar/deliveries/")), "/theFooBar/deliveries/", vbTextCompare) = 0 Then
    
        Select Case sHttpMethod
        Case "GET": '* no implementation
        Case "POST":
            '* a delivery was made all beers back on the menu
            Set moBeers = ScriptControl.Run("JSON_parse", DefaultBeerTable)
            dicStatusCode.Add 200, 0
        
        Case "PUT": '* no implementation
        Case "DELETE": '* no implementation
        End Select
    
    
    Else
        dicStatusCode.Add 404, 0
    
    
    End If

    
    '* next lines illustrate setting response headers and response cookies
    'dicResponseCookies.Add "UserName", Environ$("username")
    'dicResponseHeaders.Add "Server", "ExcelVBA: " & ThisWorkbook.Name
    'dicResponseHeaders.Add "Foo", "Bar"
End Function


'---------------------------------------------------------------------------------------
' Procedure : ScriptControl
' DateTime  : 03/03/2018 16:28
' Author    : Simon
' Purpose   : This creates a ScriptControl for containing Javascript functions
'---------------------------------------------------------------------------------------
' Arguments :
'    [out,retval]   : the scriptcontrol Javascript container populated with essential functions
'
Private Function ScriptControl() As ScriptControl
    Static oScriptControl As ScriptControl
    If oScriptControl Is Nothing Then
        Set oScriptControl = New ScriptControl
        oScriptControl.Language = "JScript"
            
        oScriptControl.AddCode "function deleteValueByKey(obj,keyName) { delete obj[keyName]; } "
        oScriptControl.AddCode "function setValueByKey(obj,keyName, newValue) { obj[keyName]=newValue; } "
        oScriptControl.AddCode "function enumKeysToMsDict(jsonObj,msDict) { for (var i in jsonObj) { msDict.Add(i,0); }  } "
        oScriptControl.AddCode GetJavaScriptLibrary("https://raw.githubusercontent.com/douglascrockford/JSON-js/master/json2.js")
        oScriptControl.AddCode "function JSON_stringify(value, replacer,spacer) { return JSON.stringify(value, replacer,spacer); } "
        oScriptControl.AddCode "function JSON_parse(sJson) { return JSON.parse(sJson); } "
        
        
        '* using a separate variable to populate first,
        '* which is not strictly necessary but I like the
        '* prettiness of the alignment/justification
        Dim sProg As String
                
        sProg = "function lookupBeer(beers, beerBrand) {" & _
                "   for (var i = 0; i < beers.length; i++) {" & _
                "        var beerLoop = beers[i];" & _
                "        if (beerLoop.Brand === beerBrand) {" & _
                "            return i;" & _
                "        }" & _
                "    }" & _
                "    return -1;" & _
                "}"
        oScriptControl.AddCode sProg
        
        sProg = "function deleteBeer(beers, beerName) { " & _
                "   var lookup = lookupBeer(beers, beerName);" & _
                "   if (lookup !== -1) { beers.splice(lookup, 1); }" & _
                "}"
        oScriptControl.AddCode sProg
        
        sProg = "function addBeer(beers, newBeer) { " & _
                "   var lookup = lookupBeer(beers, newBeer.Brand);" & _
                "   if (lookup === -1) { beers.push(newBeer); }" & _
                "}"
        oScriptControl.AddCode sProg
        
        sProg = "function updateBeer(beers, newBeer) { " & _
                "   var lookup = lookupBeer(beers, newBeer.Brand);" & _
                "   if (lookup !== -1) { beers[lookup]=newBeer; }" & _
                "}"
        oScriptControl.AddCode sProg
        
        Set moBeers = oScriptControl.Run("JSON_parse", DefaultBeerTable)
    End If
    Set ScriptControl = oScriptControl

End Function


'---------------------------------------------------------------------------------------
' Procedure : GetJavaScriptLibrary
' DateTime  : 03/03/2018 16:27
' Author    : Simon
' Purpose   :
'---------------------------------------------------------------------------------------
' Arguments :
'    sURL[in]     : the url of the javascript library to download
'    [out,retval] : the source code of the javascript library
'
Private Function GetJavaScriptLibrary(ByVal sURL As String) As String

    Dim xHTTPRequest As MSXML2.XMLHTTP60
    Set xHTTPRequest = New MSXML2.XMLHTTP60
    xHTTPRequest.Open "GET", sURL, False
    xHTTPRequest.send
    GetJavaScriptLibrary = xHTTPRequest.responseText

End Function

'---------------------------------------------------------------------------------------
' Procedure : DefaultBeerTable
' DateTime  : 03/03/2018 16:26
' Author    : Simon
' Purpose   : we need to start out with some data so here is a JSON strings which is
'             an array of beers
'---------------------------------------------------------------------------------------
' Arguments :
'    [out,retval]   : a JSON string which contains default entries
'
Private Function DefaultBeerTable() As String
    DefaultBeerTable = "[{""Brand"": ""Budweiser"", ""Country"":""US""}, {""Brand"": ""Tsingtao"", ""Country"":""China""}," & _
                      "{""Brand"": ""Heineken"", ""Country"": ""Holland""}, {""Brand"": ""Brahma"", ""Country"":""Brazil""}]"
End Function

'---------------------------------------------------------------------------------------
' Procedure : DumpRequestInfo
' DateTime  : 02/03/2018 10:20
' Author    : Simon
' Purpose   : outputs to immediate window all the richness of the request parameters
'---------------------------------------------------------------------------------------
' Arguments :
'   dicUrl[in]                  : a dictionary of properties relating to the url and its components
'   sHttpMethod[in]             : the HTTP method, GET, PUT, POST, DELETE etc.
'   dicQueryString[in]          : a dictionary containing the query string as key-value pairs
'   dicRequestHeaders[in]       : a dictionary containing request headers
'   dicRequestCookies[in]       : a dictionary containing request cookies
'
Private Sub DumpRequestInfo(ByVal dicUrl As Dictionary, ByVal sHttpMethod As String, _
                    ByVal dicQueryString As Dictionary, _
                    ByVal dicRequestHeaders As Dictionary, ByVal dicRequestCookies As Dictionary)
    
    Debug.Print "****" & vbNewLine & "URL:" & vbNewLine & DictionaryToString(dicUrl) & vbNewLine
    'Debug.Print "****" & vbNewLine & Pad("HTTP:", 32) & sHttpMethod & vbNewLine
    'Debug.Print "****" & vbNewLine & "QUERYSTRING:" & vbNewLine & DictionaryToString(dicQueryString) & vbNewLine
    'Debug.Print "****" & vbNewLine & "REQUESTHEADERS:" & vbNewLine & DictionaryToString(dicRequestHeaders) & vbNewLine
    'Debug.Print "****" & vbNewLine & "REQUESTCOOKIES:" & vbNewLine & DictionaryToString(dicRequestCookies) & vbNewLine
    
    
End Sub

'---------------------------------------------------------------------------------------
' Procedure : DictionaryToString
' DateTime  : 02/03/2018 10:03
' Author    : Simon
' Purpose   : routine to help pretty print a dictionary's contents
'---------------------------------------------------------------------------------------
' Arguments :
'   dic[in]        : the dictionary whose contents we want to print
'   sDelimiter[in] : typically a new line
'   lPadKey[in]    : used to justifty/align
'   [out,retval]   : the string representation of the dictionary
'
Private Function DictionaryToString(ByVal dic As Scripting.Dictionary, _
                            Optional ByVal sDelimiter As String = vbNewLine, _
                            Optional ByVal lPadKey As Long = 32) As String
                            
    Dim vKeyLoop As Variant, sKVP As String, sRetVal As String
    For Each vKeyLoop In dic.Keys
        Dim sPaddedKey As String: sPaddedKey = vbNullString
        
        If Len(vKeyLoop) + 2 < lPadKey Then sPaddedKey = Pad(vKeyLoop & ": ", lPadKey) Else sPaddedKey = vKeyLoop & ": "
    
        If Not IsObject(dic.Item(vKeyLoop)) Then
            sKVP = sPaddedKey & dic.Item(vKeyLoop)
        Else
            sKVP = sPaddedKey & "{ " & DictionaryToString(dic.Item(vKeyLoop), " ; ", 0) & " }"
        End If
        If Len(sRetVal) > 0 Then sRetVal = sRetVal & sDelimiter
        sRetVal = sRetVal & sKVP
        
        sPaddedKey = vbNullString
    Next vKeyLoop
    
    DictionaryToString = sRetVal

End Function

'---------------------------------------------------------------------------------------
' Procedure : Pad
' DateTime  : 02/03/2018 10:19
' Author    : Simon
' Purpose   : pad a string, used to align/justify
'---------------------------------------------------------------------------------------
' Arguments :
'    s[in]        : The string to pad
'    lPad[in]     : the numbers of characters to pad
'    [out,retval] : returns a padded string
'
Private Function Pad(ByVal s As String, ByVal lPad As Long) As String
    Pad = Left(s & String(lPad, " "), lPad)
End Function

'---------------------------------------------------------------------------------------
' Procedure : TestHttpRequest
' DateTime  : 26/02/2018 15:42
' Author    : Simon
' Purpose   : Run this to ensure your macros are enabled whilst troubleshooting
'---------------------------------------------------------------------------------------
'
Public Sub TestHttpRequest()
    Dim abBody() As Byte
    Debug.Print Application.Run(ThisWorkbook.Name & "!HttpRequest", NewDictionary(), "GET", NewDictionary(), _
                            False, abBody, _
                            NewDictionary(), NewDictionary(), _
                            NewDictionary(), NewDictionary())
End Sub

'---------------------------------------------------------------------------------------
' Procedure : NewDictionary
' DateTime  : 02/03/2018 09:23
' Author    : Simon
' Purpose   : allows anonymous dictionaries (no need to declare variable) to be created
'---------------------------------------------------------------------------------------
' Arguments :
' [out,retval]  : a newly created Scripting.Dictionary object
'
Private Function NewDictionary() As Dictionary
    Set NewDictionary = New Scripting.Dictionary
End Function

C# Addin source


using System;
using Excel = Microsoft.Office.Interop.Excel;
using System.Collections.Generic;
using System.Net;
using System.Text;
using System.Threading;
using System.Runtime.InteropServices;

using Scripting; // Added COM reference to COM library 'Microsoft Scripting Runtime'
using System.IO;

namespace ExcelWebServerAddIn
{
    public class WebServer
    {
        /*
         * With effusive thanks and great praise to David's Blog
         * https://codehosting.net/blog/BlogEngine/post/Simple-C-Web-Server
         * a big win!
         */
        private readonly HttpListener _listener = new HttpListener();
        private readonly Func<HttpListenerRequest, Scripting.Dictionary, Scripting.Dictionary, Scripting.Dictionary, string> _responderMethod;

        /// <summary>
        /// Mime Type conversion table (with thanks to Caio Proiete https://gist.github.com/caioproiete/0a22dd020045a0fee239 )
        /// TODO replace with more "official" https://developer.mozilla.org/en-US/docs/Web/HTTP/Basics_of_HTTP/MIME_types/Complete_list_of_MIME_types
        /// </summary>
        private static IDictionary<string, string> _mimeTypeMappings =
            new Dictionary<string, string>(StringComparer.InvariantCultureIgnoreCase)
            {
                #region extension to MIME type list
                {".asf", "video/x-ms-asf"},
                {".asx", "video/x-ms-asf"},
                {".avi", "video/x-msvideo"},
                {".bin", "application/octet-stream"},
                {".cco", "application/x-cocoa"},
                {".crt", "application/x-x509-ca-cert"},
                {".css", "text/css"},
                {".deb", "application/octet-stream"},
                {".der", "application/x-x509-ca-cert"},
                {".dll", "application/octet-stream"},
                {".dmg", "application/octet-stream"},
                {".ear", "application/java-archive"},
                {".eot", "application/octet-stream"},
                {".exe", "application/octet-stream"},
                {".flv", "video/x-flv"},
                {".gif", "image/gif"},
                {".hqx", "application/mac-binhex40"},
                {".htc", "text/x-component"},
                {".htm", "text/html"},
                {".html", "text/html"},
                {".ico", "image/x-icon"},
                {".img", "application/octet-stream"},
                {".iso", "application/octet-stream"},
                {".jar", "application/java-archive"},
                {".jardiff", "application/x-java-archive-diff"},
                {".jng", "image/x-jng"},
                {".jnlp", "application/x-java-jnlp-file"},
                {".jpeg", "image/jpeg"},
                {".jpg", "image/jpeg"},
                {".js", "application/x-javascript"},
                {".mml", "text/mathml"},
                {".mng", "video/x-mng"},
                {".mov", "video/quicktime"},
                {".mp3", "audio/mpeg"},
                {".mpeg", "video/mpeg"},
                {".mpg", "video/mpeg"},
                {".msi", "application/octet-stream"},
                {".msm", "application/octet-stream"},
                {".msp", "application/octet-stream"},
                {".pdb", "application/x-pilot"},
                {".pdf", "application/pdf"},
                {".pem", "application/x-x509-ca-cert"},
                {".pl", "application/x-perl"},
                {".pm", "application/x-perl"},
                {".png", "image/png"},
                {".prc", "application/x-pilot"},
                {".ra", "audio/x-realaudio"},
                {".rar", "application/x-rar-compressed"},
                {".rpm", "application/x-redhat-package-manager"},
                {".rss", "text/xml"},
                {".run", "application/x-makeself"},
                {".sea", "application/x-sea"},
                {".shtml", "text/html"},
                {".sit", "application/x-stuffit"},
                {".swf", "application/x-shockwave-flash"},
                {".tcl", "application/x-tcl"},
                {".tk", "application/x-tcl"},
                {".txt", "text/plain"},
                {".war", "application/java-archive"},
                {".wbmp", "image/vnd.wap.wbmp"},
                {".wmv", "video/x-ms-wmv"},
                {".xhtml", "application/xhtml+xml" },
                {".xml", "text/xml"},
                {".xpi", "application/x-xpinstall"},
                {".zip", "application/zip"},

                #endregion
            };

        public WebServer(IReadOnlyCollection<string> prefixes, Func<HttpListenerRequest, Scripting.Dictionary, Scripting.Dictionary, Scripting.Dictionary, string> method)
        {
            if (!HttpListener.IsSupported)
            {
                throw new NotSupportedException("Needs Windows XP SP2, Server 2003 or later.");
            }

            // URI prefixes are required eg: "http://localhost:8080/test/"
            if (prefixes == null || prefixes.Count == 0)
            {
                throw new ArgumentException("URI prefixes are required");
            }

            if (method == null)
            {
                throw new ArgumentException("responder method required");
            }

            foreach (var s in prefixes)
            {
                _listener.Prefixes.Add(s);
            }

            _responderMethod = method;
            _listener.Start();
        }

        public WebServer(Func<HttpListenerRequest, Scripting.Dictionary, Scripting.Dictionary, Scripting.Dictionary, string> method, params string[] prefixes)
           : this(prefixes, method)
        {
        }

        public void Run()
        {
            ThreadPool.QueueUserWorkItem(o =>
            {
                Console.WriteLine("Webserver running...");
                try
                {
                    while (_listener.IsListening)
                    {
                        ThreadPool.QueueUserWorkItem(c =>
                        {
                            var ctx = c as HttpListenerContext;
                            try
                            {
                                if (ctx == null)
                                {
                                    return;
                                }


                                string localpathOs = ctx.Request.Url.LocalPath.Replace("/", "\");
                                string path = "N:\html" + localpathOs; 
                                string ext = System.IO.Path.GetExtension(path);



                                if (ext.Length > 0)
                                {
                                    /* a static file has been requested so serve it
                                     *
                                     * With thanks to L.B. https://stackoverflow.com/users/932418/l-b
                                     * https://stackoverflow.com/questions/13385633/serving-large-files-with-c-sharp-httplistener
                                     *
                                     * Also with thanks to Caio Proiete https://gist.github.com/caioproiete
                                     * https://gist.github.com/caioproiete/0a22dd020045a0fee239
                                     */
                                    if (!System.IO.File.Exists(path))
                                    {
                                        ctx.Response.StatusCode = (int)HttpStatusCode.NotFound;
                                    }
                                    else
                                    {

                                        using (FileStream fs = System.IO.File.OpenRead(path))
                                        {
                                            string filename = Path.GetFileName(path);
                                            //response is HttpListenerContext.Response...
                                            ctx.Response.ContentLength64 = fs.Length;
                                            ctx.Response.SendChunked = false;

                                            string mime;
                                            ctx.Response.ContentType = _mimeTypeMappings.TryGetValue(Path.GetExtension(filename), out mime)
                                                ? mime
                                                : "application/octet-stream";

                                            byte[] buffer = new byte[64 * 1024];
                                            int read;
                                            using (BinaryWriter bw = new BinaryWriter(ctx.Response.OutputStream))
                                            {
                                                while ((read = fs.Read(buffer, 0, buffer.Length)) > 0)
                                                {
                                                    bw.Write(buffer, 0, read);
                                                    bw.Flush(); //seems to have no effect
                                                }

                                                bw.Close();
                                            }

                                            ctx.Response.StatusCode = (int)HttpStatusCode.OK;
                                            ctx.Response.StatusDescription = "OK";
                                            ctx.Response.OutputStream.Close();
                                        }
                                    }
                                }
                                else
                                {
                                    /* a non-static file has been requested so we assume it is a REST request
                                     * and will route it to our Excel VBA server
                                     */

                                    try
                                    {
                                        Scripting.Dictionary dicResponseHeaders = new Scripting.Dictionary(); // this is to be populated by the Excel VBA
                                        Scripting.Dictionary dicResponseCookies = new Scripting.Dictionary(); // this is to be populated by the Excel VBA
                                        Scripting.Dictionary dicStatusCode = new Scripting.Dictionary(); // this is to be populated by the Excel VBA

                                        /* next we call into the VBA gateway */
                                        var rstr = _responderMethod(ctx.Request, dicResponseHeaders, dicResponseCookies, dicStatusCode);

                                        var keys = dicStatusCode.Keys();
                                        int lStatusCode = keys[0];

                                        ctx.Response.StatusCode = lStatusCode;

                                        {
                                            if (dicResponseHeaders.Count > 0)
                                            {
                                                foreach (string keyLoop in dicResponseHeaders.Keys())
                                                {
                                                    ctx.Response.Headers.Add(keyLoop, dicResponseHeaders.get_Item(keyLoop));
                                                }
                                            }

                                            if (dicResponseCookies.Count > 0)
                                            {
                                                foreach (string keyLoop in dicResponseCookies.Keys())
                                                {
                                                    string cookieValue = dicResponseCookies.get_Item(keyLoop);
                                                    Cookie cookieLoop = new Cookie(keyLoop, cookieValue);
                                                    ctx.Response.SetCookie(cookieLoop);
                                                }
                                            }

                                            if (rstr != null)
                                            {
                                                var buf = Encoding.UTF8.GetBytes(rstr);
                                                ctx.Response.ContentLength64 = buf.Length;
                                                ctx.Response.OutputStream.Write(buf, 0, buf.Length);
                                            }
                                        }
                                    }
                                    catch (Exception)
                                    {
                                        ctx.Response.StatusCode = (int)HttpStatusCode.InternalServerError;
                                    }
                                }
                            }
                            catch
                            {
                                // ignored
                            }
                            finally
                            {
                                // always close the stream
                                if (ctx != null)
                                {
                                    ctx.Response.OutputStream.Close();
                                }
                            }
                        }, _listener.GetContext());
                    }
                }
                catch (Exception)
                {
                    // ignored
                }
            });
        }

        public void Stop()
        {
            _listener.Stop();
            _listener.Close();
        }
    }


    public partial class ThisAddIn
    {
        WebServer ws = null;

        public static string SendResponse(HttpListenerRequest request, Scripting.Dictionary dicResponseHeaders, Scripting.Dictionary dicResponseCookies, Scripting.Dictionary dicStatusCode)
        {
            const string csWebServerWorkbook = "WebServer.xlsm";
            Excel.Workbook wbServer = GetWorkbookByName(csWebServerWorkbook);
            if (wbServer != null)
            {
                try
                {
                    Scripting.Dictionary dicUrlProps = new Scripting.Dictionary();

                    dicUrlProps.Add("AbsolutePath", request.Url.AbsolutePath);
                    dicUrlProps.Add("AbsoluteUri", request.Url.AbsoluteUri);
                    dicUrlProps.Add("Authority", request.Url.Authority);
                    dicUrlProps.Add("DnsSafeHost", request.Url.DnsSafeHost);
                    dicUrlProps.Add("Fragment", request.Url.Fragment);
                    dicUrlProps.Add("Host", request.Url.Host);
                    dicUrlProps.Add("HostNameType", request.Url.HostNameType.ToString());
                    dicUrlProps.Add("IdnHost", request.Url.IdnHost);
                    dicUrlProps.Add("IsAbsoluteUri", request.Url.IsAbsoluteUri);
                    dicUrlProps.Add("IsDefaultPort", request.Url.IsDefaultPort);
                    dicUrlProps.Add("IsFile", request.Url.IsFile);
                    dicUrlProps.Add("IsLoopback", request.Url.IsLoopback);
                    dicUrlProps.Add("IsUnc", request.Url.IsUnc);
                    dicUrlProps.Add("IsWellFormedOriginalString", request.Url.IsWellFormedOriginalString());
                    dicUrlProps.Add("LocalPath", request.Url.LocalPath);
                    dicUrlProps.Add("OriginalString", request.Url.OriginalString);
                    dicUrlProps.Add("PathAndQuery", request.Url.PathAndQuery);
                    dicUrlProps.Add("Port", request.Url.Port);
                    dicUrlProps.Add("Query", request.Url.Query);
                    dicUrlProps.Add("Scheme", request.Url.Scheme);

                    Scripting.Dictionary dicUrlSegments = new Scripting.Dictionary();
                    foreach (string segmentLoop in request.Url.Segments)
                    {
                        dicUrlSegments.Add(dicUrlSegments.Count, segmentLoop);
                    }
                    dicUrlProps.Add("Segments", dicUrlSegments);
                    dicUrlProps.Add("ToString", request.Url.ToString());
                    dicUrlProps.Add("UserEscaped", request.Url.UserEscaped);
                    dicUrlProps.Add("UserInfo", request.Url.UserInfo);

                    Scripting.Dictionary dicQueryString = new Scripting.Dictionary();
                    foreach (string keyLoop in request.QueryString.Keys)
                    {
                        dicQueryString.Add(keyLoop, request.QueryString[keyLoop]);
                    }

                    Scripting.Dictionary dicRequestHeaders = new Scripting.Dictionary();
                    foreach (string headerKeyLoop in request.Headers.Keys)
                    {
                        dicRequestHeaders.Add(headerKeyLoop, request.Headers[headerKeyLoop]);
                    }


                    byte[] postData = null;
                    if (request.HasEntityBody)
                    {
                        //https://stackoverflow.com/questions/3434007/error-this-stream-does-not-support-seek-operations-in-c-sharp#3434077
                        using (Stream stream = request.InputStream)
                        using (MemoryStream ms = new MemoryStream())
                        {
                            int count = 0;
                            do
                            {
                                byte[] buf = new byte[1024];
                                count = stream.Read(buf, 0, 1024);
                                ms.Write(buf, 0, count);
                            } while (stream.CanRead && count > 0);
                            postData = ms.ToArray();
                        }

                    }
                    else
                    {
                        // it seems we have to pass something ...
                        postData = new byte[0];
                    }


                    Scripting.Dictionary dicRequestCookies = new Scripting.Dictionary();
                    foreach (Cookie cookieLoop in request.Cookies)
                    {
                        dicRequestCookies.Add(cookieLoop.Name, cookieLoop.Value);
                    }

                    string responseText;
                    responseText = Globals.ThisAddIn.Application.Run(csWebServerWorkbook + "!HttpRequest", dicUrlProps, request.HttpMethod,
                            dicQueryString, request.HasEntityBody, postData, dicRequestHeaders, dicRequestCookies, dicResponseHeaders, dicResponseCookies, dicStatusCode);
                    if (dicStatusCode.Count == 0)
                    {
                        dicStatusCode.Add(500, 0);
                    }
                    return responseText;
                }
                catch (COMException ex)
                {
                    if (ex.Message.Contains("macros may be disabled"))
                    {
                        dicStatusCode.Add(500, 0);
                        return ex.Message;
                    }
                    else
                    {
                        dicStatusCode.Add(500, 0);
                        return ex.Message;
                    }
                }

                catch (Exception ex)
                {
                    dicStatusCode.Add(500, 0);
                    return ex.Message;
                }
            }
            else
            {
                dicStatusCode.Add(500, 0);
                return string.Format("<HTML><BODY>Error:" + csWebServerWorkbook + " is not running!<br>{0}</BODY></HTML>", DateTime.Now);
            }
        }

        private static Excel.Workbook GetWorkbookByName(string wbName)
        {
            Excel.Workbook wbReturn = null;
            foreach (Excel.Workbook wbLoop in Globals.ThisAddIn.Application.Workbooks)
            {
                if (wbLoop.Name == wbName)
                {
                    wbReturn = wbLoop;
                }
            }
            return wbReturn;
        }

        private void ThisAddIn_Startup(object sender, System.EventArgs e)
        {
            ws = new WebServer(SendResponse, "http://localhost:8080/theFooBar/");
            ws.Run();

        }

        private void ThisAddIn_Shutdown(object sender, System.EventArgs e)
        {
            ws.Stop();
        }

        #region VSTO generated code

        /// <summary>
        /// Required method for Designer support - do not modify
        /// the contents of this method with the code editor.
        /// </summary>
        private void InternalStartup()
        {
            this.Startup += new System.EventHandler(ThisAddIn_Startup);
            this.Shutdown += new System.EventHandler(ThisAddIn_Shutdown);
        }

        #endregion
    }
}


1 comment:

  1. Simon,
    This looks very interesting.
    However AngularJS is soon EOL.
    Do you have any interest in updating it to Angular (8/9) Excel 2019 ?
    I could add the current code to GitHub, get a working base system
    and use it to document/develop the upgrade process.
    Thanks,
    Peter



    ReplyDelete