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
}
}
Simon,
ReplyDeleteThis 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