Thursday 28 December 2017

Convert Excel Table To JSON with VBA and Javascript running on ScriptControl

Today, I am reminded of a SO answer I gave some time ago which serialises an Excel table to JSON. The code is replicated below. I am reminded because it seems there is JavaScript library called SheetJS. SheetJS would require some time to evaluate to see what it is capable of, hopefully I'll blog about it soon. In the meantime, I am re-publishing the code I wrote to show that actually it is quite trivial and need not involve any VBA string operations. Instead, we leverage the JavaScript language and we call into the Excel object model (probably uses COM under the hood) to get each cell's value.

So I would pass in the range to a JavaScript function and let it iterate over the Excel object model and build the array in JavaScript. Then call a JavaScript library to convert array into a string (hat tip Douglas Crockford) and simply return the string to VBA. So no string operations in VBA.

The JavaScript function is given below but depends upon Douglas Crockford's library at https://raw.githubusercontent.com/douglascrockford/JSON-js/master/json2.js. Save this in a file and then amend VBA code with the correct file path so the JavaScript is loaded into the Microsoft Script Control.


function ExcelTableToJSON(rngTable) {
    try {
        if (rngTable && rngTable['Rows'] && rngTable['Columns']) {
            var rowCount = rngTable.Rows.Count;
            var columnCount = rngTable.Columns.Count;
            var arr = new Array();

            for (rowLoop = 1; rowLoop <= rowCount; rowLoop++) {
                arr[rowLoop - 1] = new Array();
                for (columnLoop = 1; columnLoop <= columnCount; columnLoop++) {
                    var rngCell = rngTable.Cells(rowLoop, columnLoop);
                    var cellValue = rngCell.Value2;
                    arr[rowLoop - 1][columnLoop - 1] = cellValue;
                }
            }
            return JSON.stringify(arr);
        }
        else {
            return { error: '#Either rngTable is null or does not support Rows or Columns property!' };
        }
    }
    catch(err) {
        return {error: err.message};
    }
}


Option Explicit

'In response to
'http://stackoverflow.com/questions/38100193/is-it-possible-in-vba-convert-excel-table-to-json?rq=1
'Is it possible in VBA convert Excel table to json

'Tools->References->
'Microsoft Script Control 1.0;  {0E59F1D2-1FBE-11D0-8FF2-00A0D10038BC}; C:\Windows\SysWOW64\msscript.ocx

Private Sub Test()

    Dim oScriptEngine As ScriptControl
    Set oScriptEngine = New ScriptControl
    oScriptEngine.Language = "JScript"

    oScriptEngine.AddCode GetJavaScriptLibraryFromWeb("https://raw.githubusercontent.com/douglascrockford/JSON-js/master/json2.js")

    Dim sJavascriptCode As String
    sJavascriptCode = CreateObject("Scripting.FileSystemObject").GetFile("<<<Your file path to javascript file>>>\ExcelTableToJSON.js").OpenAsTextStream.ReadAll

    oScriptEngine.AddCode sJavascriptCode

    Dim rngTable As Excel.Range
    Set rngTable = ThisWorkbook.Worksheets.Item("Sheet2").Range("A1:B2")

    rngTable.Cells(1, 1) = 1.2
    rngTable.Cells(1, 2) = "red"
    rngTable.Cells(2, 1) = True
    rngTable.Cells(2, 2) = "=2+2"


    Dim sStringified As String
    sStringified = oScriptEngine.Run("ExcelTableToJSON", rngTable)
    Debug.Assert sStringified = "[[1.2,""red""],[true,4]]"

    Stop

End Sub

Public Function GetJavaScriptLibraryFromWeb(ByVal sURL As String) As String

    Dim xHTTPRequest As Object 'MSXML2.XMLHTTP60
    Set xHTTPRequest = VBA.CreateObject("MSXML2.XMLHTTP.6.0")
    xHTTPRequest.Open "GET", sURL, False
    xHTTPRequest.send
    GetJavaScriptLibraryFromWeb = xHTTPRequest.responseText

End Function

Wednesday 27 December 2017

VBA Taking Screen Print and saving to file

So I've been pondering Screen Prints and how they work, in doing so I wondered how some VBA code would take a screen print and save to file. I found lots of fragments of code and then settled on an ideal candidate answer at StackOverflow.

But there is a bug in that code, when calling OleCreatePictureIndirect for the third parameter specify 1 (I define a constant) and not True which is -1. Otherwise, one suffers from "Out of Memory" error either immediately or eventually. Windows API True (1) is not the same as VBA's True (-1).

In addition to the bug fix there is some extra code to thrash the logic Test_ClearTestFiles() and TestMyPrintScreen()


Option Explicit

'* see - Stack Overflow - Is there a way to take a screenshot in MS-Access with vba_
'* https://stackoverflow.com/questions/2456998/is-there-a-way-to-take-a-screenshot-in-ms-access-with-vba/2457169#2457169

Private Declare Sub keybd_event Lib "user32" (ByVal bVk As Byte, ByVal _
  bScan As Byte, ByVal dwFlags As Long, ByVal dwExtraInfo As Long)

Private Const VK_SNAPSHOT = &H2C
Private Const VK_MENU = &H12
Private Const KEYEVENTF_KEYUP = &H2
Private Const WINAPI_TRUE As Long = 1

Private Declare Function OpenClipboard Lib "user32" (ByVal hwnd As Long) As Long

Private Declare Function GetClipboardData Lib "user32" (ByVal wFormat As Integer) As Long

Private Declare Function EmptyClipboard Lib "User32.dll" () As Long

Private Declare Function CloseClipboard Lib "user32" () As Long

'https://msdn.microsoft.com/en-us/library/windows/desktop/ms694511(v=vs.85).aspx
Private Declare Function OleCreatePictureIndirect Lib "olepro32.dll" _
(PicDesc As uPicDesc, RefIID As GUID, ByVal fPictureOwnsHandle As Long, _
IPic As IPicture) As Long

'\\ Declare a UDT to store a GUID for the IPicture OLE Interface
Private Type GUID
    Data1 As Long
    Data2 As Integer
    Data3 As Integer
    Data4(0 To 7) As Byte
End Type

'\\ Declare a UDT to store the bitmap information
Private Type uPicDesc
    Size As Long
    Type As Long
    hPic As Long
    hPal As Long
    Reserved As Long '* added by S Meaden
End Type

Private Const CF_BITMAP = 2
Private Const PICTYPE_BITMAP = 1

Private Sub PrintScreen()
    keybd_event VK_SNAPSHOT, 1, 0, 0
    
    '* the old way
    'keybd_event VK_MENU, 0, 0, 0
    'keybd_event VK_SNAPSHOT, 0, 0, 0
    'keybd_event VK_SNAPSHOT, 0, KEYEVENTF_KEYUP, 0
    'keybd_event VK_MENU, 0, KEYEVENTF_KEYUP, 0
    
End Sub

Private Sub ClearClipboard()
    Dim lRet As Long

    lRet = OpenClipboard(0&)
    If lRet <> 0 Then lRet = EmptyClipboard
    CloseClipboard
End Sub

Private Function CreateIDispatchIID() As GUID
    ' IDispatch interface ID is defined as a GUID with
    ' the value of {00020400-0000-0000-C000-000000000046}.
    Dim IID_IDispatch As GUID
    With IID_IDispatch
        .Data1 = &H20400
        .Data4(0) = &HC0
        .Data4(7) = &H46
    End With
    CreateIDispatchIID = IID_IDispatch

End Function


Private Sub Test_ClearTestFiles()
    Dim fso As Object
    Set fso = VBA.CreateObject("Scripting.FileSystemObject")

    Dim lLoop As Long
    For lLoop = 0 To 50

        Dim sFileName As String
        sFileName = "N:\Test" & lLoop & ".bmp"

        If fso.FileExists(sFileName) Then
            fso.DeleteFile sFileName
        End If
    Next lLoop

End Sub

Private Sub TestMyPrintScreen()

    Static suffix As Long
    suffix = suffix + 1

    'ClearClipboard
    MyPrintScreen "N:\test" & CStr(suffix) & ".bmp"
End Sub


Public Sub MyPrintScreen(FilePathName As String)

    Call PrintScreen

    Dim IID_IDispatch As GUID
    Dim uPicinfo As uPicDesc
    Dim IPic As IPicture
    Dim hPtr As Long

    OpenClipboard 0
    hPtr = GetClipboardData(CF_BITMAP)
    CloseClipboard

    '* Request IDispatch but it will be QueryInterfaced to IPicture by VBA runtime
    IID_IDispatch = CreateIDispatchIID

    '\\ Fill uPicInfo with necessary parts.
    With uPicinfo
        .Size = Len(uPicinfo) '\\ Length of structure.
        .Type = PICTYPE_BITMAP '\\ Type of Picture
        .hPic = hPtr '\\ Handle to image.
        .hPal = 0 '\\ Handle to palette (if bitmap).
    End With


   '\\ Create the Range Picture Object
   '* Bugfix: need WINAPI_TRUE (1) as not VBA True which is -1
   OleCreatePictureIndirect uPicinfo, IID_IDispatch, WINAPI_TRUE, IPic

    '\\ Save Picture Object
    stdole.SavePicture IPic, FilePathName

End Sub



Fake namespace! VBA MSXML2 XPath namespace looks like we need to fake a prefix for the default namespace

This is more a TODO post to myself to find a better solution to a VBA Xml programming program. Visitors are welcome to comment at the bottom if they know a better answer.

So a while ago, I had a problem with using XPath to get some elements out of an Xml Dom using VBA Xml library, MSXML2. You can see my SO question about it here. I expressed unhappiness about how we have to fake a prefix when setting the dom's SelectionNamespace.

Today a similar question arose but the twist here is that multiple namespaces have to be set. Here is my answer.

To set multiple namespaces simply space separate thus...


    dom.setProperty "SelectionNamespaces", "xmlns:sf='urn:sobject.enterprise.soap.sforce.com' xmlns:sf2='urn:enterprise.soap.sforce.com'"


(I omitted a couple of namespaces for formatting issues but you get the idea)

So I got some code working for the OP but I'd really like to find a way to not have to fake the prefix. In the source Xml note xmlns="urn:enterprise.soap.sforce.com" has no prefix but in our VBA we have to fake it with "sf2".

As a working resource I'm copying the Xml file here and the code below


<?xml version="1.0" encoding="UTF-8" ?>
<soapenv:Envelope xmlns:soapenv="http://schemas.xmlsoap.org/soap/envelope/" xmlns="urn:enterprise.soap.sforce.com" xmlns:sf="urn:sobject.enterprise.soap.sforce.com" xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance" >
  <soapenv:Header>
    <LimitInfoHeader>
      <limitInfo>
        <current>50</current>
        <limit>5000000</limit>
        <type>API REQUESTS</type>
      </limitInfo>
    </LimitInfoHeader>
  </soapenv:Header>
  <soapenv:Body>
    <queryResponse>
      <result>
        <done>true</done>
        <queryLocator xsi:nil="true"/>
        <records xsi:type="sf:Nodav">
          <sf:Id>a0S0E000000DMUg320</sf:Id>
          <sf:Name>Netta test 11</sf:Name>
        </records>
        <records xsi:type="sf:Nodav">
          <sf:Id>a0S0E000000DMUg321</sf:Id>
          <sf:Name>Netta test 32</sf:Name>
        </records>
        <size>2</size>
      </result>
    </queryResponse>
  </soapenv:Body>
</soapenv:Envelope>


Option Explicit


Sub TestCoreLogic()
    Dim dom As MSXML2.DOMDocument60
    Set dom = New MSXML2.DOMDocument60
    
    dom.Load "N:\xmlfile1.xml"
    Debug.Assert dom.parseError.ErrorCode = 0

    dom.setProperty "SelectionLanguage", "XPath"
    
    dom.setProperty "SelectionNamespaces", "xmlns:sf='urn:sobject.enterprise.soap.sforce.com' xmlns:sf2='urn:enterprise.soap.sforce.com' " & _
            "xmlns:soapenv='http://schemas.xmlsoap.org/soap/envelope/' xmlns:xsi='http://www.w3.org/2001/XMLSchema-instance' "
    
    CoreLogic dom
End Sub
'
Function CoreLogic(ByVal xmlDoc As MSXML2.DOMDocument60)

    Dim records As MSXML2.IXMLDOMElement
    Set records = xmlDoc.DocumentElement
    
    Dim lists As MSXML2.IXMLDOMNodeList
    
    'Debug.Assert records.SelectNodes("//soapenv:Envelope").Length = 1
    'Debug.Assert records.SelectNodes("//soapenv:Envelope/soapenv:Body").Length = 1
    'Debug.Assert records.SelectNodes("//soapenv:Envelope/soapenv:Body/sf2:queryResponse").Length = 1
    'Debug.Assert records.SelectNodes("//soapenv:Envelope/soapenv:Body/sf2:queryResponse/sf2:result").Length = 1
    '
    'Debug.Assert records.SelectNodes("//soapenv:Envelope/soapenv:Body/sf2:queryResponse/sf2:result/sf2:records").Length = 2
    'Set lists = records.SelectNodes("//soapenv:Envelope/soapenv:Body/sf2:queryResponse/sf2:result/sf2:records")
    
    Debug.Assert records.SelectNodes("//sf2:records").Length = 2
    Set lists = records.SelectNodes("//sf2:records")

    Dim listNode As MSXML2.IXMLDOMNode
    
    For Each listNode In lists
        Debug.Print "---Email---"
        
        Dim fieldNode As MSXML2.IXMLDOMNode
        For Each fieldNode In listNode.ChildNodes
            Debug.Print "[" & fieldNode.BaseName & "] = [" & fieldNode.Text & "]"
        Next fieldNode
    Next listNode

    Set records = Nothing
    Set lists = Nothing
    Set listNode = Nothing
    Set fieldNode = Nothing


End Function


Sunday 17 December 2017

WinAPI - there's a difference between Child windows and Popup windows - for controlling visibility at least

So there is currently a SO bounty where poster wants to hide all windows for a program. They launched the program using the Windows Script Host library (c:\Windows\SysWOW64\wshom.ocx). They use the Run method of the Shell object (another link). But despite specifying WshWindowStyle.WshHide, popups still appear. Because of the bounty I decided to investigate, but I started with C# (see bottom of page), then I translated my findings into VBA (see first listing ).

Firstly, a key reading resource is Windows Features which tells that all windows are created with CreateWindowEx but popups are create by specifying WS_POPUP and child windows are created by specifying WS_CHILD. So popups and child windows are different.

On the same page in the section Window Visibility it explains that we can set the visibility of a main window and the change will cascade down to all child windows but there is no mention of this cascade affecting popups.

The short answer to the investigation is that to hide popups it is required to call ShowOwnedPopups(hwnd,0). The VBA declaration is given here


Declare Function ShowOwnedPopups Lib "user32" Alias "ShowOwnedPopups" _
       (ByVal hwnd As Long, ByVal fShow As Long) As Long

And here is some final VBA code but which depends upon a simple C# demo program called VisibilityExperiment

Option Explicit

Private Declare Function ShowOwnedPopups Lib _
    "user32" (ByVal hwnd As Long, _
    ByVal fShow As Long) As Long

Private Declare Function EnumWindows _
    Lib "user32" ( _
        ByVal lpEnumFunc As Long, _
        ByVal lParam As Long) _
        As Long
        
Private Declare Function GetWindowThreadProcessId _
    Lib "user32" (ByVal hwnd As Long, lpdwprocessid As Long) As Long
    

    
Private mlPid As Long
Private mlHWnd As Variant


Private Function EnumAllWindows(ByVal hwnd As Long, ByVal lParam As Long) As Long
    
    Dim plProcID As Long
    GetWindowThreadProcessId hwnd, plProcID
    If plProcID = mlPid Then
        If IsEmpty(mlHWnd) Then
            mlHWnd = hwnd
            Debug.Print "HWnd:&" & Hex$(mlHWnd) & "  PID:&" & Hex$(mlPid) & "(" & mlPid & ")"
        End If
    End If

    EnumAllWindows = True
End Function

Private Function GetPID(ByVal sExe As String) As Long

    Static oServ As Object
    If oServ Is Nothing Then Set oServ = GetObject("winmgmts:\\.\root\cimv2")
    
    Dim cProc As Object
    Set cProc = oServ.ExecQuery("Select * from Win32_Process")
    
    Dim oProc As Object
    For Each oProc In cProc
        If oProc.Name = sExe Then
            Dim lPid As Long
            GetPID = oProc.ProcessID
        End If
    Next

End Function


Private Sub Test()
    '* Tools->References   "Windows Script Host library"

    Dim wsh As IWshRuntimeLibrary.WshShell
    Set wsh = New IWshRuntimeLibrary.WshShell

    Dim lWinStyle As WshWindowStyle
    lWinStyle = WshNormalFocus

    Dim sExe As String
    sExe = "VisibilityExperiment.exe"

    Dim sExeFullPath As String
    sExeFullPath = Environ$("USERPROFILE") & "\source\repos\VisibilityExperiment\VisibilityExperiment\bin\Debug\" & sExe

    Dim x As Long
    x = wsh.Run(sExeFullPath, lWinStyle, False)

    mlPid = GetPID(sExe)

    mlHWnd = Empty
    Call EnumWindows(AddressOf EnumAllWindows, 0)


    Stop
    Call ShowOwnedPopups(mlHWnd, 0)  '* o to hide, 1 to show

End Sub



To repeat, to hide popups one must call ShowOwnedPopups(). Sadly, I cannot see around this restriction. Even if we tried to use the Windows API directly to spawn the process there is nothing in the STARTUPINFO structure (Windows) which looks like it will help, there is nothing to specify the visibility of popups.

Here is the source code of the form to the C# program VisibilityExperiment.exe, it is a normal Windows Forms application and I have added a single button called button1,


using System;
using System.Windows.Forms;

namespace VisibilityExperiment
{
    public partial class VisibilityExperiment : Form
    {
        public VisibilityExperiment()
        {
            InitializeComponent();
        }

        private void button1_Click(object sender, EventArgs e)
        {
            MessageBox.Show("message", "caption", MessageBoxButtons.YesNo);
        }
    }
}

And here is my experiment program call VisibilityExperiment2.exe . It is again a simple WinForms Application. You run VisibilityExperiment manually and you can see the effect of calling different Windows API functions. You will see that the message box does will not be hidden unless you use ShowOwnedPopups.

Here is the form layout

.

You will have to rename the controls btnGetMainWindowHandle, btnShow, btnHide, grpShowHide, chkShowOwnedPopups, chkShowWindowAsync, chkSetWindowPos for the following form code to work...


using System;
using System.Diagnostics;
using System.Dynamic;
using System.Runtime.InteropServices;
using System.Windows.Forms;

namespace VisibilityExperiment2
{


    public partial class ShowerHider : Form
    {
        IntPtr mainWindowHandle;

        [DllImport("user32.dll")]
        static extern bool ShowWindowAsync(IntPtr hWnd, int nCmdShow);

        [DllImport("user32.dll")]
        static extern bool ShowOwnedPopups(IntPtr hWnd, int nCmdShow);

        [DllImport("user32.dll", SetLastError = true)]
        static extern bool SetWindowPos(IntPtr hWnd, IntPtr hWndInsertAfter, int X, int Y, int cx, int cy, SetWindowPosFlags uFlags);

        #region Constants

        enum SetWindowPosFlags
        {
            NOSIZE = 0x0001,
            NOMOVE = 0x0002,
            NOZORDER = 0x0004,
            NOREDRAW = 0x0008,
            NOACTIVATE = 0x0010,
            DRAWFRAME = 0x0020,
            FRAMECHANGED = 0x0020,
            SHOWWINDOW = 0x0040,
            HIDEWINDOW = 0x0080,
            NOCOPYBITS = 0x0100,
            NOOWNERZORDER = 0x0200,
            NOREPOSITION = 0x0200,
            NOSENDCHANGING = 0x0400,
            DEFERERASE = 0x2000,
            ASYNCWINDOWPOS = 0x4000
        };

        static readonly IntPtr HWND_TOPMOST = new IntPtr(-1);
        static readonly IntPtr HWND_NOTOPMOST = new IntPtr(-2);
        static readonly IntPtr HWND_TOP = new IntPtr(0);
        static readonly IntPtr HWND_BOTTOM = new IntPtr(1);

        private const int SW_HIDE = 0;
        private const int SW_SHOWNORMAL = 1;
        private const int SW_SHOW = 5;
        #endregion Constants

        public ShowerHider()
        {
            InitializeComponent();
        }



        private ExpandoObject CheckForPID()
        {
            dynamic retVal = new ExpandoObject();

            Process[] processes = Process.GetProcessesByName("VisibilityExperiment");
            if (processes.Length==0)
            {
                retVal.pid = -1;
                
            } else if (processes.Length == 1) {

                Process proc = processes[0];
                retVal.pid = proc.Id;
                retVal.hWnd = proc.MainWindowHandle;
                

            } else
            {
                retVal.pid = -2;
            }
            return retVal;
        }

        private void btnGetMainWindowHandle_Click(object sender, EventArgs e)
        {
            dynamic retVal = CheckForPID();

            if (retVal.pid>=0)
            {
                mainWindowHandle = retVal.hWnd;
                this.textBox1.Text = retVal.hWnd.ToString("X8");
                this.grpShowHide.Enabled = true;
            }

            
            
        }

        private void btnShow_Click(object sender, EventArgs e)
        {
            if (this.chkSetWindowPos.Checked == true)
            {
                SetWindowPos(mainWindowHandle, IntPtr.Zero, 0, 0, 0, 0,SetWindowPosFlags.SHOWWINDOW | 
                    SetWindowPosFlags.NOMOVE | SetWindowPosFlags.NOSIZE);
            }


            if (this.chkShowWindowAsync.Checked==true)
            { 
                ShowWindowAsync(mainWindowHandle, SW_SHOW);
                //* Need to call this twice of the first time
                //* TODO Eastablish first time versus subsequent time logic 
                ShowWindowAsync(mainWindowHandle, SW_SHOW);
            }

            if (this.chkShowOwnedPopups.Checked == true)
                ShowOwnedPopups(mainWindowHandle, 1);
        }

        private void btnHide_Click(object sender, EventArgs e)
        {

            if (this.chkSetWindowPos.Checked == true)
            {
                SetWindowPos(mainWindowHandle, IntPtr.Zero, 0, 0, 0, 0,SetWindowPosFlags.HIDEWINDOW |
                    SetWindowPosFlags.NOMOVE | SetWindowPosFlags.NOSIZE);
            }

            if (this.chkShowWindowAsync.Checked == true)
            {
                ShowWindowAsync(mainWindowHandle, SW_HIDE);
                //* Need to call this twice of the first time
                //* TODO Eastablish first time versus subsequent time logic 

                ShowWindowAsync(mainWindowHandle, SW_HIDE);
            }
            if (this.chkShowOwnedPopups.Checked == true)
                ShowOwnedPopups(mainWindowHandle, 0);



        }

        private void chkShowWindowAsync_CheckedChanged(object sender, EventArgs e)
        {

        }
    }
}



Friday 15 December 2017

Ubuntu - what do the colours in the console mean - Blue is Directory etc.

So I chanced upon a lovely Unix script which prints out a colour key in case a newbie is bamboozled by the coloured items. Copy the following in your terminal


eval $(echo "no:global default;fi:normal file;di:directory;ln:symbolic link;pi:named pipe;so:socket;do:door;bd:block device;cd:character device;or:orphan symlink;mi:missing file;su:set uid;sg:set gid;tw:sticky other writable;ow:other writable;st:sticky;ex:executable;"|sed -e 's/:/="/g; s/\;/"\n/g')           
{      
  IFS=:     
  for i in $LS_COLORS     
  do        
    echo -e "\e[${i#*=}m$( x=${i%=*}; [ "${!x}" ] && echo "${!x}" || echo "$x" )\e[m" 
  done       
} 

You will dark blue is a directory, normal file is white plus some others (run the script!)

Reproduced from Ask Ubuntu

Changing the bash prompt

So I really do not like so many colours in my bash prompt, here is an economical bash prompt that does not have colours and also does not have username and hostname.

PS1='\[\e]0;\u@\h: \w\a\]${debian_chroot:+($debian_chroot)}bash :\w\$'

To ensure this happens on each logon I changed my .bashrc file using nano. It lives in the home directory ~ and is hidden by default.

cd ~
nano .bashrc

In nano add the PS1= line to the end, then attempt to exit, it will prompt for a save before exiting to which you say yes.

If you forget your password

Thankfully there is askubuntu.com and this answer works.

Changing the Ubuntu's Window Caption

So if I am making a video I do not want my user name and hostname appearing in the bash prompt (see above) or in the Ubuntu window's title. I'm sure it is configurable but I knew how to use a Windows API call to set the window caption and this code below will suffice. It's for a C# console.

using System;
using System.Collections.Generic;
using System.Diagnostics;
using System.Runtime.InteropServices;
using System.Text;

namespace UbuntuWindowTitleRenamer
{
    class Program
    {
        [DllImport("user32.dll")]
        static extern bool SetWindowText(IntPtr hWnd, string text);

        [DllImport("user32.dll", CharSet = CharSet.Unicode, SetLastError = true)]
        static extern int GetWindowText(IntPtr hWnd, StringBuilder lpString, int nMaxCount);

        [DllImport("user32.dll", SetLastError = true, CharSet = CharSet.Auto)]
        static extern int GetWindowTextLength(IntPtr hWnd);

        static void Main(string[] args)
        {
            Process[] processes = null;
            string bashPrompt = Environment.GetEnvironmentVariable("BASH_WINDOW_TITLE_PREFIX");
            while (!Console.KeyAvailable)
            {
                processes = Process.GetProcessesByName("ubuntu");
                LoopThruProcesses(processes, bashPrompt);
                processes = Process.GetProcessesByName("bash");
                LoopThruProcesses(processes, bashPrompt);
            }
        }

        static void LoopThruProcesses(Process[] processes, string bashPrompt)
        {
            foreach (var procLoop in processes)
            {
                long ProcId = procLoop.Id;
                string hexProcId = ProcId.ToString("x8");

                {
                    List consoleWindows = Accessibility.GetConsoleWindowsByProcessId(ProcId);
                    foreach (IntPtr consoleWindow in consoleWindows)
                    {
                        int textLength = GetWindowTextLength(consoleWindow);

                        StringBuilder sb = new StringBuilder(textLength+1);
                        GetWindowText(consoleWindow, sb, sb.Capacity);

                        string windowCaption = sb.ToString();

                        if (windowCaption.StartsWith(bashPrompt))
                        {
                            string newCaption = "bash " + windowCaption.Substring(bashPrompt.Length);
                            SetWindowText(consoleWindow, newCaption);
                            Console.WriteLine("changing window caption:" + newCaption);
                        }
                    }
                }

                {
                    string originalCaption = procLoop.MainWindowTitle;
                    if (originalCaption.StartsWith(bashPrompt))
                    {
                        string newCaption = "bash " + originalCaption.Substring(bashPrompt.Length);
                        SetWindowText(procLoop.MainWindowHandle, newCaption);
                        Console.WriteLine("changing window caption:" + newCaption);
                    }
                }
            }
        }
    }

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

        [DllImport("user32.dll")]
        static extern uint GetWindowThreadProcessId(IntPtr hWnd, out int processId);

        public static List GetConsoleWindowsByProcessId(long processId)
        {
            List retVal = new List();

            IntPtr hWnd = FindWindowEx(IntPtr.Zero, IntPtr.Zero, "ConsoleWindowClass", null);
            while (hWnd != IntPtr.Zero)
            {
                //Console.WriteLine("Window handle:" + hWnd.ToString("x8"));
                retVal.Add(hWnd);
                hWnd = FindWindowEx(IntPtr.Zero, hWnd, "ConsoleWindowClass", null);
            }
            return retVal;
        }
    }
}

Ubuntu (Windows Subsystem for Linux) Apache2 Configuration Overview

So Apache2 running on Ubuntu running on Windows Subsystem for Linux (WSL) on Windows 10 has a different configuration from other Apache2 installs. So there is a mismatch between documentation, if for example one is following Dedoimedo's Apache Web server Complete Guide. The config details are hiding in plain sight on the default index page that appears after a fresh install. Because we are meant to replace that page I am keeping a copy here.

Configuration Overview

Ubuntu's Apache2 default configuration is different from the upstream default configuration, and split into several files optimized for interaction with Ubuntu tools. The configuration system is fully documented in /usr/share/doc/apache2/README.Debian.gz. Refer to this for the full documentation. Documentation for the web server itself can be found by accessing the manual if the apache2-doc package was installed on this server.

The configuration layout for an Apache2 web server installation on Ubuntu systems is as follows:

/etc/apache2/
|-- apache2.conf
|       `--  ports.conf
|-- mods-enabled
|       |-- *.load
|       `-- *.conf
|-- conf-enabled
|       `-- *.conf
|-- sites-enabled
|       `-- *.conf
          
  • apache2.conf is the main configuration file. It puts the pieces together by including all remaining configuration files when starting up the web server.
  • ports.conf is always included from the main configuration file. It is used to determine the listening ports for incoming connections, and this file can be customized anytime.
  • Configuration files in the mods-enabled/, conf-enabled/ and sites-enabled/ directories contain particular configuration snippets which manage modules, global configuration fragments, or virtual host configurations, respectively.
  • They are activated by symlinking available configuration files from their respective *-available/ counterparts. These should be managed by using our helpers a2enmod, a2dismod, a2ensite, a2dissite, and a2enconf, a2disconf . See their respective man pages for detailed information.
  • The binary is called apache2. Due to the use of environment variables, in the default configuration, apache2 needs to be started/stopped with /etc/init.d/apache2 or apache2ctl. Calling /usr/bin/apache2 directly will not work with the default configuration.
Document Roots

By default, Ubuntu does not allow access through the web browser to any file apart of those located in /var/www, public_html directories (when enabled) and /usr/share (for web applications). If your site is using a web document root located elsewhere (such as in /srv) you may need to whitelist your document root directory in /etc/apache2/apache2.conf.

The default Ubuntu document root is /var/www/html. You can make your own virtual hosts under /var/www. This is different to previous releases which provides better security out of the box.

Ubuntu on WSL piping output to the host OS's drives - convert LFs to CRLFs

So continuing on the Ubuntu theme. I need to configure Apache. So I am not used to Linux because it has been a dozen years ago since I trained for certification on Linux. I still want to use my favourite Windows apps not mention the windowed environment; it takes a while to acclimatise to console culture. Specifically, whilst poking around the Linux file system, I need to find a way to pipe output of a command to a file on the host OS’s drive and then handle the line feed issue.

In Linux line feeds are one character ASC 10, whilst in Windows line feeds are in fact two, ASC 13 + ASC 10. If you don’t believe me then in VBA Immediate window try ?ASC(MID$(vbNewLine,1,1)) and then ?ASC(MID$(vbNewLine,2,1)) .

So in the Linux console a typical command would be sudo find / -name apache2.conf &> /mnt/n/findapache.txt which searches for Apache2 configuration file (it’s not where my Apache book says it should be!). The above command pipes output both stdout and stderr (hence “&>”) to /mnt/n which is where my N: drive is mounted into the unified Linux file system.

So here is some code to process the line feeds


Option Explicit

'* Tools->References->Microsoft Scripting Runtime

Sub Test()
    'ConvertLinuxLineFeedsToWindowsCRAndLineFeeds "n:\findapache.txt"
    ConvertLinuxLineFeedsToWindowsCRAndLineFeeds "n:\apache2.conf"
End Sub

Sub ConvertLinuxLineFeedsToWindowsCRAndLineFeeds(ByVal sLinuxFile As String, _
                        Optional ByVal sWindowsFile As String)

    sWindowsFile = Trim(sWindowsFile)
    If LenB(sWindowsFile) = 0 Then
        Dim vSplit As Variant
        vSplit = VBA.Split(sLinuxFile, ".")
        
        Dim lCount As Long
        lCount = UBound(vSplit)
        ReDim Preserve vSplit(0 To lCount + 1)
        vSplit(lCount + 1) = vSplit(lCount)
        vSplit(lCount) = "winLfCr"
        
        sWindowsFile = VBA.Join(vSplit, ".")
    
    End If

    Dim oFSO As New Scripting.FileSystemObject
    
    
    Debug.Assert oFSO.FileExists(sLinuxFile)
    Dim oTxtIn As Scripting.TextStream
    Set oTxtIn = oFSO.OpenTextFile(sLinuxFile)

    Dim oTxtOut As Scripting.TextStream
    Set oTxtOut = oFSO.CreateTextFile(sWindowsFile)

    While Not oTxtIn.AtEndOfStream
        Dim sLine As String
        sLine = oTxtIn.ReadLine
        Debug.Print sLine
        
        oTxtOut.WriteLine sLine
        
    Wend
    
    oTxtOut.Close
    oTxtIn.Close
    
    Set oTxtOut = Nothing
    Set oTxtIn = Nothing

End Sub


Now one can use Notepad to view the contents. Without the windows line feeds the whole file looks like it has no line breaks!

Wednesday 13 December 2017

Installing Apache into Ubuntu running on Windows Subsystem for Linux on Windows 10

Part A - Installing WSL

So in the previous post I discussed the merits of Apache and whilst installable directly onto Windows 10 there is a good case for running it on Linux. But fortunately we don't have to thanks to a new component of Windows 10 called Windows Subsystem for Linux (Wikipedia article) (hereafter WSL) which is more lightweight than a fully virtualised machine (though a VM remains an option).

Microsoft's own documentation is here. To install one can follow instruction on this web page Microsoft - Install the Linux Subsystem on Windows 10 - Microsoft Docs. However, I can supplement with some extra info and a few screenshots because not everything is spelt out and indeed some of it I didn't follow at all :) .

To install 'Windows Subsystem for Linux' one needs to go to the Control Panel->Programs and Features->Turn Windows features on or off

Taking the above update requires a reboot.

Then I opened the Windows Store. Then I searched for Ubuntu and made sure to match the one shown on the Microsoft installation web page, the correct app is published by Canonical Group Limited. Then I clicked Install and it began downloading. Ubuntu is the leading leading distribution or "Distro". Once installed I pinned to Start menu and then clicked the Launch button. A command windows opens and the installation continues

After a while I get a prompt to create a new UNIX username which I did, on the first machine I tried this there was such a long dealy I though the process had hung, but please be patient it will get there. Then it asks for a password which I entered and then confirmed. then I am dropped into a console session. Yea! Try 'cd /' and then 'ls' to see the contents of your root folder.

Part B - Installing Apache

So next we install Apache, and I followed (roughly) the instructions from Digital Ocean and at the prompt I did the following

sudo apt-get update

sudo apt-get install apache2

this completes the install. Now we start the server with

sudo /etc/init.d/apache2 start

Then in a browser naviaget to

http://127.0.0.1

and one should see the Apache2 Ubuntu Default page

By the way, to fans of Virtual Machines (VMs) who are not convinced all I can say in parting is that I had to tidy a user profile of late because it grew massive and I discovered huge VM disk images. WSL allows the native disk filing system to be mounted so there is no need for a separate disk image with WSL.

Installing Apache directly onto Windows 10

So, this blog gets many hits regarding how to use HTTP(S) and also how to parse JSON. It seems that using Excel as a web service client is quite trendy. The REST Api is an increasingly popular web service paradigm. Excel developers should seriously consider structuring their applications and solutions around a smart client GUI interacting with a middle and data tier sitting behind a web server.

In such an architecture, should we use Microsoft IIS for the web server? Well for developers running a desktop edition of Windows, e.g. Windows 10, the version of IIS is not representative of the version of IIS on a Windows Server edition but then Windows Server costs at least a thousand dollars/pounds/euros. The desktop edition will ALWAYS ship with fewer features which can be very frustrating. And there will ALWAYS be a look and feel difference between developer edition and server edition. In this blog post, we'll explore the open source alternative, Apache.

Installing Apache directly onto Windows is a cinch, the XAMPP technology stack which includes not only Apache but also MariaDB (formerly MySql), PHP and Perl. With XAMPP you even get a nice control panel applet to start and stop your server

However, there are two drawbacks with this configuration. Firstly, if you move from your computer to a web hosting company then you will still need Windows; your hosting company might be puzzled as to why after having accepted Apache you chose Windows and not Linux as the OS. Secondly, one will find that a huge amount of Apache documentation is written for a Unix implementation. At this point I will end this post because the next post shows how to install Linux-like Apache.

Sunday 10 December 2017

VBA - Using WorksheetFunction in code doesn't have to throw an error

So one can use worksheet function from code from two different points in the object model (i) Application (ii) Application.WorksheetFunction. If you use the latter any errors will throw an error which you must catch with On Error. If you want to run with the error in the same way that the worksheet does then use the former and test with IsError. Here is some code which illustrates

Option Explicit

Sub Test_Application_WorksheetFunction_VLookup()
    Dim rng As Excel.Range
    Set rng = ThisWorkbook.Sheets.Item(1).Range("A1:b3")
    
    rng.Value = Application.Evaluate("{""Red"",1;""Green"",2;""Blue"",4}")


    Debug.Assert Application.WorksheetFunction.VLookup("Red", rng.Value, 2, False) = 1
    Debug.Assert Application.WorksheetFunction.VLookup("Green", rng.Value, 2, False) = 2
    Debug.Assert Application.WorksheetFunction.VLookup("Blue", rng.Value, 2, False) = 4
    
    Dim lSavedError As Long, sSavedError As String
    On Error Resume Next
    Dim vLU As Variant
    vLU = Application.WorksheetFunction.VLookup("Yellow", rng.Value, 2, False)
    sSavedError = Err.Description
    lSavedError = Err.Number
    On Error GoTo 0

    Debug.Assert lSavedError = 1004
    Debug.Assert sSavedError = "Unable to get the VLookup property of the WorksheetFunction class"
    Debug.Assert IsEmpty(vLU)

End Sub


Sub Test_Application_VLookup()
    Dim rng As Excel.Range
    Set rng = ThisWorkbook.Sheets.Item(1).Range("A1:b3")
    
    rng.Value = Application.Evaluate("{""Red"",1;""Green"",2;""Blue"",4}")


    Debug.Assert Application.WorksheetFunction.VLookup("Red", rng.Value, 2, False) = 1
    Debug.Assert Application.WorksheetFunction.VLookup("Green", rng.Value, 2, False) = 2
    Debug.Assert Application.WorksheetFunction.VLookup("Blue", rng.Value, 2, False) = 4
    
    Dim vLU As Variant
    vLU = Application.VLookup("Yellow", rng.Value, 2, False)

    Debug.Assert Not IsEmpty(vLU)
    Debug.Assert IsError(vLU)

End Sub



C++ Internationalisation - Twelve steps to Unicode-enabling

Some great advice about ensuring Unicode...

From Developing International Applications pages 109-111, Microsoft Press:
  1. Modify your code to use generic data types.
    Determine which variables declared as char or char* are text, and not pointers to buffers or binary byte arrays. Change these types to TCHAR and TCHAR*, as defined in the Win32 file windows.h, or to _TCHAR as defined in the VC++ file tchar.h. Replace LPSTR and LPCH with LPTSTR and LPTCH. Make sure to check all local variables and return types. Using generic data types is a good transition strategy because you can compile both ANSI and Unicode versions of your program without sacrificing the readability of the code. Don't use generic data types, however, for data that will always be Unicode or always ANSI. For example, one of the string parameters of MutliByteToWideChar and WideCharToMultiByte should always be in ANSI and the other should always be in Unicode.
  2. Modify your code to use generic function prototypes.
    For example, use the C run-time call _tclen instead of strlen, and use the Win32 API GetLocaleInfo instead of GetLocaleInfoA. If you are also porting from 16 bits to 32 bits, most Win32 generic function prototypes conveniently have the same name as the corresponding Windows 3.1 API calls (TextOut is one good example). Besides, the Win32 API is documented using generic types. If you plan to use Visual C++ 2.x or higher, become familiar with the available wide-character functions so that you'll know what kind of function calls you need to change. Always use generic data types when using generic function prototypes.
  3. Surround any character or string literal with the TEXT macro. The TEXT macro conditionally places an L in front of a character literal or a string literal. The C run-time equivalents are _T and _TEXT. Be careful with escape sequence specifying a 16-bit Unicode double-quote character, not as the beginning of a Unicode string. Visual C++ 2 treats anything within L" " quotes as a multibyte string and translates it to Unicode byte by byte, based on the current locale, using mbtowc. One possible way to create a string with Unicode hex values is to create a regular string and then coerce it to a Unicode string (while paying attention to byte order).
       char foo[4] = 0x40,0x40,0x40,0x41;
       wchar_t *wfoo = (wchar_t *)foo;
  4. Create generic versions of your data structures.
    Type definitions for string or character fields in structure should resolve correctly based on the UNICODE compile-time flag. If you write your own string-handling and character-handling functions, or functions that take strings as parameters, create Unicode versions of them and define generic prototypes for them.

  5. Change your make process.
    When you want to build a Unicode version of your application, both the Win32 compile-time flag -DUNICODE and the C run-time compile-time flag -D_UNICODE must be defined.

  6. Adjust pointer arithmetic.
    Subtracting char* values yields an answer in terms of bytes; subtracting wchar_t values yields an answer in terms of 16-bit chunks. When determining the number of bytes (for example, when allocating memory), multiply by sizeof(TCHAR). When determining the number of characters from the number of bytes, divide by sizeof(TCHAR). You can also create macros for these two operations, if you prefer. C makes sure that the + + and - - operators increment and decrement by the size of the data type.

  7. Check for any code that assumes a character is always 1 byte long.
    Code that assumes a character's value is always less than 256 (for example, code that uses a character value as an index into a table of size 256) must be changed. Remember that the ASCII subset of Unicode is fully compatible with 7-bit ASCII, but be smart about where you assume that character will be limited to ASCII. Make sure your definition of NULL is 16 bits long.

  8. Add Unicode-specific code if necessary.
    In particular, add code to map data "at the boundary" to and from Unicode using the Win32 functions WideCharToMultiByte and MutliByteToWideChar, or using the C run-time functions mbtowc, mbstowcs, wctomb, and wcstombs. Boundary refers to systems such as Windows 95, to old files, or to output calls, all of which might expect or provide non-Unicode encoded characters.

  9. Add code to support special Unicode characters.
    These include Unicode character in the compatibility zone, character in the private-use zone, combining characters, and character with directionality. Other special characters include the private-use-zone non-character U+FFFF, which can be used as a sentinel, and the byte order marks U+FEFF and U+FFFE, which can serve as flags that indicate a file is stored as Unicode. The byte order marks are used to indicate whether a text stream is little-Endian or big-Endian - that is, whether the high-order byte is stored first or last. In plaintext, the line separator U+2028 marks an unconditional end of line. Inserting a paragraph separator, U+2029, between paragraphs makes it easier to lay out text at different line widths.

  10. Determine how using Unicode will affect file I/O.
    If your application will exist in both Unicode and non-Unicode variations, you'll need to consider whether you want them to share a file format. Standardizing on an 8-bit character set data file will take away some of the benefits of having a Unicode application. Having different file formats and adding a conversion layer so each version can read the other's files is another alternative. Even if you choose a Unicode file format, you might have to support reading in old non-Unicode files or saving files in non-Unicode format for backward compatibility. Also, make sure to use the correct printf-style format specifiers for Visual C++, shown here:

       Specifier printf Expects wprintf expects
       %s SBCS or MBCS Unicode
       %S Unicode SBCS or MBCS
       %hs SBCS or MBCS SBCS or MBCS
       %ls Unicode Unicode

  11. Double-check the way in which you retrieve command line arguments.
    Use the function GetCommandLine rather than the lpCmdLine parameter (an ANSI string) that is passed to WinMain. WinMain cannot accept Unicode input because it is called before a window class is registered.

  12. Debug your port by enabling your compiler's type-checking.
    Do this (using W3 on Microsoft compilers) with and without the UNICODE flag defined. Some warnings that you might be able to ignore in the ANSI world will cause problems with Unicode. If your original code compiles cleanly with type-checking turned on, it will be easier to port. The warnings will help you make sure that you are not passing the wrong data type to code that expects wide-character data types. Use the Win32 NLSAPI or equivalent C run-time calls to get character typing and sorting information. Don't try to write your own logic - your application will end up carrying very large tables!
From Microsoft Typography|Developer Information|Character sets

Friday 1 December 2017

Use MSHTML to parse local HTML file without using Internet Explorer (Microsoft HTML Object Library)

So an excellent question came up today on StackOverflow about the parsing of HTML in VBA for when Internet Explorer is unavailable.

Anyone who has done some web scraping will be familiar with creating an instance of Internet Explorer (IE) and the navigating to a web address and then once the page is ready start navigating the DOM using the 'Microsoft HTML Object Library' (MSHTML) type library. The question asks if IE is unavailable what to do. I am in the same situation for my box running Windows 10.

I had suspected it was possible to spin up an instance of MSHTML.HTMLDocument but its creation is not obvious. Thanks to the questioner for asking this now. The answer lies in the MSHTML.IHTMLDocument4.createDocumentFromUrl method. One needs a local file to work with (EDIT: actually one can put a webby url in as well!) but we have a nice tidy Windows API function called URLDownloadToFile to download a file.

This codes runs on my Windows 10 box where Microsoft Edge is running and not Internet Explorer. This is an important find and thanks to the questioner for raising it.


Option Explicit

'* Tools->Refernces Microsoft HTML Object Library


'* MSDN - URLDownloadToFile function - https://msdn.microsoft.com/en-us/library/ms775123(v=vs.85).aspx
Private Declare PtrSafe Function URLDownloadToFile Lib "urlmon" Alias "URLDownloadToFileA" _
        (ByVal pCaller As Long, ByVal szURL As String, ByVal szFileName As String, _
        ByVal dwReserved As Long, ByVal lpfnCB As Long) As Long

Sub Test()

    Dim fso As Object
    Set fso = CreateObject("Scripting.FileSystemObject")

    Dim sLocalFilename As String
    sLocalFilename = Environ$("TMP") & "\urlmon.html"
    
    Dim sURL As String
    sURL = "https://stackoverflow.com/users/3607273/s-meaden"
    
    
    Dim bOk As Boolean
    bOk = (URLDownloadToFile(0, sURL, sLocalFilename, 0, 0) = 0)
    If bOk Then
        If fso.FileExists(sLocalFilename) Then
        
            '* Tools->References Microsoft HTML Object Library
            Dim oHtml4 As MSHTML.IHTMLDocument4
            Set oHtml4 = New MSHTML.HTMLDocument
            
            Dim oHtml As MSHTML.HTMLDocument
            Set oHtml = Nothing
            
            '* IHTMLDocument4.createDocumentFromUrl
            '* MSDN - IHTMLDocument4 createDocumentFromUrl method - https://msdn.microsoft.com/en-us/library/aa752523(v=vs.85).aspx
            Set oHtml = oHtml4.createDocumentFromUrl(sLocalFilename, "")
            
            '* need to wait a little whilst the document parses
            '* because it is multithreaded
            While oHtml.readyState <> "complete"
                DoEvents  '* do not comment this out it is required to break into the code if in infinite loop
            Wend
            Debug.Assert oHtml.readyState = "complete"
            

            Dim sTest As String
            sTest = Left$(oHtml.body.outerHTML, 100)
            Debug.Assert Len(Trim(sTest)) > 50  '* just testing we got a substantial block of text, feel free to delete
            
            '* this is where the page specific logic now goes, here I am getting info from a StackOverflow page
            Dim htmlAnswers As Object 'MSHTML.DispHTMLElementCollection
            Set htmlAnswers = oHtml.getElementsByClassName("answer-hyperlink")
    
            Dim lAnswerLoop As Long
            For lAnswerLoop = 0 To htmlAnswers.Length - 1
                Dim vAnswerLoop
                Set vAnswerLoop = htmlAnswers.Item(lAnswerLoop)
                Debug.Print vAnswerLoop.outerText
            
            Next
    
        End If
    End If
End Sub