Wednesday 31 October 2018

C# - Excel Moniker Class to pack cell address to single string

In one single string, I need to encode a path to a block of Excel cells including the correct Excel.exe process (in case there is more than one Excel). I need this for an OLE DB Provider Custom Implementation where one only gets a single string to pack in all the details. As the OLE DB provider is written in C# then I implement an Excel Moniker Class also in C#.

There is an established COM moniker form for an Excel cell address qualified by worksheet, workbook and file location. I use this as the base of my moniker. I then bolt on the Hwnd of the specific Excel session as a prefix.

COM Monikers To Specify Excel Ranges

I do not want to replicate the COM specification here but there is such a thing as a COM moniker. A COM moniker is a bit like a URL (web address) or a file path. COM monikers can be composed of subtype COM moniker such as file moniker. The segments of such composite monikers by convention are frequently separated by the bang (exclamation mark) '!' . It is possible for a composite moniker to be parsed segment by segment passing control of each segment parsing to a separate component. This is emblematic of COM's component design.

An example of a composite moniker is an Excel cell located in another workbook. But first, let's build it up piece by piece. N.B. all the following examples show an equals sign as if in a formula. If on the same sheet a cell address requires no qualification, e.g. =$A$1. A cell address on another sheet requires the sheet name as a qualifier e.g. =Sheet2!$A$1 (note the bang '!' as separator) . A problem arises if the other sheet has a space in its name as this then requires surrounding quotes, e.g. ='Sheet 3'!$E$8 . A cell address in another workbook requires further qualification with the workbook enclosed in square brackets ...

=[TestClient.xlsm]Sheet5!$C$6

If there is a space in the workbook name then this (just like a worksheet name) has to be surrounded in single quotes.

='[Book With Space in Name.xlsx]Sheet1'!$D$6

Moreover, sometimes a workbook needs to be qualified by its full path so a full moniker could look like ...

=[C:\Temp\TestClient.xlsm]Sheet5!$C$6

Then there is the issue of using a named range instead of a cell address. Furthermore, a named range can be either local or global which gives us two extra forms...

=[TestClient.xlsm]Sheet5!LocalName
=[TestClient.xlsm]!GlobalName

So lots of logic to program into a moniker class.

Additionally specifying Excel session with Hwnd

As highlighted in previous post, it is possible to identify and reach a specify Excel session running by means of its Hwnd by using the IAccessible interface. I use this in the code to identify the correct and specific Excel.exe session in case there are two. I bolt on the Hwnd as a prefix separated by a tick ` .

XlMoniker Class Source Code

So the following is C# code to be housed in an assembly that is registered for interop (Visual Studio will need admin rights to register).

Public XlMoniker Class and IXlMoniker

There is more than one class in the code below and so it is required to distinguish in this commentary. To expose functionality to VBA we need to ship a COM interface, that is IXlMoniker and also we need to shiop a COM class, XlMoniker that implements the interface IXlMoniker. There are three methods, GetExcelByHwnd was covered in prior post. ExcelRangeToMoniker takes a range and returns a moniker string. GetExcelRangeFromMoniker takes a moniker string and returns a range.

Internal XlMonikerParser Class

I have separated out the parsing and string handling in a separate class XlMonikerParser. This has no COM interface and so is not exposed to VBA. The code in this class lends itself to unit testing and the Unit test code is given below.

using System;
using System.Runtime.InteropServices;

namespace XlMoniker
{
    [ComVisible(true)]
    public interface IXlMoniker
    {
        bool GetExcelByHwnd(int lhwndApp, ref object app);
        bool GetExcelRangeFromMoniker(string sMoniker, ref object rngRetVal);
        string ExcelRangeToMoniker(object rng);
    }

    public class XlMonikerParser
    {
        public bool ParseMoniker(string sFullMoniker, out string sHwnd, out string sWorkbook,
                    out string sWorksheet, out string sCellAddress)
        {
            bool retval = false; sHwnd = ""; sWorkbook = ""; sWorksheet = ""; sCellAddress = "";

            if (this.ParseLeadingHwnd(sFullMoniker, out sHwnd, out string sFileAndCellAddressMoniker))
            {
                if (this.ParseWorkbookAndSheetFromCellAddress(sFileAndCellAddressMoniker, out string sWorkbookAndSheet, out sCellAddress))
                {
                    if (this.ParseWorkbookFromSheet(sWorkbookAndSheet, out sWorkbook, out sWorksheet))
                    {
                        return true;
                    }
                }
            }

            return retval;
        }

        public bool ParseWorkbookFromSheet(string sWorkbookAndSheet, out string sWorkbook,
                    out string sWorksheet)
        {
            bool retval = false; sWorkbook = ""; sWorksheet = "";
            // if workbook or sheet name contain a space then single quotes wrap them isolating them from the cell address
            // '[Book With Space in Name.xlsx]Sheet1'
            // [TestClient.xlsm]Sheet1


            string[] splitOnSingleQuotes = sWorkbookAndSheet.Split(''');
            string sWithoutSingleQuotes = splitOnSingleQuotes.Length == 3 ? splitOnSingleQuotes[1] : sWorkbookAndSheet;

            char[] squareBrackets = new char[] { '[', ']' };
            string[] splitOnSquareBrackets = sWithoutSingleQuotes.Split(squareBrackets);
            if (splitOnSquareBrackets.Length == 3)
            {
                sWorkbook = splitOnSquareBrackets[1];
                sWorksheet = splitOnSquareBrackets[2];
                return true;
            }
            else if (splitOnSquareBrackets.Length == 1)
            {
                sWorkbook = splitOnSquareBrackets[0];
                sWorksheet = ""; // possibly a global name
                return true;
            }

            return retval;
        }

        public bool ParseWorkbookAndSheetFromCellAddress(string sFileAndCellAddressMoniker, out string sWorkbookAndSheet,
                    out string sCellAddress)
        {
            bool retval = false; sWorkbookAndSheet = ""; sCellAddress = "";

            string[] splitOnBang = sFileAndCellAddressMoniker.Split('!');
            // expecting only one bang to split the workbook and sheet name from the cell address , so two elements
            if (splitOnBang.Length == 2)
            {
                sWorkbookAndSheet = splitOnBang[0];
                sCellAddress = splitOnBang[1];
                return true;
            }

            return retval;
        }

        public bool ParseLeadingHwnd(string sFullMoniker, out string sHwnd, out string sFileAndCellAddressMoniker)
        {
            bool retval = false;
            sHwnd = "";
            sFileAndCellAddressMoniker = "";

            string[] splitOnTick = sFullMoniker.Split('`');
            // expecting only one tick to split the Hwnd from the rest of the moniker, so two elements
            if (splitOnTick.Length == 2)
            {
                sHwnd = splitOnTick[0];
                sFileAndCellAddressMoniker = splitOnTick[1];
                return true;
            }

            return retval;
        }
    }

    [ClassInterface(ClassInterfaceType.None)]
    [ComDefaultInterface(typeof(IXlMoniker))]
    [ComVisible(true)]
    public class XlMoniker : IXlMoniker
    {
        const char separator = '`';

        [DllImport("user32.dll", SetLastError = true)]
        static extern IntPtr FindWindowEx(IntPtr hwndParent, IntPtr hwndChildAfter, string lpszClass, string lpszWindow);


        [DllImport("oleacc.dll", SetLastError = true)]
        internal static extern int AccessibleObjectFromWindow(IntPtr hwnd, uint id, ref Guid iid,
                                                    [In, Out, MarshalAs(UnmanagedType.IUnknown)] ref object ppvObject);

        bool IXlMoniker.GetExcelByHwnd(int lhwndApp2, ref object appRetVal)
        {
            bool bRetVal = false;

            IntPtr lhwndApp = (IntPtr)lhwndApp2;

            IntPtr lHwndDesk = FindWindowEx(lhwndApp, IntPtr.Zero, "XLDESK", "");
            if (lHwndDesk != IntPtr.Zero)
            {

                IntPtr lHwndExcel7 = FindWindowEx(lHwndDesk, IntPtr.Zero, "EXCEL7", null);
                if (lHwndExcel7 != IntPtr.Zero)
                {
                    Guid IID_IDispatch = new Guid("{00020400-0000-0000-C000-000000000046}");
                    const uint OBJID_NATIVEOM = 0xFFFFFFF0;
                    object app = null;
                    if (AccessibleObjectFromWindow(lHwndExcel7, OBJID_NATIVEOM, ref IID_IDispatch, ref app) == 0)
                    {
                        dynamic appWindow = app;
                        appRetVal = appWindow.Application;
                        return true;
                    }
                }
            }
            return bRetVal;
        }


        bool IXlMoniker.GetExcelRangeFromMoniker(string sMoniker, ref object rngRetVal)
        {
            bool retval = false;

            XlMonikerParser parser = new XlMonikerParser();
            retval = parser.ParseMoniker(sMoniker, out string sHwnd, out string sWorkbook,
                        out string sWorksheet, out string sCellAddress);
            if (retval)
            {
                if (int.TryParse(sHwnd, out int lHwnd))
                {
                    dynamic xlApp = null;
                    if (((IXlMoniker)this).GetExcelByHwnd(lHwnd, ref xlApp))
                    {

                        if (FindWorkbookByFullName(sWorkbook, xlApp, out dynamic wbFound))
                        {
                            if (sWorksheet.Length == 0)
                            {
                                // perhaps a global name
                                if (TryGetName(sCellAddress, wbFound, out dynamic nameFound))
                                {
                                    rngRetVal = nameFound.RefersToRange;
                                    return true;
                                }
                            }
                            else
                            {
                                if (FindWorksheetByName(sWorksheet, wbFound, out dynamic wsFound))
                                {
                                    // perhaps a local name
                                    if (TryGetName(sCellAddress, wsFound, out dynamic nameFound))
                                    {
                                        rngRetVal = nameFound.RefersToRange;
                                        return true;
                                    }
                                    else
                                    {
                                        // here it can only be a cell address
                                        if (TryGetRange(wsFound, sCellAddress, out dynamic range))
                                        {
                                            rngRetVal = range;
                                            return true;
                                        }
                                    }
                                }
                            }
                        }
                    }
                }
            }

            return retval;
        }

        bool FindWorkbookByFullName(string sWorkbookFullName, dynamic xlApp, out dynamic wbFound)
        {
            bool retVal = false;
            wbFound = null;
            if (xlApp != null)
            {
                foreach (var wb in xlApp.workbooks)
                {
                    if (wb.FullName == sWorkbookFullName)
                    {
                        wbFound = wb;
                        return true;
                    }
                }
            }
            return retVal;
        }

        bool FindWorksheetByName(string sWorksheetName, dynamic wb, out dynamic wsFound)
        {
            bool retVal = false;
            wsFound = null;
            if (wb != null)
            {
                foreach (var ws in wb.worksheets)
                {
                    if (ws.Name == sWorksheetName)
                    {
                        wsFound = ws;
                        return true;
                    }
                }
            }
            return retVal;
        }

        bool TryGetName(string sNameName, dynamic wsOrWb, out dynamic nameFound)
        {   // this should work for both the Names collection off the workbook (i.e. global) and off each worksheet (i.e. Local)
            bool retVal = false;
            nameFound = null;
            if (wsOrWb != null)
            {
                try
                {
                    nameFound = wsOrWb.Names.Item(sNameName);
                    retVal = true;
                }
                catch
                {
                    return false;
                }
            }
            return retVal;
        }

        bool TryGetRange(dynamic ws, string sCellAddress, out dynamic range)
        {
            bool retVal = false;
            range = null;
            if (ws != null)
            {
                try
                {
                    range = ws.Range(sCellAddress);
                    return true;
                }
                catch
                {
                    return false;
                }
            }
            return retVal;
        }

        bool IsRangeNamed(dynamic rng, out dynamic nameFound)
        {
            bool retVal = false;
            nameFound = null;

            try
            {
                nameFound = rng.Name;
                return true;
            }
            catch
            { }

            return retVal;
        }

        string IXlMoniker.ExcelRangeToMoniker(dynamic rng)
        {
            string retval = "";
            if (rng != null)
            {
                dynamic ws = null; dynamic wb = null; dynamic xlApp = null; int hwnd;
                try
                {
                    ws = rng.Worksheet;
                    wb = ws.Parent;
                    xlApp = wb.Application;
                    hwnd = xlApp.hwnd();
                }
                catch
                {
                    throw new Exception("Error navigating from Range->Worksheet->Parent(Workbook)->Application->Hwnd!");
                }

                try
                {
                    string hwndPrefix = hwnd.ToString() + separator.ToString();
                    string sWorkbookFullName = wb.FullName;
                    string sWorksheetName = ws.Name;

                    if (IsRangeNamed(rng, out dynamic nameFound))
                    {   // range is named, but global or local, presence of ! indicates local
                        string sName = nameFound.Name;
                        bool quoteWorkbook = sWorkbookFullName.Contains(" ");
                        bool quoteWorksheet = sWorksheetName.Contains(" ");

                        if (sName.Contains("!"))
                        {   // it's local 
                            // use single quotes if there is a space in workbook name or sheetname
                            if (quoteWorkbook || quoteWorksheet)
                            {
                                return hwndPrefix + "'[" + sWorkbookFullName + "]" + sName;
                            }
                            else
                            {
                                return hwndPrefix + "[" + sWorkbookFullName + "]" + sName;
                            }
                        }
                        else
                        {   // it's global
                            // use single quotes if there is a space in workbook name
                            if (quoteWorkbook)
                            {
                                return hwndPrefix + "'[" + sWorkbookFullName + "]'!" + sName;
                            }
                            else
                            {
                                return hwndPrefix + "[" + sWorkbookFullName + "]!" + sName;
                            }
                        }
                    }
                    else
                    {   // range is not named just a cell address, so expect a worksheetname
                        if (sWorkbookFullName.Contains(" ") || sWorksheetName.Contains(" "))
                        {
                            return hwndPrefix + "'[" + sWorkbookFullName + "]" + sWorksheetName + "'!" + rng.Address;
                        }
                        else
                        {
                            return hwndPrefix + "[" + sWorkbookFullName + "]" + sWorksheetName + "!" + rng.Address;
                        }
                    }
                }
                catch
                {
                    throw new Exception("Error building moniker string!");
                }
            }
            return retval;
        }
    }

}

VBA Client Code

So this is VBA code to test our class. Though the real test is when I blog an OLEDB Provider that accepts a cell moniker to generate a table, that is upcoming, watch this blog!

Option Explicit
Option Private Module

Private moXlMoniker As SimpleOLEDBProvider1.XlMoniker

Public Function GetXlMoniker() As SimpleOLEDBProvider1.XlMoniker
    If moXlMoniker Is Nothing Then
        Set moXlMoniker = New SimpleOLEDBProvider1.XlMoniker
    End If
    Set GetXlMoniker = moXlMoniker
End Function

Public Sub ResetXlMoniker()
    Set moXlMoniker = Nothing
End Sub

Private Sub Test_XlMoniker_GetExcelRange2()

    Dim oMoniker As SimpleOLEDBProvider1.XlMoniker
    Set oMoniker = New SimpleOLEDBProvider1.XlMoniker
    
    Dim sht1 As Excel.Worksheet
    Set sht1 = ThisWorkbook.Worksheets("Sheet1")
    
    Dim sHwnd As String
    sHwnd = Application.hwnd & "`"
    
    Dim sMonikerPart1 As String
    
    If InStr(1, ThisWorkbook.FullName, " ", vbTextCompare) > 0 Then
        sMonikerPart1 = sHwnd & "'[" & ThisWorkbook.FullName & "]"
        Debug.Assert oMoniker.ExcelRangeToMoniker(sht1.Range("A11:B14")) = sMonikerPart1 & "Sheet1'!$A$11:$B$14"
        Debug.Assert oMoniker.ExcelRangeToMoniker(sht1.Range("A1:B4")) = sMonikerPart1 & "'!GlobalName"
        Debug.Assert oMoniker.ExcelRangeToMoniker(sht1.Range("LocalName")) = sMonikerPart1 & "'Sheet1!LocalName"
    Else
        sMonikerPart1 = sHwnd & "[" & ThisWorkbook.FullName & "]"
        Debug.Assert oMoniker.ExcelRangeToMoniker(sht1.Range("A11:B14")) = sMonikerPart1 & "Sheet1!$A$11:$B$14"
        Debug.Assert oMoniker.ExcelRangeToMoniker(sht1.Range("A1:B4")) = sMonikerPart1 & "!GlobalName"
        Debug.Assert oMoniker.ExcelRangeToMoniker(sht1.Range("LocalName")) = sMonikerPart1 & "Sheet1!LocalName"
    End If
    
End Sub



Private Sub Test_XlMoniker_GetExcelRange()

    Dim oMoniker As SimpleOLEDBProvider1.XlMoniker
    Set oMoniker = New SimpleOLEDBProvider1.XlMoniker
    
    Dim vSetupValues As Variant
    vSetupValues = Application.[{"ColorName","ColorRGB";"Red","FF0000";"Green", "00FF00";"Blue" ,"0000FF"}]

    ThisWorkbook.Worksheets("Sheet1").Range("A1:B4").Value2 = vSetupValues

    Debug.Assert GetExcelRangeAddress(oMoniker, Application.hwnd & "`[" & ThisWorkbook.FullName & "]Sheet1!A1") = "$A$1"
    Debug.Assert GetExcelRangeAddress(oMoniker, Application.hwnd & "`[" & ThisWorkbook.FullName & "]Sheet1!A1:b4") = "$A$1:$B$4"
    Debug.Assert GetExcelRangeAddress(oMoniker, Application.hwnd & "`[" & ThisWorkbook.FullName & "]Sheet2!B1:C4") = "$B$1:$C$4"

    ThisWorkbook.Worksheets("Sheet1").Range("A1:B4").Name = "GlobalName"
    
    Dim rngGlobalName As Excel.Range
    Set rngGlobalName = ThisWorkbook.Names.Item("GlobalName").RefersToRange
    
    
    Debug.Assert GetExcelRangeAddress(oMoniker, Application.hwnd & "`[" & ThisWorkbook.FullName & "]!GlobalName") = "$A$1:$B$4"
    ThisWorkbook.Worksheets("Sheet1").Range("B1:C4").Name = "Sheet1!LocalName"
    Debug.Assert GetExcelRangeAddress(oMoniker, Application.hwnd & "`[" & ThisWorkbook.FullName & "]Sheet1!LocalName") = "$B$1:$C$4"
    Debug.Assert GetExcelRangeAddress(oMoniker, Application.hwnd & "`[" & ThisWorkbook.FullName & "]Sheet1!$D5:E7") = "$D$5:$E$7"
End Sub

Private Function GetExcelRangeAddress(ByVal oMoniker As SimpleOLEDBProvider1.XlMoniker, ByVal sMoniker As String) As String
    Dim rng As Excel.Range
    Debug.Assert oMoniker.GetExcelRangeFromMoniker(sMoniker, rng)
    GetExcelRangeAddress = rng.Address
End Function

Private Sub Test_XlMoniker_GetExcelByHwnd()

    Dim oMoniker As SimpleOLEDBProvider1.XlMoniker
    Set oMoniker = New SimpleOLEDBProvider1.XlMoniker
    
    Dim obj As Excel.Application
    If oMoniker.GetExcelByHwnd(Application.hwnd, obj) Then
        Debug.Assert obj Is Application
    End If


End Sub

Private Sub GlobalName()
    
    Dim namGlobal As Excel.Name
    Set namGlobal = ThisWorkbook.Names.Item("GlobalName")
    Debug.Assert Not namGlobal Is Nothing
    Debug.Assert namGlobal.RefersToRange.Address = "$A$1:$B$4"
    
    Dim namLocal As Excel.Name
    Set namLocal = ThisWorkbook.Worksheets("Sheet1").Names.Item("LocalName")
    Debug.Assert Not namLocal Is Nothing

    Dim namGlobal2 As Excel.Name
    Set namGlobal2 = ThisWorkbook.Names.Item("GlobalName")

    Stop

End Sub

XlMonikerParser Unit Tests

As promised here is the unit test code for the XlMonikerParser class. I must say I really like the testing support in Visual Studio 2017. Far better than unit tests in VBA!

using XlMoniker;
using Microsoft.VisualStudio.TestTools.UnitTesting;

namespace UnitTestProject1
{
    [TestClass]
    public class UnitTest1
    {
        [TestMethod]
        public void TestMethod1()
        {
            XlMonikerParser parser = new XlMonikerParser();
            string sHwnd;
            string sFileAndCellAddressMoniker;

            bool parsed = parser.ParseLeadingHwnd("1234`'[foo bar.xlsx]!Sheet1", out sHwnd, out sFileAndCellAddressMoniker);
            Assert.IsTrue(parsed);
            Assert.IsTrue(sHwnd == "1234");
            Assert.IsTrue(sFileAndCellAddressMoniker == "'[foo bar.xlsx]!Sheet1");

            parsed = parser.ParseLeadingHwnd("1234`'[Book With Space in Name.xlsx]Sheet1'!$D$3", out sHwnd, out sFileAndCellAddressMoniker);
            Assert.IsTrue(parsed);
            Assert.IsTrue(sHwnd == "1234");
            Assert.IsTrue(sFileAndCellAddressMoniker == "'[Book With Space in Name.xlsx]Sheet1'!$D$3");

            parsed = parser.ParseLeadingHwnd("1234`TestClient.xlsm!GlobalName", out sHwnd, out sFileAndCellAddressMoniker);
            Assert.IsTrue(parsed);
            Assert.IsTrue(sHwnd == "1234");
            Assert.IsTrue(sFileAndCellAddressMoniker == "TestClient.xlsm!GlobalName");
        }

        [TestMethod]
        public void TestMethod2()
        {
            XlMonikerParser parser = new XlMonikerParser();

            string sWorkbookAndSheet; string sCellAddress;

            bool parsed = parser.ParseWorkbookAndSheetFromCellAddress("'[Book With Space in Name.xlsx]Sheet1'!$D$3", out sWorkbookAndSheet, out sCellAddress);
            Assert.IsTrue(parsed);
            Assert.IsTrue(sWorkbookAndSheet == "'[Book With Space in Name.xlsx]Sheet1'");
            Assert.IsTrue(sCellAddress == "$D$3");

            parsed = parser.ParseWorkbookAndSheetFromCellAddress("TestClient.xlsm!GlobalName", out sWorkbookAndSheet, out sCellAddress);
            Assert.IsTrue(parsed);
            Assert.IsTrue(sWorkbookAndSheet == "TestClient.xlsm");
            Assert.IsTrue(sCellAddress == "GlobalName");
        }

        [TestMethod]
        public void TestMethod3()
        {
            XlMonikerParser parser = new XlMonikerParser();

            string sWorkbook; string sWorksheet;

            bool parsed = parser.ParseWorkbookFromSheet("'[Book With Space in Name.xlsx]Sheet1'", out sWorkbook, out sWorksheet);
            Assert.IsTrue(parsed);
            Assert.IsTrue(sWorkbook == "Book With Space in Name.xlsx");
            Assert.IsTrue(sWorksheet == "Sheet1");

            parsed = parser.ParseWorkbookFromSheet("[TestClient.xlsm]Sheet2", out sWorkbook, out sWorksheet);
            Assert.IsTrue(parsed);
            Assert.IsTrue(sWorkbook == "TestClient.xlsm");
            Assert.IsTrue(sWorksheet == "Sheet2");

            parsed = parser.ParseWorkbookFromSheet("TestClient.xlsm", out sWorkbook, out sWorksheet);
            Assert.IsTrue(parsed);
            Assert.IsTrue(sWorkbook == "TestClient.xlsm");
            Assert.IsTrue(sWorksheet == "");
        }

        [TestMethod]
        public void TestMethod4()
        {
            XlMonikerParser parser = new XlMonikerParser();

            string sHwnd; string sWorkbook; string sWorksheet; string sCellAddress;

            bool parsed = parser.ParseMoniker("1234`'[Book With Space in Name.xlsx]Sheet1'!$D$3", out sHwnd, out sWorkbook, out sWorksheet, out sCellAddress);
            Assert.IsTrue(parsed);
            Assert.IsTrue(sHwnd == "1234");
            Assert.IsTrue(sWorkbook == "Book With Space in Name.xlsx");
            Assert.IsTrue(sWorksheet == "Sheet1");
            Assert.IsTrue(sCellAddress == "$D$3");

            parsed = parser.ParseMoniker("1234`TestClient.xlsm!GlobalName", out sHwnd, out sWorkbook, out sWorksheet, out sCellAddress);
            Assert.IsTrue(parsed);
            Assert.IsTrue(sHwnd == "1234");
            Assert.IsTrue(sWorkbook == "TestClient.xlsm");
            Assert.IsTrue(sWorksheet == "");
            Assert.IsTrue(sCellAddress == "GlobalName");
        }
    }
}

Tuesday 30 October 2018

C# - Excel.exe Accessible via Hwnd

This is a trick I have given before on this blog but this time coded in C#. Windows allows applications to be queried for Accessibility APIs. Excel can return a COM pointer via such an API call. This means all one needs to acquire a callable COM pointer on an Excel.exe is its Hwnd.

Use case context - Competing with Microsoft.ACE.OLEDB.12.0

In yesterday's post I demonstrated a C# Custom Implementation for the OLEDB Simple Provider. This effectively allows us to write our own OLE DB Provider. The example code given was for in-memory arrays. There is no reason why we could not serve up blocks of Excel cells. Now, the Microsoft.ACE.OLEDB.12.0 OLEDB Provider already does serves Excel worksheets. However, there are a few minor issues that make me want to explore writing an alternative OLEDB Provider.

As demonstrated in yesterday's post we supply a connection string with the ProgId or our COM server (implemented as a COM Interoperable C# assembly). But as far as I can see the connection string does not provide any scope to specify details.

Instead of the connection string, details are specified in the string passed to the ADO.Recordset's Open() method. This means one cannot pass any pointers to Excel workbooks, sheets, ranges etc. One has to pack into one single string enough to identify (1) the Excel Session, (2) the Workbook, (3) the Worksheet, and (4) the Cell Range. This post focuses on identifying and acquiring an Excel session (a subsequent post will handle the remaining items).

Assumes Hwnd Known

Other code on this blog that does similar cycles through all the top windows registered to the Desktop. This code assumes that the Hwnd of Excel.exe session is known, so this is more efficient.

C# dynamic type is a lifesaver

Without the dynamic keyword much of this code would be twice as long with references to primary interop assemblies (PIA) etc. Of note is the fact that Excel.exe in fact returns a COM pointer to the Excel.Window object and thus we need to make a further call to acquire the Excel.Application.

Alternative to the Running Object Table

If all of this sounds like accessing the Running Object Table (ROT) then you'd be right. Normally, I suggest using the ROT. There are reports of a bug in Excel 2016, the GetObject() VBA function allows the accessing of objects registered in the ROT. GetObject() is reportedly broken. This bug would hinder access to ROT. Now, I have written a separate C# ROT Viewer and the source code is on my sister C# blog but if the Running Object Table is fading as a usable technique then finding another way to do cross process communication is useful.

Mind you, the following GetObject() code works for me ...

Sub TestGetObject()
    Dim obj As Object
    Set obj = GetObject(, "Excel.Application")
    Debug.Assert obj Is Excel.Application

    Set obj = GetObject(ThisWorkbook.FullName)
End Sub

C# Assembly Source Code

So this needs to be packed into a C# Assembly that is registered for Interop; Visual Studio will need to run with Administrator privileges to register.

using System;
using System.Runtime.InteropServices;

namespace XlMoniker
{
    [ComVisible(true)]
    public interface IXlMoniker
    {

        bool GetExcelByHwnd(int lhwndApp, ref object app);
        //bool GetExcelRangeFromMoniker(string sMoniker, ref object rngRetVal);
        //string ExcelRangeToMoniker(object rng);
    }

    [ClassInterface(ClassInterfaceType.None)]
    [ComDefaultInterface(typeof(IXlMoniker))]
    [ComVisible(true)]
    public class XlMoniker : IXlMoniker
    {
        const char separator = '`';

        [DllImport("user32.dll", SetLastError = true)]
        static extern IntPtr FindWindowEx(IntPtr hwndParent, IntPtr hwndChildAfter, string lpszClass, string lpszWindow);


        [DllImport("oleacc.dll", SetLastError = true)]
        internal static extern int AccessibleObjectFromWindow(IntPtr hwnd, uint id, ref Guid iid,
                                                    [In, Out, MarshalAs(UnmanagedType.IUnknown)] ref object ppvObject);

        bool IXlMoniker.GetExcelByHwnd(int lhwndApp2, ref object appRetVal)
        {
            bool bRetVal = false;

            IntPtr lhwndApp = (IntPtr)lhwndApp2;

            IntPtr lHwndDesk = FindWindowEx(lhwndApp, IntPtr.Zero, "XLDESK", "");
            if (lHwndDesk != IntPtr.Zero)
            {

                IntPtr lHwndExcel7 = FindWindowEx(lHwndDesk, IntPtr.Zero, "EXCEL7", null);
                if (lHwndExcel7 != IntPtr.Zero)
                {
                    Guid IID_IDispatch = new Guid("{00020400-0000-0000-C000-000000000046}");
                    const uint OBJID_NATIVEOM = 0xFFFFFFF0;
                    object app = null;
                    if (AccessibleObjectFromWindow(lHwndExcel7, OBJID_NATIVEOM, ref IID_IDispatch, ref app) == 0)
                    {
                        dynamic appWindow = app;
                        appRetVal = appWindow.Application;
                        return true;
                    }
                }
            }
            return bRetVal;
        }
    }
}

Client VBA Source Code

I packed the C# code into the same Assembly as yesterday's post on OLE DB providers so it happes to share the same library name, SimpleOLEDBProvider1 .

Private Sub Test_XlMoniker_GetExcelByHwnd()

    Dim oMoniker As SimpleOLEDBProvider1.XlMoniker
    Set oMoniker = New SimpleOLEDBProvider1.XlMoniker
    
    Dim obj As Excel.Application
    If oMoniker.GetExcelByHwnd(Application.hwnd, obj) Then
        Debug.Assert obj Is Application
    End If

End Sub

Can I Implement the same IAccessible technique for my Applications?

So, given that this is a useful cross-process communication technique you might be thinking can I implement this technique for my code. The answer is yes, here is the link, Using OBJID_NATIVEOM to expose a native object model interface for a window _ Microsoft Docs. However, the article implies one has access to the windows message pump, one does in C++, in C# I'd have to research that. Asking on StackOverflow here.

Monday 29 October 2018

OLEDB Simple Provider C# Custom Implementation

I am delighted to be able to say that I have succeeded in getting a C# Custom Implementation of a Data Source for use with the OLEDB Simple Provider. The code below demonstrates how to access in-memory arrays via ADO Recordsets for use in VBA clients..

This posts follows on from both the OLEDB Simple Provider OSP Toolkit Documentation post and the OLEDB Simple Provider - C++ Sample Step Thru post; together these form the investigation and documentation posts. I have been playing detective with this technology and have stepped through an old C++ sample, Googling for details as to how it works and accumulating documentation links before they fade forever. These have now given fruit in this post which shows how to achieve the same in C#.

The OLEDB Simple Provider

Writing a full OLEDB Provider is very hard, I've had some problems compiling even the free ATL/OLEDB sample that comes with Visual Studio 2017. A full OLEDB Provider requires the full implementation of a great many COM interfaces. Active Template Library (ATL) goes some way to give C++ default implementations of these interfaces but nevertheless OLEDB is complicated. As OLEDB is being replaced by .NET technologies, OLEDB is not worth hugely investing in.

So it is excellent news to know that there is the Simple Provider which provides a framework which a developer can customise by implementing only two (at minimum) interfaces, DataSource and OLEDBSimpleProvider. This is like being given a base class from which to inherit and override a minimum number of methods. Timesaver. Lifesaver.

C# Assembly Source Code

The following source code is for a .NET Framework Assembly (I built against .NET Framework 4.6.1) , register for COM interop and run Visual Studio under Administrator rights so it can access the registry.

Hard coded demonstration tables.

So I wanted to focus on the two interfaces that require implementing, DataSource and OLEDBSimpleProvider. To that end the code below does not connect to a database for its data, or open a file or read from a block of cells from an Excel worksheet. Instead to keep things simple, it initializes an in-memory array which is the case below is hard coded.

Clearly, the array could be dynamic as part of your own application. It should also be obvious that you can write your own code to open a file acting as a database.

The code below is also usefully annotated with links to Microsoft Docs.

C# Project requires references to COM libraries MSDATASRC and MSDAOSP

To make the code below compile you will need to add COM references to two separate type libraries. I give the file locations here below, though they may differ for your installation. You can also find them by looking through a VBA Tools->References dialog for there descriptions also given below.

C:\Windows\SysWOW64\msdatsrc.tlb - MSDATASRC - Microsoft Data Source Interfaces for ActiveX Data Binding Type Library
C:\Windows\SysWOW64\simpdata.tlb - MSDAOSP   - Microsoft OLE DB Simple Provider 1.5 Library

Once compiled and registered (don't forget Visual Studio needs Administrator rights to register your assembly in the registry), then you can run the sample VBA code given below (page/scroll down).

using MSDAOSP;
using MSDATASRC;
using System;
using System.Runtime.InteropServices;
using System.Collections.Generic;
using System.Threading;

// Added COM Reference to C:\Windows\SysWOW64\msdatsrc.tlb - MSDATASRC - Microsoft Data Source Interfaces for ActiveX Data Binding Type Library
// Added COM Reference to C:\Windows\SysWOW64\simpdata.tlb - MSDAOSP   - Microsoft OLE DB Simple Provider 1.5 Library

namespace SimpleOLEDBProvider1

{
    [ClassInterface(ClassInterfaceType.None)]
    [ComDefaultInterface(typeof(MSDATASRC.DataSource))]
    [ComVisible(true)]
    public class MyDataSource : MSDATASRC.DataSource
    {
        
        List<MSDATASRC.DataSourceListener> _listListeners = new List<MSDATASRC.DataSourceListener>();
        Dictionary<string, MyCustomRecordset> _dataMembers = new Dictionary<string, MyCustomRecordset>();


        ~MyDataSource()
        {   // release all listeners
            while (_listListeners.Count > 0)
            {
                MSDATASRC.DataSourceListener head = _listListeners[0];
                head = null; // calls IUnknown::Release (hopefully)
                _listListeners.RemoveAt(0);
            }
        }

        void MSDATASRC.DataSource.addDataSourceListener(DataSourceListener pDSL)
        {   // https://docs.microsoft.com/en-us/previous-versions/windows/desktop/ms716931(v=vs.85)
            _listListeners.Add(pDSL);
        }

        dynamic MSDATASRC.DataSource.getDataMember(string bstrDM, ref Guid riid)
        {   // https://docs.microsoft.com/en-us/previous-versions/windows/desktop/ms724549(v=vs.85)

            MyCustomRecordset retval = null;

            if (_dataMembers.ContainsKey(bstrDM))
            {
                retval = _dataMembers[bstrDM];
            }
            else
            {
                retval = new MyCustomRecordset();
                retval.Initialize(bstrDM);
                _dataMembers.Add(bstrDM, retval);
            }

            return retval;
        }

        string MSDATASRC.DataSource.getDataMemberName(int lIndex)
        {   // https://docs.microsoft.com/en-us/previous-versions/windows/desktop/ms715947(v=vs.85)
            List<string> keys = new List<string>();
            keys.AddRange(_dataMembers.Keys);
            return keys[lIndex];
        }

        int MSDATASRC.DataSource.getDataMemberCount()
        {   // https://docs.microsoft.com/en-us/previous-versions/windows/desktop/ms721173(v=vs.85)
            return _dataMembers.Count;
        }

        void MSDATASRC.DataSource.removeDataSourceListener(DataSourceListener pDSL)
        {   // https://docs.microsoft.com/en-us/previous-versions/windows/desktop/ms724012(v=vs.85)
            _listListeners.Remove(pDSL);
        }
    }

    [ClassInterface(ClassInterfaceType.None)]
    [ComDefaultInterface(typeof(MSDAOSP.OLEDBSimpleProvider))]
    [ComVisible(true)]
    public class MyCustomRecordset : MSDAOSP.OLEDBSimpleProvider
    {
        private List<object[]> _tabularData = null;
        private string _bstrDM = null;
        private List<MSDAOSP.OLEDBSimpleProviderListener> _listListeners = new List<MSDAOSP.OLEDBSimpleProviderListener>();

        ~MyCustomRecordset()
        {
            while (_listListeners.Count > 0)
            {
                MSDAOSP.OLEDBSimpleProviderListener head = _listListeners[0];
                head = null; // calls IUnknown::Release (hopefully)
                _listListeners.RemoveAt(0);
            }
        }

        public void Initialize(string bstrDM)
        {
            //
            // we got some hard coded statrting tables for demonstration purposes only
            // in a real situation one would open a file or something
            //
            switch (bstrDM.ToLower())
            {
                case "customers":

                    _tabularData = new List<object[]>();
                    _tabularData.Add(new object[4] { "CustomerId", "CustomerName", "ContactName", "Country" });
                    _tabularData.Add(new object[4] { 1, "Big Corp", "Mandy", "USA" });
                    _tabularData.Add(new object[4] { 2, "Medium Corp", "Bob", "Canada" });
                    _tabularData.Add(new object[4] { 3, "Small Corp", "Jose", "Mexico" });

                    break;
                case "orders":

                    _tabularData = new List<object[]>();
                    _tabularData.Add(new object[3] { "OrderId", "CustomerId", "OrderDate" });
                    _tabularData.Add(new object[3] { 420, 2, new DateTime(2018, 10, 10) });
                    _tabularData.Add(new object[3] { 421, 3, new DateTime(2018, 10, 11) });
                    _tabularData.Add(new object[3] { 422, 1, new DateTime(2018, 10, 12) });
                    _tabularData.Add(new object[3] { 423, 2, new DateTime(2018, 10, 13) });

                    break;
                default:
                    // if unrecognised hand back default of colors
                    _tabularData = new List<object[]>();
                    _tabularData.Add(new object[2] { "ColorName", "ColorRGB" });
                    _tabularData.Add(new object[2] { "Red", "FF0000" });
                    _tabularData.Add(new object[2] { "Green", "00FF00" });
                    _tabularData.Add(new object[2] { "Blue", "0000FF" });
                    break;
            }

            _bstrDM = bstrDM;
        }

        void OLEDBSimpleProvider.addOLEDBSimpleProviderListener(OLEDBSimpleProviderListener pospIListener)
        {   // https://docs.microsoft.com/en-us/previous-versions/windows/desktop/ms713697(v=vs.85)
            _listListeners.Add(pospIListener);
        }

        int OLEDBSimpleProvider.deleteRows(int iRow, int cRows)
        {   // https://docs.microsoft.com/en-us/previous-versions/windows/desktop/ms713665(v=vs.85)

            // Notify our Listeners:
            foreach (OLEDBSimpleProviderListener listener in _listListeners)
                listener.aboutToDeleteRows(iRow, cRows);

            _tabularData.RemoveRange(iRow, cRows);

            // Notify our Listeners:
            foreach (OLEDBSimpleProviderListener listener in _listListeners)
                listener.deletedRows(iRow, cRows);

            return cRows;
        }

        int OLEDBSimpleProvider.find(int iRowStart, int iColumn, object val, OSPFIND findFlags, OSPCOMP compType)
        {   // https://docs.microsoft.com/en-us/previous-versions/windows/desktop/ms709764(v=vs.85)
            // not yet implemented
            return -1;
        }


        int OLEDBSimpleProvider.getColumnCount()
        {   // https://docs.microsoft.com/en-us/previous-versions/windows/desktop/ms715965(v=vs.85)

            object[] colHeaders = _tabularData[0];
            int totalColumnCount = colHeaders.Length;
            return totalColumnCount;
        }

        int OLEDBSimpleProvider.getEstimatedRows()
        {   // https://docs.microsoft.com/en-us/previous-versions/windows/desktop/ms713703(v=vs.85)
            // should not include row header

            int totalRowCount = _tabularData.Count;
            return (totalRowCount - 1);
        }

        string OLEDBSimpleProvider.getLocale()
        {   // https://docs.microsoft.com/en-us/previous-versions/windows/desktop/ms711216(v=vs.85)
            //return "en-us";
            var name = Thread.CurrentThread.CurrentCulture.Name;
            var locale = name.Split('-')[1];
            return locale;
        }

        int OLEDBSimpleProvider.getRowCount()
        {
            // https://docs.microsoft.com/en-us/previous-versions/windows/desktop/ms715931(v=vs.85)
            // should not include row header

            int totalRowCount = _tabularData.Count;
            return (totalRowCount - 1);
        }

        OSPRW OLEDBSimpleProvider.getRWStatus(int iRow, int iColumn)
        {
            // https://docs.microsoft.com/en-us/previous-versions/windows/desktop/ms709946(v=vs.85)
            return OSPRW.OSPRW_READWRITE;
        }

        dynamic OLEDBSimpleProvider.getVariant(int iRow, int iColumn, OSPFORMAT format)
        {
            // https://docs.microsoft.com/en-us/previous-versions/windows/desktop/ms725341(v=vs.85)

            if (iRow < _tabularData.Count)
            {
                object[] row = _tabularData[iRow];
                return row[iColumn - 1];  // columns start at 1 it seems
            }
            else
            {
                // oddly, when a record is removed we still get called for dead row
                // so until we diagnose and fix this bug return a null
                return null;
            }
        }

        int OLEDBSimpleProvider.insertRows(int iRow, int cRows)
        {   // https://docs.microsoft.com/en-us/previous-versions/windows/desktop/ms721207(v=vs.85)

            object[] colHeaders = _tabularData[0];
            int totalColumnCount = colHeaders.Length;

            object[] blankRow = new object[totalColumnCount];

            // Notify our Listeners:
            foreach (OLEDBSimpleProviderListener listener in _listListeners)
                listener.aboutToInsertRows(iRow, cRows);


            for (int i = 0; i < cRows; i++)
            {
                _tabularData.Insert(iRow, blankRow);
            }

            // Notify our Listeners:
            foreach (OLEDBSimpleProviderListener listener in _listListeners)
                listener.insertedRows(iRow, cRows);

            return cRows;
        }

        int OLEDBSimpleProvider.isAsync()
        {   // https://docs.microsoft.com/en-us/previous-versions/windows/desktop/ms723042(v=vs.85)
            return 0; // not async
        }


        void OLEDBSimpleProvider.removeOLEDBSimpleProviderListener(OLEDBSimpleProviderListener pospIListener)
        {   // https://docs.microsoft.com/en-us/previous-versions/windows/desktop/ms712993(v=vs.85)
            _listListeners.Remove(pospIListener);
        }

        void OLEDBSimpleProvider.setVariant(int iRow, int iColumn, OSPFORMAT format, object Var)
        {   // https://docs.microsoft.com/en-us/previous-versions/windows/desktop/ms714366(v=vs.85)

            // Notify our Listeners:
            foreach (OLEDBSimpleProviderListener listener in _listListeners)
                listener.aboutToChangeCell(iRow, iColumn);

            object[] row = _tabularData[iRow];
            row[iColumn - 1] = Var;

            _tabularData[iRow] = row;

            // Notify our Listeners:
            foreach (OLEDBSimpleProviderListener listener in _listListeners)
                listener.cellChanged(iRow, iColumn);

        }

        void OLEDBSimpleProvider.stopTransfer()
        {   // https://docs.microsoft.com/en-us/previous-versions/windows/desktop/ms722788(v=vs.85)
            // we do not handle async ops
        }
    }
}

VBA Client Code

So now you have compiled and registered above C# code now you can run client VBA code. You will need a reference to an ADO type library.

So to get an ADO recordset created by the C# custom implementation one does the following:

  1. Create an ADO.Connection, supply the OLEDB Simple Provider and the ProgID of the C# custom implementation as Data Source;
  2. Create a ADO.RecordSet, set the ActiveConnection property to that created in step (1);
  3. Call the newly created recordSet's Open method supplying the table name.

In given example, the string passed into the RecordSet.Open method is a table name but one can write the code to parse and evaluate a more complicated expression.

Looking through the client code, you'll be able I have commented out some lines which call Recordset.Seek or Recordset.Sort methods because they are not supported and throw errors.

    'rsColors.Seek "Green"  '* throws error "Current provider does not support the necessary interface for Index functionality."
    'rsColors.Sort = "colorName" '* throws error "Current provider does not support the necessary interfaces for sorting or filtering."

But actually you can seek using the Recordset.Filter method. You can add and delete records happily, don't forget to call Recordset.Update. Code to add and delete records is given.

On the matter of sorting you could supply more text to the Recordset.Open method such as a 'Sort By <fieldName>' clause and change the implementation from being a List to a sortable collection class.

In fact you can supply so much more in the string passed to the Recordset.Open method. You could pass a whole SQL command just like other OLEDB providers but you will have to write your own SQL parsing code.

Also in the code below we take a snapshot of the recordset into a variant array. Snapshots are driven by the Recordset.GetRows method. This is also the same logic that drives the Range.CopyFromRecordset method which allows quick writing of a recordset to a block of cells (some commented out code for this is also given).

Enjoy!

Option Explicit

'* Tools->References
'ADODB      Microsoft ActiveX Data Objects 6.1 Library  C:\Program Files (x86)\Common Files\System\ado\msado15.dll

Sub TestCustomSimpleProvider()
    Dim vVarArray
    

    Dim oConn As ADODB.Connection
    Set oConn = New ADODB.Connection
    
    '*
    '* SimpleOLEDBProvider1.MyDataSource is progid of the custom simple provider
    '*
    oConn.Open "Provider=MSDAOSP;Data Source=SimpleOLEDBProvider1.MyDataSource"
    
    Dim rsColors As ADODB.Recordset
    Set rsColors = New ADODB.Recordset

    Set rsColors.ActiveConnection = oConn

    rsColors.Open "colors"
    
    '*
    '* what it doesn't do:
    '* (a) seeking on an index
    '* (b) sorting
    '*
    
    'rsColors.Seek "Green"  '* throws error "Current provider does not support the necessary interface for Index functionality."
    'rsColors.Sort = "colorName" '* throws error "Current provider does not support the necessary interfaces for sorting or filtering."
    
    '*
    '* what it does do:
    '* (1) filtering
    '* (2) adding
    '* (3) removing
    '*
    
    Debug.Assert rsColors.RecordCount = 3
    rsColors.Filter = "colorName='Green' or colorName='Red'"
    rsColors.Update
    Debug.Assert rsColors.RecordCount = 2
    
    rsColors.Filter = ""
    
    rsColors.AddNew
    rsColors!ColorName = "Yellow"
    rsColors!ColorRGB = "FFFF00"
    rsColors.Update
    
    Debug.Assert rsColors.RecordCount = 4
    
    rsColors.MoveFirst
    rsColors.Delete
    rsColors.Update
    
    Debug.Assert rsColors.RecordCount = 3
    
    
    rsColors.MoveFirst
    vVarArray = Application.WorksheetFunction.Transpose(rsColors.GetRows)
    Stop

    Dim rsCustomers As ADODB.Recordset
    Set rsCustomers = New ADODB.Recordset

    Set rsCustomers.ActiveConnection = oConn
    rsCustomers.Open "customers"

    vVarArray = Application.WorksheetFunction.Transpose(rsCustomers.GetRows)
    Stop
    
    Dim rsOrders As ADODB.Recordset
    Set rsOrders = New ADODB.Recordset
    
    Set rsOrders.ActiveConnection = oConn
    
    rsOrders.Open "Orders"
    vVarArray = Application.WorksheetFunction.Transpose(rsOrders.GetRows)

    '* uncomment the following to test writing whole recordset to worksheet in one go
    'Dim rng As Excel.Range
    'Set rng = ThisWorkbook.Worksheets.Item(1).Cells(1, 1)
    'rsOrders.MoveFirst
    'rng.CopyFromRecordset rsOrders
    
    Stop
End Sub

Links

Sunday 28 October 2018

OLEDB Simple Provider (OSP) Toolkit Documentation

Introduction

A StackOverflow question prompted me to look for an OLE DB Provider for Xml. This gave the top result of the Microsoft OLE DB Simple Provider | Microsoft Docs. There is some eye-catching text in its description that says

Simple providers are intended to access data sources that require only fundamental OLE DB support, such as in-memory arrays or XML documents.

I blogged the Xml aspect previously, so putting the Xml to one side, the text (I have bolded) says in-memory arrays. I have been looking for some kind of ADO interface for an in memory array for a little while. What is disappointing is that this technology is old so we cannot invest too much time in it. Nevertheless, I have done some surfing and am depositing some findings here on this post.

No Xml please, tell me about In-memory arrays

So I used Google to exclude Xml from results, Provider=MSDAOSP; in memory array -xml - Google Search.

From the link Implementing an ADO Server we can see that the interface guid (IID) is E0E270C0-C0BE-11D0-8FE4-00A0C90A6341}. Looking up this in the registry I find

Windows Registry Editor Version 5.00

[HKEY_CLASSES_ROOT\Interface\{E0E270C0-C0BE-11D0-8FE4-00A0C90A6341}]
@="OLEDBSimpleProvider"

[HKEY_CLASSES_ROOT\Interface\{E0E270C0-C0BE-11D0-8FE4-00A0C90A6341}\ProxyStubClsid]
@="{00020424-0000-0000-C000-000000000046}"

[HKEY_CLASSES_ROOT\Interface\{E0E270C0-C0BE-11D0-8FE4-00A0C90A6341}\ProxyStubClsid32]
@="{00020424-0000-0000-C000-000000000046}"

[HKEY_CLASSES_ROOT\Interface\{E0E270C0-C0BE-11D0-8FE4-00A0C90A6341}\TypeLib]
@="{E0E270C2-C0BE-11D0-8FE4-00A0C90A6341}"
"Version"="1.5"

So in the above there is a type library guid (LIBID) so we can look for that and we find

Windows Registry Editor Version 5.00

[HKEY_CLASSES_ROOT\TypeLib\{E0E270C2-C0BE-11D0-8FE4-00A0C90A6341}]

[HKEY_CLASSES_ROOT\TypeLib\{E0E270C2-C0BE-11D0-8FE4-00A0C90A6341}\1.5]
@="Microsoft OLE DB Simple Provider 1.5 Library"

[HKEY_CLASSES_ROOT\TypeLib\{E0E270C2-C0BE-11D0-8FE4-00A0C90A6341}\1.5\0]

[HKEY_CLASSES_ROOT\TypeLib\{E0E270C2-C0BE-11D0-8FE4-00A0C90A6341}\1.5\0\win32]
@="C:\\Windows\\SysWOW64\\simpdata.tlb"

[HKEY_CLASSES_ROOT\TypeLib\{E0E270C2-C0BE-11D0-8FE4-00A0C90A6341}\1.5\0\win64]
@="C:\\Windows\\System32\\simpdata.tlb"

[HKEY_CLASSES_ROOT\TypeLib\{E0E270C2-C0BE-11D0-8FE4-00A0C90A6341}\1.5\FLAGS]
@="0"

In the above we can see a path to the type library C:\\Windows\\SysWOW64\\simpdata.tlb . An excel workbook's VBA project can make a reference to this type library by selecting Microsoft OLE DB Simple Provider 1.5 Library because happily the type library is restricted to automation types; with a VBA reference one can inspect the type library via the Object Browser. However for fans of IDL and because it can be pasted as one long text document here is the IDL as given by OLEView.exe.

// Generated .IDL file (by the OLE/COM Object Viewer)
// 
// typelib filename: simpdata.tlb

[
  uuid(E0E270C2-C0BE-11D0-8FE4-00A0C90A6341),
  version(1.5),
  helpstring("Microsoft OLE DB Simple Provider 1.5 Library")
]
library MSDAOSP
{
    // TLib : OLE Automation : {00020430-0000-0000-C000-000000000046}
    importlib("stdole2.tlb");

    // Forward declare all types defined in this typelib
    interface OLEDBSimpleProviderListener;
    interface OLEDBSimpleProvider;

    typedef enum {
        OSPFORMAT_RAW = 0,
        OSPFORMAT_DEFAULT = 0,
        OSPFORMAT_FORMATTED = 1,
        OSPFORMAT_HTML = 2
    } OSPFORMAT;

    typedef enum {
        OSPRW_DEFAULT = 1,
        OSPRW_READONLY = 0,
        OSPRW_READWRITE = 1,
        OSPRW_MIXED = 2
    } OSPRW;

    typedef enum {
        OSPFIND_DEFAULT = 0,
        OSPFIND_UP = 1,
        OSPFIND_CASESENSITIVE = 2,
        OSPFIND_UPCASESENSITIVE = 3
    } OSPFIND;

    typedef enum {
        OSPCOMP_EQ = 1,
        OSPCOMP_DEFAULT = 1,
        OSPCOMP_LT = 2,
        OSPCOMP_LE = 3,
        OSPCOMP_GE = 4,
        OSPCOMP_GT = 5,
        OSPCOMP_NE = 6
    } OSPCOMP;

    typedef enum {
        OSPXFER_COMPLETE = 0,
        OSPXFER_ABORT = 1,
        OSPXFER_ERROR = 2
    } OSPXFER;

    [
      odl,
      uuid(E0E270C1-C0BE-11D0-8FE4-00A0C90A6341),
      version(1.4),
      oleautomation
    ]
    interface OLEDBSimpleProviderListener : IUnknown {
        HRESULT _stdcall aboutToChangeCell(
                        [in] long iRow, 
                        [in] long iColumn);
        HRESULT _stdcall cellChanged(
                        [in] long iRow, 
                        [in] long iColumn);
        HRESULT _stdcall aboutToDeleteRows(
                        [in] long iRow, 
                        [in] long cRows);
        HRESULT _stdcall deletedRows(
                        [in] long iRow, 
                        [in] long cRows);
        HRESULT _stdcall aboutToInsertRows(
                        [in] long iRow, 
                        [in] long cRows);
        HRESULT _stdcall insertedRows(
                        [in] long iRow, 
                        [in] long cRows);
        HRESULT _stdcall rowsAvailable(
                        [in] long iRow, 
                        [in] long cRows);
        HRESULT _stdcall transferComplete([in] OSPXFER xfer);
    };

    [
      odl,
      uuid(E0E270C0-C0BE-11D0-8FE4-00A0C90A6341),
      version(1.4),
      oleautomation
    ]
    interface OLEDBSimpleProvider : IUnknown {
        HRESULT _stdcall getRowCount([out, retval] long* pcRows);
        HRESULT _stdcall getColumnCount([out, retval] long* pcColumns);
        HRESULT _stdcall getRWStatus(
                        [in] long iRow, 
                        [in] long iColumn, 
                        [out, retval] OSPRW* prwStatus);
        HRESULT _stdcall getVariant(
                        [in] long iRow, 
                        [in] long iColumn, 
                        [in] OSPFORMAT format, 
                        [out, retval] VARIANT* pVar);
        HRESULT _stdcall setVariant(
                        [in] long iRow, 
                        [in] long iColumn, 
                        [in] OSPFORMAT format, 
                        [in] VARIANT Var);
        HRESULT _stdcall getLocale([out, retval] BSTR* pbstrLocale);
        HRESULT _stdcall deleteRows(
                        [in] long iRow, 
                        [in] long cRows, 
                        [out, retval] long* pcRowsDeleted);
        HRESULT _stdcall insertRows(
                        [in] long iRow, 
                        [in] long cRows, 
                        [out, retval] long* pcRowsInserted);
        HRESULT _stdcall find(
                        [in] long iRowStart, 
                        [in] long iColumn, 
                        [in] VARIANT val, 
                        [in] OSPFIND findFlags, 
                        [in] OSPCOMP compType, 
                        [out, retval] long* piRowFound);
        HRESULT _stdcall addOLEDBSimpleProviderListener([in] OLEDBSimpleProviderListener* pospIListener);
        HRESULT _stdcall removeOLEDBSimpleProviderListener([in] OLEDBSimpleProviderListener* pospIListener);
        HRESULT _stdcall isAsync([out, retval] long* pbAsynch);
        HRESULT _stdcall getEstimatedRows([out, retval] long* piRows);
        HRESULT _stdcall stopTransfer();
    };
};

So in the interface definition we can see some usefully unique keywords which we can use a search terms to search for sample code. And we find a good but old volume Serious ADO: Universal Data Access with Visual Basic - Rob MacDonald - Google Books which gives us some hints about how to write a VB6 component but it becomes apparent that one needs an actual VB6 copy because there is a widget to implement an interface that is otherwise restricted to VB6 developers. I have tracked the type library

MSDATASRC     Microsoft Data Source Interfaces for ActiveX Data Binding Type Library     C:\Windows\SysWOW64\msdatsrc.tlb

And I give the type library's IDL

// Generated .IDL file (by the OLE/COM Object Viewer)
// 
// typelib filename: msdatsrc.tlb

[
  uuid(7C0FFAB0-CD84-11D0-949A-00A0C91110ED),
  version(1.0),
  helpstring("Microsoft Data Source Interfaces for ActiveX Data Binding Type Library")
]
library MSDATASRC
{
    // TLib : OLE Automation : {00020430-0000-0000-C000-000000000046}
    importlib("stdole2.tlb");

    // Forward declare all types defined in this typelib
    interface DataSourceListener;
    interface DataSource;

    typedef [uuid(7C0FFAB1-CD84-11D0-949A-00A0C91110ED), public]
    BSTR DataMember;

    [
      odl,
      uuid(7C0FFAB2-CD84-11D0-949A-00A0C91110ED),
      hidden,
      oleautomation
    ]
    interface DataSourceListener : IUnknown {
        [hidden]
        HRESULT _stdcall dataMemberChanged([in] DataMember bstrDM);
        [hidden]
        HRESULT _stdcall dataMemberAdded([in] DataMember bstrDM);
        [hidden]
        HRESULT _stdcall dataMemberRemoved([in] DataMember bstrDM);
    };

    [
      odl,
      uuid(7C0FFAB3-CD84-11D0-949A-00A0C91110ED),
      oleautomation
    ]
    interface DataSource : IUnknown {
        [restricted, hidden]
        HRESULT _stdcall getDataMember(
                        [in] DataMember bstrDM, 
                        [in] GUID* riid, 
                        [out, retval] IUnknown** ppunk);
        [hidden]
        HRESULT _stdcall getDataMemberName(
                        [in] long lIndex, 
                        [out, retval] DataMember* pbstrDM);
        [hidden]
        HRESULT _stdcall getDataMemberCount([out, retval] long* plCount);
        [hidden]
        HRESULT _stdcall addDataSourceListener([in] DataSourceListener* pDSL);
        [hidden]
        HRESULT _stdcall removeDataSourceListener([in] DataSourceListener* pDSL);
    };
};

So the restricted method on the interface DataSource prevents VBA from implementing this interface. Any source code for VB6 would rely upon a widget. This means that only the Delphi article, Implementing an ADO Server and any C++ source code we can find can give us a clue as to how this can be implemented. It ought to be possible to implement in C#.

API Links

MSDATASRC.DataSource Interface Methods

DataSource Interface and Methods is defined in MSDATASRC namespace as imported by reference to C:\\Windows\\SysWOW64\\msdatsrc.tlb

MSDATASRC.DataSourceListener Interface Methods

DataSourceListener Interface and Methods is defined in MSDATASRC namespace as imported by reference to C:\\Windows\\SysWOW64\\msdatsrc.tlb

MSDAOSP.OLEDBSimpleProvider Interface Methods

OLEDBSimpleProvider Interface and Methods are defined in MSDAOSP namespace as imported by reference to C:\\Windows\\SysWOW64\\simpdata.tlb

MSDAOSP.OLEDBSimpleProviderListener Interface Methods

OLEDBSimpleProviderListener Interface and Methods are defined in MSDAOSP namespace as imported by reference to C:\\Windows\\SysWOW64\\simpdata.tlb

Other OLEDB Links

Other Links

Saturday 27 October 2018

VBA - Fabricate an ADO Recordset for Sorting and Filtering

In VBA we can fabricate an ADO Recordset without any database whatsoever. Then we can take advantage of filtering and sorting.

This is in response to a Stack Overflow question - How to sort a subset according to some ordered superset?


Sub Test()

    Dim rstADO As ADODB.Recordset
    Dim fld As ADODB.Field

    Set rstADO = New ADODB.Recordset
    With rstADO
        .Fields.Append "Animal", adVarChar, 20
        .Fields.Append "BirthDay", adDate, FieldAttributeEnum.adFldKeyColumn
        .Fields.Append "ArrivalSequence", adInteger
    
        .CursorType = adOpenKeyset
        .CursorLocation = adUseClient
        .LockType = adLockPessimistic
        .Open
        
        .AddNew Array("Animal", "BirthDay", "ArrivalSequence"), Array("Cow", Now() - 200, 1)
        .AddNew Array("Animal", "BirthDay", "ArrivalSequence"), Array("Horse", Now() - 100, 2)
        .AddNew Array("Animal", "BirthDay", "ArrivalSequence"), Array("Pig", Now() - 150, 3)
        .AddNew Array("Animal", "BirthDay", "ArrivalSequence"), Array("Chicken", Now() - 120, 4)
        .AddNew Array("Animal", "BirthDay", "ArrivalSequence"), Array("Goat", Now() - 180, 5)
        .AddNew Array("Animal", "BirthDay", "ArrivalSequence"), Array("Dog", Now() - 140, 5)
        
        
        .Filter = "Animal='Cow' or Animal='Dog' or Animal='Pig'  or Animal='Horse'"
        
        Dim vSnap As Variant
        .MoveFirst
        vSnap = .GetRows
        
        Debug.Assert vSnap(0, 0) = "Cow"
        Debug.Assert vSnap(0, 1) = "Horse"
        Debug.Assert vSnap(0, 2) = "Pig"
        Debug.Assert vSnap(0, 3) = "Dog"
        
        
        '*
        '* Now sort according to birthday
        '*
        .Sort = "BirthDay"
        
            
        Dim vSnap2 As Variant
        .MoveFirst
        vSnap2 = .GetRows
        
        Debug.Assert vSnap2(0, 0) = "Cow"
        Debug.Assert vSnap2(0, 1) = "Pig"
        Debug.Assert vSnap2(0, 2) = "Dog"
        Debug.Assert vSnap2(0, 3) = "Horse"
            
            
    End With

End Sub

Links

Tuesday 23 October 2018

OLEDB Simple Provider - C++ Sample Step Thru

It is with delight that I can report that I found a OLEDB Simple Provider C++ sample that Microsoft had deposited in Github for posterity. I got it working with a little tweak and was able to write some client VBA ADO code to retrieve an ADO recordset. I also managed to step through the code to document the interaction.

Context - Data Access Solutions

I have been surveying data access solution for working with Excel worksheets. I have found the Microsoft.ACE.OLEDB provider but I have found some weaknesses with it and was wondering what else is possible. As a caveat, it is worth noting Microsoft say they will remove this feature (OLEDB Simple Provider) from a future version of Windows. Nevertheless, for due diligence this solution ought to be explored (later I intend to investigate .NET managed data providers which will be more future proof).

Context - OLEDB Simple Provider VB6 sample

Also note that I have been investigating trying to write a custom implementation for the OLEDB Simple Provider using VBA. VBA is extremely close to VB6. Unfortunately, VB6 has a few extra mechanisms to assist the interaction with the underlying OLEDB Simple Provider interfaces. These extra mechanisms are simply not present in VBA rendering any VB6 code informative but unusable. So I needed to step through the C++ sample because I want to write a C# implementation.

Because a VBA solution is not possible we need to drop down to lower level, C++, so we can figure out how to write a C# implementation.

Client VBA Code

Below is ordinary client VBA ADO code. The key details are in the ADO connection string and the string passed to ADO recordset's Open method.

The connection is critical to correctly using the OLEDB Simple Provider. First, we first specify Provider=MSDAOSP; in all cases. The second term Data Source is where we specify a COM ProgId of a COM class which implements IDataSource. In this case we pass Data Source=ospsampc because ospsampc is the ProgId of the Windows sample. The registry settings can be found in Appendix A .

The other key detail is what is passed to ADO recordset's Open method. In the sample a file path is passed. However, there is no reason why a different implementation may pass a web url or a COM moniker. In the sample code, the file is opened and processed; it is semicolon separated with a row and column count on the top row (see Appendix B).

Option Explicit

'* Tools->References
'ADODB      Microsoft ActiveX Data Objects 6.1 Library  C:\Program Files (x86)\Common Files\System\ado\msado15.dll

Sub TestCustom()
    
    Const sFileName As String = "C:\Users\Simon\source\repos\Windows-class-samples\Samples\Win7Samples\dataaccess\osp\customer.txt"
    Debug.Assert Dir(sFileName) <> ""

    Dim oConn As ADODB.Connection
    Set oConn = New ADODB.Connection
    
    '*
    '* ospsampc is progid of the custom simple provider
    '*
    oConn.Open "Provider=MSDAOSP;Data Source=ospsampc"
    
    Dim rs As ADODB.Recordset
    Set rs = New ADODB.Recordset
    
    Set rs.ActiveConnection = oConn
    
    rs.Open sFileName
    rs.MoveFirst
        
    '* lets get the recordset to a variant array
    Dim vVarArray
    vVarArray = rs.GetRows
End Sub

Tweak to given sample code

So the sample code is at Windows-classic-samples/Samples/Win7Samples/dataaccess/osp/vc at master · Microsoft/Windows-classic-samples · GitHub . It compiles fine for me no problem. One slight tweak is that the output filename needs to be changed. So here are instructions...

  1. Right-click on project icon and from menu select Properties
  2. In Property Pages, select General in the left hand pane
  3. On the right hand pane, change Target Name from $(ProjectName) to ospsampc

Call Graph Walkthrough

The choreography between the classes can be a little confusing so I carefully stepped through the code and annotated it as this is the best way to learn the interaction. What you see below is VBA lines of code interleaved with the C++ sample code that gets called (typically via the OLEDB Simple Provider Dll, msdaosp.dll). Most of it is COM QueryInterface and COM initialisation. I have omitted calls to AddRef, Release and and calls to listening mechanisms as they cluttered the graph.

I recommend reading through the call graph but if you want a summary here it is VBA passes in the conn

  1. VBA passes ADO a connection string to the Connection.Open method, Provider=MSDAOSP;Data Source=ospsampc
  2. ADO sees the Provider=MSDAOSP and knows to load the OLEDB Simple Provider and passes control to its Dll, msdaosp.dll
  3. msdaosp.dll parses the second term of the connection string to find the custom implementation's progid, Data Source=ospsampc
  4. The progid ospsampc is found in the registry and the sample dll, ospsampc.dll, is loaded.
  5. ospsampc.dll is called via entry point DllGetClassObject to get an object that implements IClassFactory.
  6. IClassFactory.CreateInstance is called and ospsampc.dll returns an instance of MyDataSource (whilst creating an instance of MyOSPObject for later).
  7. The instance of MyDataSource is queried for interface IDataSource
  8. Control is passed back to VBA
  9. VBA code creates recordset and sets active connection. No sample code is called for this (must be purely ADO and/or msdaosp.dll).

  10. VBA code passes a filepath as the string parameter to the ADO recordset's Open method.
  11. IDataSource::getDataMember is called with the filepath passed in to bstrDM parameter, this method is implemented by MyDataSource::getDataMember.
  12. MyDataSource::getDataMember calls MyOSPObject::Init on its private instance of MyOSPObject passing the filepath as parameter.
  13. MyOSPObject::Init loads the file into memory
  14. MyDataSource::getDataMember queries MyOSPObject for the OLEDBSimpleProvider interface
  15. The OLEDB Simple provider dll, msdaosp.dll can now call MyOSPObject directly on its OLEDBSimpleProvider interface implementation
  16. msdaosp.dll calls MyOSPObject's OLEDBSimpleProvider interface implementation for row and column count etc as part of initialisation
  17. Control is passed back to VBA
  18. From now on, when VBA calls ADO to manipulate recordset msdaosp.dll makes calls on MyOSPObject's OLEDBSimpleProvider interface implementation.

VBA:    oConn.Open "Provider=MSDAOSP;Data Source=ospsampc"
C:\Program Files (x86)\Common Files\system\ole db\msdaosp.dll

 //
 // get the class factory by calling DllGetClassObject
 //
  ospsampc.dll!DllGetClassObject(const _GUID & rclsid, const _GUID & riid, void * * ppvObj) 
   ospsampc.dll!MyClassFactory::MyClassFactory() 
   ospsampc.dll!MyClassFactory::QueryInterface(const _GUID & riid, void * * ppv) 

 //
 // call CreateInstance on class factory, creates a MyDataSource (and during initialisation internally creates a MyOSPObject)
 // returns an IUnknown , no QI for IDataSource yet
 //
  ospsampc.dll!MyClassFactory::CreateInstance(IUnknown * pUnkOuter, const _GUID & riid, void * * ppv) 
   ospsampc.dll!MyDataSource::MyDataSource() 
  ospsampc.dll!MyDataSource::Init() 
    ospsampc.dll!MyOSPObject::MyOSPObject() 
    ospsampc.dll!CExList::CExList() 
  ospsampc.dll!MyDataSource::QueryInterface(const _GUID & riid, void * * ppv) 


 //
 // After some interim calls to QI for IUnknown we soon get a QI for IDataSource
 //
 ospsampc.dll!MyDataSource::QueryInterface(const _GUID & riid, void * * ppv) 

VBA:    Set rs = New ADODB.Recordset
VBA:    Set rs.ActiveConnection = oConn
VBA:    rs.Open sFileName
C:\Program Files (x86)\Common Files\system\ole db\msdaosp.dll

 //
 // the parameter passed by VBA in the rs.Open method is passed as bstrDM below
 // in this case a file path which gthis implementation will load and process
 // but the string could be an a block of COM moniker pointing to a block of cells on an Excel worksheet
 //
 // after initialization MyOSPObject is QI'ed for OLEDBSimpleProvider interface
 //
 ospsampc.dll!MyDataSource::getDataMember(wchar_t * bstrDM, const _GUID & riid, IUnknown * * ppUnk) 
  ospsampc.dll!MyOSPObject::Init(wchar_t * pwszFilePath) 
  ospsampc.dll!MyOSPObject::QueryInterface(const _GUID & riid, void * * ppv) 


C:\Program Files (x86)\Common Files\system\ole db\msdaosp.dll
 //
 // now msdaosp.dll calls MyOSPObject directly to QI for OLEDBSimpleProvider (again)
 // and then starts calling on OLEDBSimpleProvider::getRowCount , OLEDBSimpleProvider::getColumnCount   etc.
 //
 ospsampc.dll!MyOSPObject::QueryInterface(const _GUID & riid, void * * ppv) Line 87 
 ospsampc.dll!MyOSPObject::getRowCount(long * pcRows) 
 ospsampc.dll!MyOSPObject::getColumnCount(long * pcColumns) 
  ospsampc.dll!MyOSPObject::isAsync(int * pbAsynch)


Links

Appendix A - Registry Entries for sample

Windows Registry Editor Version 5.00

[HKEY_LOCAL_MACHINE\SOFTWARE\Classes\WOW6432Node\CLSID\{1E79B2C1-077B-11d1-B3AE-00AA00C1A924}]
@="ospsampc"

[HKEY_LOCAL_MACHINE\SOFTWARE\Classes\WOW6432Node\CLSID\{1E79B2C1-077B-11d1-B3AE-00AA00C1A924}\InprocServer32]
"ThreadingModel"="Both"
@="C:\\Users\\Simon\\source\\repos\\Windows-class-samples\\Samples\\Win7Samples\\dataaccess\\osp\\vc\\Debug\\ospsampc.dll"

[HKEY_LOCAL_MACHINE\SOFTWARE\Classes\WOW6432Node\CLSID\{1E79B2C1-077B-11d1-B3AE-00AA00C1A924}\ProgID]
@="ospsampc"

[HKEY_LOCAL_MACHINE\SOFTWARE\Classes\WOW6432Node\CLSID\{1E79B2C1-077B-11d1-B3AE-00AA00C1A924}\VersionIndependentProgID]
@="ospsampc"

Appendix B - Sample database file

So the given database file has semicolons separating fields with newline as row terminator. There is also a row and column count on the top row. Also we have a row of column headers. No schema information though. Here at the top rows...

90;10
CustomerID;CompanyName;ContactName;ContactTitle;Address;City;Region;PostalCode;Country;Phone;
ALFKI;Alfreds Futterkiste;Maria Anders;Sales Representative;Obere Str. 57;Berlin;;12209;Germany;030-0074321;
ANATR;Ana Trujillo Emparedados y helados;Ana Trujillo;Owner;Avda. de la Constitución 2222;México D.F.;;05021;Mexico;(5) 555-4729;
ANTON;Antonio Moreno Taquería;Antonio Moreno;Owner;Mataderos  2312;México D.F.;;05023;Mexico;(5) 555-3932;
AROUT;Around the Horn;Thomas Hardy;Sales Representative;120 Hanover Sq.;London;;WA1 1DP;UK;(71) 555-7788;
BERGS;Berglunds snabbköp;Christina Berglund;Order Administrator;Berguvsvägen  8;Luleå;;S-958 22;Sweden;0921-12 34 65;
BLAUS;Blauer See Delikatessen;Hanna Moos;Sales Representative;Forsterstr. 57;Mannheim;;68306;Germany;0621-08460;

Monday 22 October 2018

OLEDB Simple Provider - Xml Reader

So I have chanced upon something call the OLEDB Simple Provider which allows VBA to convert an Xml document into a recordset. Worth investigating some more in its own right because it is said to support shaped, i.e. hierarchical recordsets. But right now, I want to find how to implement a custom OLEDB Simple Provider for an in memory array, a goal I've had for some time.

It has to be said that a recordset can be saved to Xml and indeed a saved Xml recordset can be synthesised as I did in this blog post.

Option Explicit

'* Tools->References
'MSXML2     Microsoft XML, v6.0                         C:\Windows\SysWOW64\msxml6.dll
'ADODB      Microsoft ActiveX Data Objects 6.1 Library  C:\Program Files (x86)\Common Files\System\ado\msado15.dll

Sub Test()
    Dim xmlDom As MSXML2.DOMDocument60
    Set xmlDom = New MSXML2.DOMDocument60
    
    Dim sColorsXml As String
    sColorsXml = "<colors>" & _
            "<color><colorname>Red</colorname><colorRGB>FF0000</colorRGB></color>" & _
            "<color><colorname>Green</colorname><colorRGB>00FF00</colorRGB></color>" & _
            "<color><colorname>Blue</colorname><colorRGB>0000FF</colorRGB></color></colors>"

    
    xmlDom.LoadXML sColorsXml
    Debug.Assert xmlDom.parseError = 0
    
    Const sFileName As String = "N:Colors.xml"
    xmlDom.Save sFileName

    Dim oConn As ADODB.Connection
    Set oConn = New ADODB.Connection
    'oConn.Open "Provider=MSDAOSP;Data Source=MSXML2.DSOControl.5.0"
    oConn.Open "Provider=MSDAOSP;Data Source=MSXML2.DSOControl"

    Dim rs As ADODB.Recordset
    Set rs = New ADODB.Recordset
    Set rs.ActiveConnection = oConn
    
    rs.Open sFileName
    rs.MoveFirst
    Debug.Assert rs.RecordCount = 3
    Debug.Assert rs.Fields.Count = 3  '* this surprised me
    Debug.Assert rs.Fields.Item(0).Name = "colorname"
    Debug.Assert rs.Fields.Item(1).Name = "colorRGB"
    Debug.Assert rs.Fields.Item(2).Name = "$Text"  '* this is the additional unexpected field, it concatentates the others
        
    '* lets get the recordset to a variant array
    Dim vVarArray
    vVarArray = Application.WorksheetFunction.Transpose(rs.GetRows)
    Debug.Assert vVarArray(1, 1) = "Red"
    Debug.Assert vVarArray(1, 2) = "FF0000"
    Debug.Assert vVarArray(1, 3) = "RedFF0000"
    Debug.Assert vVarArray(2, 1) = "Green"
    Debug.Assert vVarArray(2, 2) = "00FF00"
    Debug.Assert vVarArray(2, 3) = "Green00FF00"
    Debug.Assert vVarArray(3, 1) = "Blue"
    Debug.Assert vVarArray(3, 2) = "0000FF"
    Debug.Assert vVarArray(3, 3) = "Blue0000FF"
    
    Stop
End Sub

Appendix A - Registry Entries

Just doing some digging into the load sequence etc....

So "MSXML2.DSOControl" is a ProgId and we can go find it in the registry ...

Windows Registry Editor Version 5.00

[HKEY_CLASSES_ROOT\Msxml2.DSOControl.5.0]
@="XML Data Source Object 5.0"

[HKEY_CLASSES_ROOT\Msxml2.DSOControl.5.0\CLSID]
@="{88D969E9-F192-11D4-A65F-0040963251E5}"

So we can lookup the CLSID, {88D969E9-F192-11D4-A65F-0040963251E5} ...

Windows Registry Editor Version 5.00

[HKEY_CLASSES_ROOT\Wow6432Node\CLSID\{88D969E9-F192-11D4-A65F-0040963251E5}]
@="XML Data Source Object 5.0"

[HKEY_CLASSES_ROOT\Wow6432Node\CLSID\{88D969E9-F192-11D4-A65F-0040963251E5}\InProcServer32]
@="C:\Program Files (x86)\Common Files\Microsoft Shared\OFFICE11\MSXML5.DLL"
"ThreadingModel"="Apartment"

[HKEY_CLASSES_ROOT\Wow6432Node\CLSID\{88D969E9-F192-11D4-A65F-0040963251E5}\ProgID]
@="Msxml2.DSOControl.5.0"

[HKEY_CLASSES_ROOT\Wow6432Node\CLSID\{88D969E9-F192-11D4-A65F-0040963251E5}\TypeLib]
@="{F5078F18-C551-11D3-89B9-0000F81FE221}"

[HKEY_CLASSES_ROOT\Wow6432Node\CLSID\{88D969E9-F192-11D4-A65F-0040963251E5}\Version]
@="5.0"

We can find the type library with {F5078F18-C551-11D3-89B9-0000F81FE221} There were multiple versions, I'm showing version 5 ...

Windows Registry Editor Version 5.00

[HKEY_CLASSES_ROOT\Wow6432Node\TypeLib\{F5078F18-C551-11D3-89B9-0000F81FE221}]

[HKEY_CLASSES_ROOT\Wow6432Node\TypeLib\{F5078F18-C551-11D3-89B9-0000F81FE221}\5.0]
@="Microsoft XML, v5.0"

[HKEY_CLASSES_ROOT\Wow6432Node\TypeLib\{F5078F18-C551-11D3-89B9-0000F81FE221}\5.0\0]
@=""

[HKEY_CLASSES_ROOT\Wow6432Node\TypeLib\{F5078F18-C551-11D3-89B9-0000F81FE221}\5.0\0\win32]
@="C:\\Program Files (x86)\\Common Files\\Microsoft Shared\\OFFICE11\\MSXML5.DLL"

[HKEY_CLASSES_ROOT\Wow6432Node\TypeLib\{F5078F18-C551-11D3-89B9-0000F81FE221}\5.0\FLAGS]
@="0"

[HKEY_CLASSES_ROOT\Wow6432Node\TypeLib\{F5078F18-C551-11D3-89B9-0000F81FE221}\5.0\HELPDIR]
@="C:\\Program Files (x86)\\Common Files\\Microsoft Shared\\OFFICE11\\"

Loading the type library C:\Program Files (x86)\Common Files\microsoft shared\OFFICE11.MSXML5.DLL to see what interfaces DSOControl supports we can see it only has one


[
  uuid(88D969E9-F192-11D4-A65F-0040963251E5),
  helpstring("XML Data Source Object")
]
coclass DSOControl50 {
    [default] interface IDSOControl;
};


[
  odl,
  uuid(310AFA62-0575-11D2-9CA9-0060B0EC3D39),
  helpstring("DSO Control"),
  hidden,
  dual,
  nonextensible,
  oleautomation
]
interface IDSOControl : IDispatch {
    [id(0x00010001), propget]
    HRESULT XMLDocument([out, retval] IXMLDOMDocument** ppDoc);
    [id(0x00010001), propput]
    HRESULT XMLDocument([in] IXMLDOMDocument* ppDoc);
    [id(0x00010002), propget]
    HRESULT JavaDSOCompatible([out, retval] long* fJavaDSOCompatible);
    [id(0x00010002), propput]
    HRESULT JavaDSOCompatible([in] long fJavaDSOCompatible);
    [id(0xfffffdf3), propget]
    HRESULT readyState([out, retval] long* state);
};

And there the trail goes cold, nothing interesting about that interface, certainly nothing that can help our custom implementation of OLEDB Simple Provider.

Friday 12 October 2018

VBA - CopyTab Chrome Extension Helper

In preparation for these posts, I surf the internet a lot. I read many pages but it is a pain to write the HTML markup for every link I visit. I've decided to solve this pain by using a Chrome Extension called TabCopy in addition to some VBA code that will take TabCopy's output and style it into HTML.

So you need TabCopy Chrome Extension installed. Once installed , click on the icon and select a menu option to either (1) copy tab, (2) copy all tabs for that Chrome window or (3) copy all tabs for every Chrome window. Ensure the Expanded tab is highlighted on the bottom row as this affects what is copied to clipboard. You can select any of those menu options. If you paste into Notepad or a worksheet you should get something like the following

GitHub - dkackman/SqlLinq: Dynamic SQL queries of .NET IEnumerables
https://github.com/dkackman/SqlLinq

SqlLinq: Taking LINQ to SQL in the Other Direction - CodeProject
https://www.codeproject.com/Articles/28163/SqlLinq-Taking-LINQ-to-SQL-in-the-Other-Direction

Dynamically evaluated SQL LINQ queries - CodeProject
https://www.codeproject.com/Articles/43678/Dynamically-evaluated-SQL-LINQ-queries

TabCopy - Chrome Web Store
https://chrome.google.com/webstore/detail/tabcopy/micdllihgoppmejpecmkilggmaagfdmb

And the above looks eminently parsable. What I want to get to is the following HTML source so that I can paste into my blog post source ...

<li><a href="https://github.com/dkackman/SqlLinq">GitHub - dkackman/SqlLinq: Dynamic SQL queries of .NET IEnumerables</a></li>
<li><a href="https://www.codeproject.com/Articles/28163/SqlLinq-Taking-LINQ-to-SQL-in-the-Other-Direction">SqlLinq: Taking LINQ to SQL in the Other Direction - CodeProject</a></li>
<li><a href="https://www.codeproject.com/Articles/43678/Dynamically-evaluated-SQL-LINQ-queries">Dynamically evaluated SQL LINQ queries - CodeProject</a></li>
<li><a href="https://chrome.google.com/webstore/detail/tabcopy/micdllihgoppmejpecmkilggmaagfdmb">TabCopy - Chrome Web Store</a></li>

So the following code is to be pasted into the code behind a worksheet. It's quite defensive, it looks for the blanks between entries, it also ensure the lower text row is a valid url only if all entries are valid does it proceed to generate HTML ...

Option Explicit

Private mbProcessingChange As Boolean

Private Sub Worksheet_Change(ByVal Target As Range)
    If Not mbProcessingChange Then
        mbProcessingChange = True
        If Target.Columns.Count = 1 Then
            
            If (Target.Rows.Count + 1)  3 = (Target.Rows.Count + 1) / 3 Then
                Dim bInterspacedByBlanks As Boolean
                bInterspacedByBlanks = True
                
                Dim lRowLoop As Long
                For lRowLoop = 3 To Target.Rows.Count Step 3
                    If Len(Target.Cells(lRowLoop, 1)) > 0 Then
                        bInterspacedByBlanks = False
                        Exit For
                    End If
                Next
                
                If bInterspacedByBlanks Then
                    Dim bValidURLs As Boolean
                    bValidURLs = True
                    For lRowLoop = 2 To Target.Rows.Count Step 3
                        If Not IsValidURL(Target.Cells(lRowLoop, 1)) Then
                            bValidURLs = False
                            Exit For
                        End If
                    Next
            
                    If bValidURLs Then
                    
                        Dim dic As Object 'scripting.Dictionary
                        Set dic = VBA.CreateObject("scripting.Dictionary")
            
                        For lRowLoop = 1 To Target.Rows.Count Step 3
                            Dim sText As String
                            sText = Target.Cells(lRowLoop, 1)
                            
                            Dim sURL As String
                            sURL = Target.Cells(lRowLoop + 1, 1)
                            
                            
                            dic.Add dic.Count, "<li><a title="""" href=""" & sURL & """>" & sText & "</a></li>"
                        
                        Next
                        
                        Dim vItems As Variant
                        vItems = dic.Items
                        
                        ReDim vPaste(1 To dic.Count, 1 To 1) As Variant
                        Dim l As Long
                        For l = 1 To dic.Count
                            vPaste(l, 1) = vItems(l - 1)
                        Next l
                        
                        Target.Offset(0, 4).Resize(dic.Count).Value2 = vPaste

                    End If
            
                End If
            
            End If
        End If
        mbProcessingChange = False
    End If

End Sub

Public Function IsValidURL(ByRef sURL As String) As Boolean

    IsValidURL = False
    Dim sPattern As String
    sPattern = "^" 'Beginning of string
    sPattern = sPattern & "https?://" 'Protocol is http or https
    sPattern = sPattern & "[wd][wd-]*(.[wd-]+)*" 'Domain/Subdomain
    sPattern = sPattern & ".[w]+" 'gTLD
    sPattern = sPattern & "/" 'we need to not be in the webroot
    sPattern = sPattern & ".+" 'Check that we have stuff that comes after the slash

    IsValidURL = IsRegexMatch(sURL, sPattern)

End Function

Private Function IsRegexMatch(ByRef sText As String, ByVal sPattern As String) As Boolean
    IsRegexMatch = False

    Dim regex As Object
    Set regex = CreateObject("vbscript.regexp")

    regex.IgnoreCase = True
    regex.Global = True
    regex.Pattern = sPattern
    Dim Matches As Object
    Set Matches = regex.Execute(sText)
    If Matches.Count = 1 Then IsRegexMatch = True

End Function