VBA, Python, Multi-threading - Stoppable Folder Replicator

In this post I give a multi-threaded Python script which replicates one folder to another. It uses the Windows API ReadDirectoryChangesW function to watch for directory changes. It is start-able and stoppable from Excel VBA using the Windows Synchronization Events which I explored in the previous couple of posts.

Background

So I wanted some code to replicate a folder. Of course I could have written some VBA code to scan both a source and a destination folder every few seconds and figure what needed copying but this is a bit lame because it has needless disk activity and other techniques must be available. It is possible to use the Windows API, and specifically the ReadDirectoryChangesW function to watch a folder. .NET also has a folder watcher feature but I am happy to stick to Windows API.

ReadDirectoryChangesW blocks (in synchronous case)

But the problem with ReadDirectoryChangesW is that is blocks in the synchronous case. It is not like other waitable API function such as WaitForSingleObject(handle,interval) in that one can wait for a fixed time interval before breaking off to do some other work and give the impression of multi-threading.

I have seen on some VB6 forums some programmers attempt to use CreateThread() to give themselves another thread but they report crashes and this is because threads in VB6 and VBA need to obey COM apartment threading rules. I have yet to see successfully robust multi-threaded code for VB6 or VBA. Sure, I've seen code that looks like it runs multiple threads but the moment one puts in a break point and starts debugging Excel crashes. Perhaps one day I might solve that problem. In the meantime, I strongly recommend *not* creating threads in VBA. If you want concurrency then you should shell another process.

However, shelling another process raises the issue on how to communicate between the processes. In the previous two posts I demonstrated the use of Windows Synchronization Events as an inter process communication (IPC) mechanism and I will use this to signal the folder replicator to stop. To shell a child process on the VBA side, I am using Windows Script Host Object Model (wshom.ocx) and at some point the code could call Terminate() to kill the shelled process but this does not give the shelled process a chance to tidy up its resources. Instead, I am going to give VBA code which signals an Windows Synchronization Event object to politely ask the shelled process to tidy up and terminate itself.

ReadDirectoryChangesW is waitable in the asynchronous case

So upon further researching it turns out ReadDirectoryChangesW has a asynchronous use case as well which is helpful. Even more helpful is the fact I discovered Python code to call ReadDirectoryChangesW asynchronously in the test scripts of Mark Hammond's Win32 library, test_win32file.py. I am truly grateful for Mark Hammond's Windows Python library. For an explanation as to how the asynchronous use case works see the remarks section of ReadDirectoryChangesW docs page. So in the Python code it shows we can call WaitForSingleObject(handle,interval) in the asynchronous case.

But we still need two threads, one will watch the directory for changes and the other will wait for the stop signal to be issued by the Excel VBA code. So the following Python script is an example of how to launch a second thread in Python.

StoppableFolderReplicator.py

The core of the Python script below is based upon a unit test file for Mark Hammond's Windows Python library, test_win32file.py. The main() function runs first and validates the command line arguments, if valid it creates the class StoppableFolderReplicator where the real action takes place.

In the constructor of StoppableFolderReplicator class a handle to the directory to watch is obtained and then a second Thread is created to run the class's _watcherThreadOverlapped() method. Then the main thread runs the class's waitForEvent() method where it sits waiting for the Windows Synchronization Event (the stop event) to be signalled (by VBA).

The second thread runs the class's _watcherThreadOverlapped() method and loops around watching the directory by calling the ReadDirectoryChangesW() function. ReadDirectoryChangesW() returns either on a timeout or if there is a change in the directory it is watching; if the latter then any new file is copied across. Each iteration of the loop this thread also checks to the class's tearDownInProgress boolean property which is signalled by the main thread (in waitForEvent()) when the stop event is signalled; if signalled this second thread releases its handle and then quits.

A key line of code in the class's waitForEvent() method is self.watcher_thread.join(5) where the first thread pauses and waits for the second thread to acknowledge the stop, tidy up and then quit. Without this line, the main thread would quit earlier than the second thread with unexpected results.

Most messages printed are prefixed by a thread number to help folks understand how it works.

import win32api
import win32file
import pywintypes
import winerror
import win32event
import win32con
import ntsecuritycon
import sys
import os
import tempfile
import threading
import time
import shutil
from shutil import copyfile

class StoppableFolderReplicator(): 

    def __init__(self, srcFolder, destFolder, hEvent):
        self.srcFolder = srcFolder
        self.destFolder = destFolder
        self.hEvent = hEvent
        self.tearDownInProgress = False

        self.ACTIONS = {
                1 : "Created",
                2 : "Deleted",
                3 : "Updated",
                4 : "Renamed from something",
                5 : "Renamed to something"
            }
        
        self.dir_handle = win32file.CreateFile(srcFolder, 
                                        ntsecuritycon.FILE_LIST_DIRECTORY,
                                        win32con.FILE_SHARE_READ,
                                        None, # security desc
                                        win32con.OPEN_EXISTING,
                                        win32con.FILE_FLAG_BACKUP_SEMANTICS | win32con.FILE_FLAG_OVERLAPPED,
                                        None)

        self.watcher_thread = threading.Thread(target=self._watcherThreadOverlapped,
                            args=(srcFolder, destFolder, self.dir_handle))
        self.watcher_thread.start()


    def _watcherThreadOverlapped(self, srcFolder, destFolder, dir_handle):
        print("thread #2:waiting for directory changes")
        changes = []
        flags = win32con.FILE_NOTIFY_CHANGE_FILE_NAME
        buf = win32file.AllocateReadBuffer(8192)
        overlapped = pywintypes.OVERLAPPED()
        overlapped.hEvent = win32event.CreateEvent(None, 0, 0, None)
        while 1:
            if self.tearDownInProgress:
                print("thread #2:tidying up")
                if self.dir_handle != 0:
                    win32api.CloseHandle(self.dir_handle)
                    self.dir_handle = 0
                break
            try:
                win32file.ReadDirectoryChangesW(self.dir_handle,
                                                buf,
                                                False, #sub-tree
                                                flags,
                                                overlapped)
            except Exception as e:
                print("thread #2: Exception whilst ReadDirectoryChangesW:" + str(e) + "\n")
                break 
            # Wait for our event or for a short time.
            rc = win32event.WaitForSingleObject(overlapped.hEvent, 1000)
            if rc == win32event.WAIT_OBJECT_0:
                # got some data!  Must use GetOverlappedResult to find out
                # how much is valid!  0 generally means the handle has
                # been closed.  Blocking is OK here, as the event has
                # already been set.
                nbytes = win32file.GetOverlappedResult(dir_handle, overlapped, True)
                if nbytes:
                    bits = win32file.FILE_NOTIFY_INFORMATION(buf, nbytes)
                    changes.extend(bits)

                    for action, file in changes:
                        full_filename = os.path.join(srcFolder, file)
                        print("thread #2:" , full_filename, self.ACTIONS.get(action, "Unknown"))
                        if action == 1 or action == 3:
                            #
                            # perhaps put some filtering or file renaming logic
                            # in here
                            #
                            if os.path.isfile(full_filename):
                                sDestFilename = os.path.join(destFolder, file)
                                try:
                                    copyfile(full_filename,sDestFilename)
                                except Exception as e:
                                    print("thread #2: Exception whilst copying file '" + full_filename + "':" + str(e) + "\n")
                    changes = []  # bugfix, need to clear this other it accumulates
                else:
                    # This is "normal" exit - our 'tearDown' closes the
                    # handle.
                    # print "looks like dir handle was closed!"
                    break
        print ("thread #2:stopped")

    def waitForEvent(self):
        try:
            print("thread #1:waiting for stop event")
            while 1:
                
                dwWaitResult = win32event.WaitForSingleObject(self.hEvent.handle, 500)
                if dwWaitResult == win32event.WAIT_OBJECT_0:
                    print("thread #1:stop signal received...")
                    self.tearDownInProgress = True
                    self.watcher_thread.join(5)
                    return
                pass

        except Exception as e:
            print("thread #1:Exception whilst polling for event:'" + self.stopEventName + "':" + str(e) + "\n")

        
if __name__ == '__main__':

    if len(sys.argv) < 4:
        print("Usage:" + os.path.basename(__file__) + " <sourceFolder> <destinationFolder> <stopEventName>")
    else:
        srcFolder = sys.argv[1]
        destFolder = sys.argv[2]
        stopEventName = sys.argv[3]

        ok = True
        if not os.path.isdir(srcFolder):
            print("Error, srcFolder '" + srcFolder + "' does not exist!  Abandoning.")
            ok = False

        if not os.path.isdir(destFolder):
            print("Error, destFolder '" + destFolder + "' does not exist!  Abandoning.")
            ok = False

        if ok == True:
            try:
                stoppable = False
                hEvent = win32event.OpenEvent(ntsecuritycon.SYNCHRONIZE, 0, stopEventName)
                
                stoppable = True
            except Exception as e:
                print("Exception whilst opening event:'" + stopEventName + "':" + str(e) + "\n")

            if stoppable:
                foo = StoppableFolderReplicator(srcFolder, destFolder, hEvent) 
                foo.waitForEvent()
                win32api.CloseHandle(hEvent)
                print("all stopped")
            else:
                print("Not stoppable, abandoning!")

Calling Excel VBA code

So two lines of the VBA code depend upon Chip Pearson's FormatMessage() function is a freely downloadable module from his website; alternatively you could comment them out.

In the previous two posts, I wrote about Windows Synchronization Event objects and how to use them in VBA so I won't duplicate explanation of that.

You should run the TestStoppableFolderReplicator() procedure. The other procedure is there for debugging against a Visual Studio launched Python process and is useful for development.

The stop event is created before the Python script is shelled because the Python script is expecting to open the event object; we create the event object in an initial state of being unset.

Next, the code uses the Windows Script Host Object Model (wshom.ocx) type library to shell the Python script, we supply three extra arguments after the script name (i) source folder, (ii) destination folder and (iii) the stop event name.

The code then reaches a Stop statement at which point you are invited to pop off to the source folder and create some files to test the replication. For the quickest way to create a file, I right click in a folder's explorer window and in the context menu I select the menu option New->Text Document. When a file is created it is replicated to the destination folder specified.

Once you've got bored of creating files and seeing them replicated then press F5 to move off the Stop statement and send the stop signal, the code then loops waiting for the Python process to quit voluntarily, this should be for only a split second.

When running the code below the shelled process appears as a blank window but once finished the output to that window is displayed in the VBA IDE's Immediate window. Underneath the code listing is a sample of what appeared for me in the Immediate window.

Option Explicit

'* Tools->References
'*   Windows Script Host Object Model (wshom.ocx)

Private Declare Function CreateEventWithoutSec Lib "kernel32" Alias "CreateEventA" (lpEventAttributes As Long, _
                    ByVal bManualReset As Long, ByVal bInitialState As Long, ByVal lpName As String) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Private Declare Function SetEvent Lib "kernel32.dll" (ByVal hEvent As Long) As Long
Private Declare Function ResetEvent Lib "kernel32.dll" (ByVal hEvent As Long) As Long

Private hEvent As Long



Sub TestStoppableFolderReplicator()

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

    Const csPythonScriptFilePath As String = "C:\Users\Simon\source\repos\StoppableFolderReplicator\StoppableFolderReplicator\StoppableFolderReplicator.py "
    Const csSourceFolder As String = """N:\Folder Replication Sandbox\Source"""
    Const csDestinationFolder As String = """N:\Folder Replication Sandbox\Destination"""
    Const csStopEvent As String = "stopReplicator"
    
    Dim sCmdLine As String
    sCmdLine = "python " & csPythonScriptFilePath & " " & csSourceFolder & " " & csDestinationFolder & " " & csStopEvent
    
    hEvent = CreateEventWithoutSec(0, 1, 0, csStopEvent)
    If hEvent = 0 Then
        Debug.Print GetSystemErrorMessageText(Err.LastDllError)
        GoTo SingleExit
    End If
    
    '*
    '* launch the python script
    '*
    Dim oWshExec As IWshRuntimeLibrary.WshExec
    Set oWshExec = oWshShell.Exec(sCmdLine)
    Debug.Assert oWshExec.Status = WshRunning

    '* stop here for a while, pop off to source folder and create some files
    '* and watch them replicate to destination folder
    '* once you've got bored press F5 to send the stop signal
    Stop
    
    '* Ill-advised to use oWshExec.Terminate() because of resources not being tidied up cleanly
    '* so instead we set a signal which the shelled process looks for a shutdowns cleanly and voluntarily
    Call SetEvent(hEvent)

    '* allow the Python script a split second to respond the stop signal
    '* in the meantime we'll loop until the Python process quits
    While oWshExec.Status = WshRunning
        DoEvents '* stay responsive
    Wend

    '* very important to reset event if you want subsequent runs to work as well!
    Call ResetEvent(hEvent)
    Debug.Assert oWshExec.Status = WshFinished
    
    '* we can access what would have been printed to the console
    Debug.Print oWshExec.StdOut.ReadAll
    
    '* tidy up our handle, very important!
SingleExit:
    If hEvent <> 0 Then
        Call CloseHandle(hEvent)
        hEvent = 0
    End If

End Sub

Private Sub DebugStopSignal()
    '* I used this procedure for debugging the stop signal
    hEvent = CreateEventWithoutSec(0, 1, 0, "stopReplicator")
    If hEvent = 0 Then
        Debug.Print GetSystemErrorMessageText(Err.LastDllError)
        GoTo SingleExit
    Else
        Stop
        Call SetEvent(hEvent)
    
        Stop
        Call ResetEvent(hEvent)
    End If
    
SingleExit:
    If hEvent <> 0 Then
        Call CloseHandle(hEvent)
        hEvent = 0
    End If
End Sub

Here is some sample output copied from my Immediate window

thread #2:waiting for directory changes
thread #1:waiting for stop event
thread #2: N:\Folder Replication Sandbox\Source\New Text Document.txt Created
thread #2: N:\Folder Replication Sandbox\Source\New Text Document.txt Created
thread #2: N:\Folder Replication Sandbox\Source\New Rich Text Document.rtf Created
thread #1:stop signal received...
thread #2:tidying up
thread #2:stopped
all stopped

Final thoughts

The Python script replicated a folder but it could do anything that you wanted to offload from VBA because of VBA's lack of multi-threading. Signalling a stop is a vital IPC mechanism. This is much better than just calling the Terminate() method. I really like Python as a means of extending VBA's power. Enjoy!

Links

• Microsoft Docs - ReadDirectoryChangesW function

VBA, WinAPI - Simpler IPC synchronisation Events

In this post I give simple VBA code to create an Event object for Windows synchronization. In the last post I gave some C++ code which was complicated by some extra lines for security descriptors, it turns out one can pass NULL instead of creating a security descriptor meaning I could written simpler C++ code. Instead of rewriting the C++ I will write the new code as VBA.

You'll need a instance of Microsoft Excel and a instance of Microsoft Word (or two VBA devlopment environments, Excel, Word, Access etc.); one instance will create the event and the other will wait upon the event.

VBA code to create a Windows Synchronization Event object

This code requires the GetSystemErrorMessageText module from Chip Pearson to give nice error messages for any errors encountered using the WinAPI, I recommend!

Copy the code below into a module in one your two VBA development environments. For me, I am running this in Excel.

Option Explicit

Private Declare Function CreateEventWithoutSec Lib "kernel32" Alias "CreateEventA" (ByVal lpEventAttributes As Long, ByVal bManualReset As Long, _
      ByVal bInitialState As Long, ByVal lpName As String) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Private Declare Function SetEvent Lib "kernel32.dll" (ByVal hEvent As Long) As Long
Private Declare Function ResetEvent Lib "kernel32.dll" (ByVal hEvent As Long) As Long

Private Sub CreateEventWithoutSecurity()

    Dim hEvent As Long

    hEvent = CreateEventWithoutSec(0, 1, 0, "ExcelWordIPC1")
    If hEvent = 0 Then
        Debug.Print GetSystemErrorMessageText(Err.LastDllError)
        GoTo SingleExit
    Else
        Stop
        Call SetEvent(hEvent)
    
        Stop
        Call ResetEvent(hEvent)
    
    End If
    
SingleExit:
    If hEvent <> 0 Then
        Call CloseHandle(hEvent)
        hEvent = 0
    End If
End Sub

VBA code to wait upon a Windows Synchronization Event object

This code also requires the GetSystemErrorMessageText module from Chip Pearson to give nice error messages for any errors encountered using the WinAPI, I recommend!

Copy the code below into a module in the other of your two VBA development environments. For me, I am running this in Word.

Option Explicit

Private Const SYNCHRONIZE As Long = &H100000

Private Declare Function OpenEvent Lib "kernel32.dll" Alias "OpenEventA" (ByVal dwDesiredAccess As Long, _
        ByVal bInheritHandle As Long, ByVal lpName As String) As Long
        
Private Declare Function WaitForSingleObject Lib "kernel32" (ByVal hHandle As Long, ByVal dwMilliseconds As Long) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long

Private Enum eWaitResult
    WAIT_ABANDONED = &H80       'The specified object is a mutex object that was not released by the thread that owned the mutex
    WAIT_OBJECT_0 = &H0         'The state of the specified object is signaled.
    WAIT_TIMEOUT = &H102        'The time-out interval elapsed, and the object's state is nonsignaled.
    WAIT_FAILED = &HFFFFFFFF    'The function has failed. To get extended error information, call GetLastError.
End Enum

Sub OpenEventAndSet()

    Dim hEvent As Long
    hEvent = OpenEvent(SYNCHRONIZE, 0, "ExcelWordIPC1")
    If hEvent = 0 Then
        Debug.Print "Failed in call to OpenEvent."
        Debug.Print GetSystemErrorMessageText(Err.LastDllError)
    Else
        Dim dwWaitResult As eWaitResult
        dwWaitResult = WaitForSingleObject(hEvent, -1)
        
        Stop
        Select Case dwWaitResult
        
        Case eWaitResult.WAIT_OBJECT_0
            Debug.Print "The state of the specified object is signalled."
        Case eWaitResult.WAIT_TIMEOUT
            Debug.Print "wait timeout"
            
        Case eWaitResult.WAIT_FAILED
            Debug.Print "wait failed"
            Debug.Print GetSystemErrorMessageText(Err.LastDllError)
        Case eWaitResult.WAIT_ABANDONED
            Debug.Print "wait abandoned"
        End Select
        'Stop
        Call CloseHandle(hEvent)
    End If
    
    'Stop
End Sub

So if you run the first block of code until it reaches the Stop statement just above SetEvent and then switch to the other block and run that then the latter will wait in the call to WaitForSingleObject(); switch back to the former code and then press F5 to allow the code to run the SetEvent() line of code then you should find that in the latter code environment the code has exited WaitForSingleObject() and is waiting at the Stop statement.

Congratulations if you got this far as you have stepped through an IPC signal code sample. If you are more interested I suggest the previous post as there are many documentation links in the text.

Epilogue

So there is a trick to the above simplification where we skip security attributes, and it involves rewriting the Declare Function CreateEvent statement. A fuller, more correct declaration of CreateEvent would look like this ...

Private Declare Function CreateEvent Lib "kernel32" Alias "CreateEventA" (lpEventAttributes As SECURITY_ATTRIBUTES, _ 
    ByVal bManualReset As Long, ByVal bInitialState As Long, ByVal lpName As String) As Long

So in the above declaration we can see the first argument is of type SECURITY_ATTRIBUTES but the API allows a NULL (zero) to be passed to this argument, this is not possible in VBA with the above Declare Function signature. If you try passing zero as the first argument then you get a type mismatch. Instead it needs rewriting so that the first argument is of type Long so we can pass a zero (which is what NULL actually is in C++). So the new Declare Function statement becomes (as found in above listing) ...

Private Declare Function CreateEventWithoutSec Lib "kernel32" Alias "CreateEventA" (ByVal lpEventAttributes As Long, ByVal bManualReset As Long, _
    ByVal bInitialState As Long, ByVal lpName As String) As Long

And I have renamed the function declaration CreateEventWithoutSec to signify what I am doing here. This is a useful trick in calling a Windows API function precisely for our use case and worth remembering as this may arise in other contexts.

C++, VBA, WinApi - Signal another process with WinApi Synchronization Event

In this post I give code where a C++ program signals to a VBA program running in a separate process. This demonstrates inter-process communication (IPC) using the native Windows API (and not related to COM).

I do like playing with the Windows API and in this instance I am playing with a Windows API Event which is used for synchronization; it is not to be confused with COM events. A good definition of an Event is given by this doc page ...

Applications can use event objects in a number of situations to notify a waiting thread of the occurrence of an event. For example, overlapped I/O operations on files, named pipes, and communications devices use an event object to signal their completion.

I needed this for a use case where I wanted to signal to a child process to terminate. So instead of using brute force to terminate the child process, I signal an event which is periodically inspected and if signalled the child process will terminate cleanly and voluntarily.

Before we get to that use case (which I intend to post shortly) I wanted to post the details of ...

In the first (C++) process that hosts the event... Creating an event, including creating a security descriptor. Setting the event Resetting the event

In the second (VBA) process... Opening the event Waiting for event

Code for the C++ process that hosts the event

I have moved some code the error reporting code to Appendix A, the remainder of code is relevant to the teaching point of this post.

The first thing required is to create a security descriptor object (of type SECURITY_DESCRIPTOR). The security descriptor is created on the heap using LocalAlloc and so has to be freed before the program exits; then it has to be initialized with a call to InitializeSecurityDescriptor(). Next an access control list (ACL) has to be set for the security descriptor or not! I have saved plenty of code by opting not to use an access control list (ACL). I have seen plenty of voluminous code which does program an ACL but I did not want to distract from the main teaching point. In production you'd likely want to use an ACL to secure the Event object. I'm skipping the ACL and so I pass NULL into 3rd argument of SetSecurityDescriptorDacl() and set the 2nd argument to FALSE to show I intended not to pass an ACL.

Then the security descriptor is added to a parent structure called security attributes (of type SECURITY_ATTRIBUTES).

It is worth stressing that in the post the bulk of the headaches in getting this to work was with the security. Once the security attributes structure is created (with its nested security descriptor) then we are good to start calling CreatEvent() which in comparison is straightforward. The call to CreatEvent() specifies that the Event object is to be signalled manually and that its initial state is False, i.e. not signalled/not set. The final argument to CreatEvent() is the name of the object.

After creating the event there is a line of code to SetEvent() which sets or signals the event. Then, the Event object needs to be reset and so the call to ResetEvent. If you are playing along then you will want to place a breakpoint on the SetEvent() line of code.

So the following code can be pasted into a C++ console app.

#include "pch.h"
#include <iostream>
#include <Windows.h>
#include <strsafe.h>

void ErrorExit(LPCTSTR lpszFunction)
{
 // Omitted , see Appendix A
}

//https://docs.microsoft.com/en-us/windows/win32/secauthz/creating-a-security-descriptor-for-a-new-object-in-c--
//https://stackoverflow.com/questions/49253537/the-createfilemapping-is-failed-with-security-attributes-the-revision-level-is

int main()
{
 PSECURITY_DESCRIPTOR pSD = NULL;
 // Initialize a security descriptor.  
 pSD = (PSECURITY_DESCRIPTOR)LocalAlloc(LPTR,
  SECURITY_DESCRIPTOR_MIN_LENGTH);
 if (NULL == pSD)
 {
  ErrorExit(TEXT("LocalAlloc"));
 }

 if (NULL == InitializeSecurityDescriptor(pSD, SECURITY_DESCRIPTOR_REVISION))
 {
  ErrorExit(TEXT("InitializeSecurityDescriptor"));
 }

 // Add the ACL to the security descriptor. 
 if (!SetSecurityDescriptorDacl(pSD,
  FALSE,     // bDaclPresent flag   
  NULL,      // We're passing NULL to say there is no Access Control List for this object
  FALSE))   // not a default DACL 
 {
  ErrorExit(TEXT("SetSecurityDescriptorDacl"));
 }

 SECURITY_ATTRIBUTES sa;
 // Initialize a security attributes structure.
 sa.nLength = sizeof(SECURITY_ATTRIBUTES);
 sa.lpSecurityDescriptor = pSD;
 sa.bInheritHandle = FALSE;

 /*
  * Use this following line to abolish any mention of security attributes/descriptors
  * HANDLE hEvent = CreateEvent(NULL, TRUE, FALSE, TEXT("C++ExcelVBAIPC"));
  */
 HANDLE hEvent = CreateEvent(&sa, TRUE, FALSE, TEXT("C++ExcelVBAIPC"));
 if (0 == hEvent)
 {
  ErrorExit(TEXT("CreateEvent"));
 }
 else
 {
  // PLACE BREAKPOINT HERE TO EXPERIMENT WITH A CLIENT CALLING WaitForSingleObject
  SetEvent(hEvent);
 }
 ResetEvent(hEvent);
 CloseHandle(hEvent);
        std::cout << "Finished!\n"; 

 // free any allocated heap memory
 if (pSD)
  LocalFree(pSD);

}

Code for the VBA ++ process that waits on the event

The following VBA code can sit in Excel or Word. It requires the GetSystemErrorMessageText module from Chip Pearson to give nice error messages for any errors encountered using the WinAPI, I recommend!

The code is relatively simple. It opens an event with OpenEvent() specifying SYNCHRONIZE permissions only. Then the code calls WaitForSingleObject(). In this code we pass -1 which means wait indefinitely but in a more realistic scenario one would pass a positive integer of milliseconds for how long to wait.

If you are playing along with the breakpoint in the C++ code then the VBA code will wait forever (hang) so do please save your work! The VBA code will progress once the event object is signalled on the C++ side, so switch back to the C++ code and make it continue then the VBA code will continue. If running the experiment multiple times don't forget to let the C++ side call ResetEvent (or pass the C++ CloseHandle() statement) otherwise the Event object will remain signalled.

On detroying Event objects a good quote here from this page ...

Use the CloseHandle function to close the handle. The system closes the handle automatically when the process terminates. The event object is destroyed when its last handle has been closed.

Option Explicit

Private Const SYNCHRONIZE As Long = &H100000

Private Declare Function CloseHandle Lib "kernel32.dll" (ByVal hObject As Long) As Long

Private Declare Function OpenEvent Lib "kernel32.dll" Alias "OpenEventA" (ByVal dwDesiredAccess As Long, _
        ByVal bInheritHandle As Long, ByVal lpName As String) As Long

Private Declare Function WaitForSingleObject Lib "kernel32" (ByVal hHandle As Long, ByVal dwMilliseconds As Long) As Long

Private Enum eWaitResult
    WAIT_ABANDONED = &H80       'The specified object is a mutex object that was not released by the thread that owned the mutex
    WAIT_OBJECT_0 = &H0         'The state of the specified object is signaled.
    WAIT_TIMEOUT = &H102        'The time-out interval elapsed, and the object's state is nonsignaled.
    WAIT_FAILED = &HFFFFFFFF    'The function has failed. To get extended error information, call GetLastError.
End Enum

Private hEvent As Long

Sub OpenEventAndWait()

    hEvent = OpenEvent(SYNCHRONIZE, 0, "C++ExcelVBAIPC")
    If hEvent = 0 Then
        Debug.Print "Failed in call to OpenEvent."

        // requires http://www.cpearson.com/Excel/FormatMessage.aspx
        Debug.Print GetSystemErrorMessageText(Err.LastDllError) 
    Else
        Stop
        Dim dwWaitResult As eWaitResult
        dwWaitResult = WaitForSingleObject(hEvent, -1)
        
        Stop
        Select Case dwWaitResult
        
        Case eWaitResult.WAIT_OBJECT_0
            Debug.Print "The state of the specified object is signaled."
        Case eWaitResult.WAIT_TIMEOUT
            Debug.Print "wait timeout"
            
        Case eWaitResult.WAIT_FAILED
            Debug.Print "wait failed"
            Debug.Print GetSystemErrorMessageText(Err.LastDllError)
        Case eWaitResult.WAIT_ABANDONED
            Debug.Print "wait abandoned"
        End Select
        'Stop
        Call CloseHandle(hEvent)
    End If
    
    'Stop
End Sub

Conclusions and other thoughts

So even this post with its stripped down permissioning requires a lot of explanation. If you feel cheated in that I have skipped code regarding security and access control lists then I recommend this link which has some relevant code.

Now that I have given explanation for this code I can now proceed with the post where I spawn a child process and when I need to terminate it I signal using an Event object. That code will be VBA creating the event whilst a Python script polls the event.

UPDATE: it looks like one can pass NULL instead of a security attributes object into CreateEvent and this also has no permissions. Oh well, I'm not going to strip out the security attributes code because I hope to upgrade it with some ACL code one day. But it does mean the VBA equivalent should be much easier to write and I will slip in another post to show this.

Appendix A - Extra C++ code which calls GetLastError, formats the error message and throws an message box

So this code was taken out of the full C++ listing given above in order not to distract from the main teaching point. Nevertheless it is useful.

//With thanks to https://docs.microsoft.com/en-us/windows/win32/debug/retrieving-the-last-error-code

#include <strsafe.h>

void ErrorExit(LPCTSTR lpszFunction)
{
 // Retrieve the system error message for the last-error code

 LPVOID lpMsgBuf;
 LPVOID lpDisplayBuf;
 DWORD dw = GetLastError();

 FormatMessage(
  FORMAT_MESSAGE_ALLOCATE_BUFFER |
  FORMAT_MESSAGE_FROM_SYSTEM |
  FORMAT_MESSAGE_IGNORE_INSERTS,
  NULL,
  dw,
  MAKELANGID(LANG_NEUTRAL, SUBLANG_DEFAULT),
  (LPTSTR)&lpMsgBuf,
  0, NULL);

 // Display the error message and exit the process

 lpDisplayBuf = (LPVOID)LocalAlloc(LMEM_ZEROINIT,
  (lstrlen((LPCTSTR)lpMsgBuf) + lstrlen((LPCTSTR)lpszFunction) + 40) * sizeof(TCHAR));
 StringCchPrintf((LPTSTR)lpDisplayBuf,
  LocalSize(lpDisplayBuf) / sizeof(TCHAR),
  TEXT("%s failed with error %d: %s"),
  lpszFunction, dw, lpMsgBuf);
 MessageBox(NULL, (LPCTSTR)lpDisplayBuf, TEXT("Error"), MB_OK);

 LocalFree(lpMsgBuf);
 LocalFree(lpDisplayBuf);
 ExitProcess(dw);
}

VBA - ADO - Recordset.GetRows method allows SQL column selection but CopyFromRecordset doesn't

I like ADO recordsets even though they are old school, they dovetail well with Excel VBA especially in that one can call the Range.CopyFromRecordset method and get a recordset written to a block of sheets in super quick time. However, in this post I show the Recordset.GetRows method which allows SQL column selection (technically known as projection) which is something lacking with CopyFromRecordset.

So the code below has two functions, the bottom function is just to create a test recordset because not everybody has a database lying around to which they can make queries, so there is nothing to see there. What there is to see is the top function which contains calls to the Recordset.GetRows method to return a rectangular two dimensional variant array which can easily be pasted onto a range of cells on a worksheet. If you are wondering why take two steps when CopyFromRecordset takes one then consider the parameters for CopyFromRecordset shown here immediately below

So in the first parameter Range.CopyfromRecordset takes a recordset and the remaining two parameters allow the rows and columns to be capped but there is no parameter by which to select the columns. But in the code below, specifically in the second call to GetRows we can specify a Fields parameter which is an array of field names. Cool.

Why does this matter (to me) ? Well, ADO recordsets are useful as 'state vehicles' or data marshalling devices in a distributed system. That is to say they can be used in network calls between separate machines on a network such as in a multi-tier (N-Tier) distributed system design pattern. Now that we know we can select columns we can engineer our system to be generous in columns knowing they can be selected out when writing to a worksheet.

Option Explicit

'* Tools -> References
'* Microsoft ActiveX Data Objects x.y Library

Function ProjectRecordset()
    Dim rstADO As ADODB.Recordset
    Set rstADO = CreateTestRecordset_NothingToSeeHere

    '* you need to move the cursor to first record
    rstADO.MoveFirst
    
    
    Dim vAllColumns As Variant
    vAllColumns = rstADO.GetRows()
    
    Debug.Assert UBound(vAllColumns, 1) - LBound(vAllColumns, 1) + 1 = rstADO.Fields.Count
    
    '* reset the cursor by moving it back to first record
    rstADO.MoveFirst
    
    '    ____      _   ____                         _                                   _           _   _ _
    '   / ___| ___| |_|  _ \ _____      _____    __| | ___   ___  ___   _ __  _ __ ___ (_) ___  ___| |_(_) ___  _ __  ___
    '  | |  _ / _ \ __| |_) / _ \ \ /\ / / __|  / _` |/ _ \ / _ \/ __| | '_ \| '__/ _ \| |/ _ \/ __| __| |/ _ \| '_ \/ __|
    '  | |_| |  __/ |_|  _ < (_) \ V  V /\__ \ | (_| | (_) |  __/\__ \ | |_) | | | (_) | |  __/ (__| |_| | (_) | | | \__ \
    ' (_)____|\___|\__|_| \_\___/ \_/\_/ |___/  \__,_|\___/ \___||___/ | .__/|_|  \___// |\___|\___|\__|_|\___/|_| |_|___/
    '                                                                  |_|           |__/
    
    
    Dim vSubselectionOfColumns As Variant
    vSubselectionOfColumns = rstADO.GetRows(, , Array("Animal", "ArrivalSequence"))

    Debug.Assert UBound(vSubselectionOfColumns, 1) - LBound(vSubselectionOfColumns, 1) + 1 = 2

    Dim rngDestination As Excel.Range
    'Set rngDestination = Workbooks("Foo").Worksheets("Bar").Range("a1")   '<---- Placeholder workbook and worksheet names
    'rngDestination.CopyFromRecordset  '<--- no parameter to select columns

    Stop  '* this is here so you can browse the Locals Window
    
End Function



Function CreateTestRecordset_NothingToSeeHere() As ADODB.Recordset

    '* Nothing to see here!  This is just some code to create a recordset out of thin air.
    '* Because not everybody has a database lying around to which they can make queries.
    '* The real lesson of this post is above in the GetRows method call
    
    Dim rstADO As ADODB.Recordset
    Dim fld As ADODB.Field
    '* Nothing to see here!
    Set rstADO = New ADODB.Recordset
    With rstADO
        '* Nothing to see here!
        .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, 6)
        
    End With

    Set CreateTestRecordset_NothingToSeeHere = rstADO
    '* Nothing to see here!
End Function

How to create a GUID in Visual Studio (and VBA)

I've just reading some comments on other posts. In this post I'll quickly show where the GUID generator is in Visual Studio...

From the Visual Studio's main menu take the Tools menu and midway down that list is Create GUID...

Clicking on 'Create GUID' menu item take you to this dialog box. Press Copy to copy to clipboard, you can select the format using the radio button on the left.

If you want some VBA code to generate the GUID then I found this on StackOverflow

Option Explicit

'* With thanks to StackOverflow
'* https://stackoverflow.com/questions/7031347/how-can-i-generate-guids-in-excel#answer-48434899
'* and specifically user https://stackoverflow.com/users/3056160/rchacko

Declare Function CoCreateGuid Lib "ole32" (ByRef GUID As Byte) As Long
Public Function GenerateGUID() As String
    Dim ID(0 To 15) As Byte
    Dim N As Long
    Dim GUID As String
    Dim Res As Long
    Res = CoCreateGuid(ID(0))

    For N = 0 To 15
        GUID = GUID & IIf(ID(N) < 16, "0", "") & Hex$(ID(N))
        If Len(GUID) = 8 Or Len(GUID) = 13 Or Len(GUID) = 18 Or Len(GUID) = 23 Then
            GUID = GUID & "-"
        End If
    Next N
    GenerateGUID = GUID
End Function

Video - Parsing an Mpeg file with VBA (Redux)

In this post I read an Mpeg (.MP4) file and write the results to an Xml file using VBA (and a little help from Python).

So this is a rewrite, previously I wrote this program and used user defined types to record the state but I was unhappy with this because I would have needed to write a load of gui code. In this rewrite I record the results to an Xml document and then let some xml pretty printing code place each element of a separate line nicely tabbed, I delivered this code in the previous blog post.

I don't have much to add, either you have a requirement to inspect mp4 files or you don't. There is little point me explaining mp4 files to those uninterested and uninitiated.

Please don't take this code and place in github and has happened with previous code. If in github then I don't get any traffic; if github changes policy on this then I will then use it. I also intend to use Github for upcoming work where I deliberately want to collaborate and enlist the help of others to achieve a task I have in mind. Please respect the intellectual property rights of this blog, thanks.

Source Modules

Firstly, the Python module which I needed for long numbers, this is to be called PythonBigNumbersComServer.py and needs to be run from the command line so that the COM class is registered (this needs administrator rights, so expect an elevation request if not running as adminstrator).

PythonBigNumbersComServer.py

import pythoncom

class PythonBigNumbersComServer:
    _reg_progid_ = "PythonInVBA.PythonBigNumbersComServer"
    _reg_clsid_ = "{5AD66FCC-EFFC-4A78-B5B6-9A42C523272E}"  
    _public_methods_ = ['LongByteArrayToDecimalString']    

    def LongByteArrayToDecimalString(self, bytes):
        ret = 0 
        for byte in bytes:
            print(byte)
            ret = ret * 256 + byte
        return str(ret) 

if __name__ == '__main__':
    import win32com.server.register

    win32com.server.register.UseCommandLine(PythonBigNumbersComServer)
    
    
    try:
        import win32com.client
        bigNumbers = win32com.client.Dispatch("PythonInVBA.PythonBigNumbersComServer")
        #bigNumbers = PythonBigNumbersComServer()
        x = bytes('01', 'utf8')
        print(x)

        asDecimal = bigNumbers.LongByteArrayToDecimalString(x)
        print('asDecimal:' +  asDecimal)

    except Exception as e:
        print("Error : " + str(e) + "\n")

Next is the modXmlReports module given in the previous blog post.

Okay from here on all the code is VBA. So next is the DefinedSymbols class

DefinedSymbols Class

Option Explicit

'**********************************************************************************************************
'* Class Name: DefinedSymbols
'* Copyright exceldevelopmentplatform.blogspot.com 2nd November 2019
'*
'* Requires Tools Reference
'*  Microsoft Scripting Runtime
'*
'* Description:
'*  This class collaborates with modVLCSourceProcessor to read VLC Media Player C++ source file on github and
'*  scrapes four character codes identifiers found in mp4 files, such as moov, trak, trhd etc.
'*  The class then stores the results and services requests for atom identification whilst parsing an mp4 file
'*
'* Notes:
'*  we have to categorise the identifiers into Brand, Atom, Handler and SampleGroup because otherwise we will
'*  get duplicates, this is why we have a nested dictionary to store the data.  The main code is only interested
'*  in atoms, however.
'*
'*  Also, for each category, we maintain a map each way, i.e. two maps, because the four character codes can
'*  contain special characters which are not valid in C++ source code identifiers.
'*  This is a pain, but it is handled.
'*
'*  To hide this complex state housing I invented this class
'*
'**********************************************************************************************************

Private mdicMaps As New Scripting.Dictionary


'*********************************************************************************************************
'* Name:        AddMapEntry
'* Description: Abstracts the storage of categorise defined symbols maps.  This for loading
'*              the store of information.
'*********************************************************************************************************

Public Function AddMapEntry(ByVal sMap As String, ByVal sKey As String, ByVal sValue As String, ByVal sSourceLine As String) As Variant

    Dim vMaps As Variant
    vMaps = GetCategoryMap(sMap)
    Debug.Assert IsArray(vMaps)
    
    Dim dicMap As Scripting.Dictionary
    Set dicMap = vMaps(0)
    
    Dim dicMapReverse As Scripting.Dictionary
    Set dicMapReverse = vMaps(1)

    If Not dicMap.Exists(sKey) Then
        dicMap.Add sKey, sValue
    
        If Not dicMapReverse.Exists(sValue) Then
            dicMapReverse.Add sValue, sKey
        Else
            Debug.Print "duplicate item in line:" & sSourceLine
        End If
    
    Else
        If dicMap.Item(sKey) <> sValue Then
            Debug.Print "Symbol " & sKey & " defined twice to two different values (" & dicMap.Item(sKey) & "," & sValue & "):" & sSourceLine
        End If
    End If

End Function


'*********************************************************************************************************
'* Name:        LookupMapEntry
'* Description: Abstracts the storage of parent-child relationships in nested dictionaries.  This for loading
'*              the store of information.
'*********************************************************************************************************

Public Function LookupMapEntry(ByVal sMap As String, ByVal sKey As String, ByVal bReverse As Boolean) As Variant
    Dim vMaps As Variant
    vMaps = GetCategoryMap(sMap)
    Debug.Assert IsArray(vMaps)

    If bReverse Then
        Dim dicMap As Scripting.Dictionary
        Set dicMap = vMaps(1)
    Else
        Set dicMap = vMaps(0)
    End If
    
    
    If dicMap.Exists(sKey) Then
        LookupMapEntry = dicMap.Item(sKey)
    End If
    

End Function


Private Function GetCategoryMap(ByVal sMap As String)
    Dim dicMap As Scripting.Dictionary
    Dim dicMapReverse As Scripting.Dictionary
    Dim vMaps As Variant
    If Not mdicMaps.Exists(sMap) Then
        Set dicMap = New Scripting.Dictionary
        dicMap.CompareMode = BinaryCompare
        
        Set dicMapReverse = New Scripting.Dictionary
        dicMapReverse.CompareMode = BinaryCompare
        
        vMaps = Array(dicMap, dicMapReverse)
        
        mdicMaps.Add sMap, vMaps
        
    Else
        vMaps = mdicMaps.Item(sMap)
    End If
    GetCategoryMap = vMaps
End Function

Private Sub Class_Initialize()
    mdicMaps.CompareMode = BinaryCompare
End Sub

Next is the BoxFunctionTable class

BoxFunctionTable class

Option Explicit

'**********************************************************************************************************
'* Class Name: BoxFunctionTable
'* Copyright exceldevelopmentplatform.blogspot.com 2nd November 2019
'*
'* Requires Tools Reference
'*  Microsoft Scripting Runtime
'*
'* Description:
'*  This class collaborates with modVLCSourceProcessor to read VLC Media Player C++ source file on github and
'*  scrapes parent-child relationships between atoms defined in the box function block of code
'*  The class then stores the results and services requests for possible children atoms for a given parent
'*
'*  To hide this complex state housing I invented this class
'*
'**********************************************************************************************************

Private mdicChildrenOfParents As New Scripting.Dictionary

'*********************************************************************************************************
'* Name:        RecordAParentsPotentialChild
'* Description: Abstracts the storage of parent-child relationships in nested dictionaries.  This for loading
'*              the store of information.
'*********************************************************************************************************
Friend Function RecordAParentsPotentialChild(ByVal sParentAtom As String, ByVal sChildAtom As String)
    
    Dim dicChildrenOfAParent As Scripting.Dictionary
    If Not mdicChildrenOfParents.Exists(sParentAtom) Then
        Set dicChildrenOfAParent = New Scripting.Dictionary
        mdicChildrenOfParents.Add sParentAtom, dicChildrenOfAParent
    Else
        Set dicChildrenOfAParent = mdicChildrenOfParents.Item(sParentAtom)
    End If
    
    Debug.Assert Not dicChildrenOfAParent.Exists(sChildAtom)
    dicChildrenOfAParent.Add sChildAtom, Empty

End Function

'*********************************************************************************************************
'* Name:        RecordAParentsPotentialChild
'* Description: For a given parent atom will return a list (ass Dictionary) of potential child atoms.
'*              This for reading the store of information.
'*********************************************************************************************************
Public Function ChildrenOfAParentAsADictionary(ByVal sParentAtom As String) As Scripting.Dictionary
    'Debug.Assert mdicChildrenOfParents.Exists(sParentAtom)
    If mdicChildrenOfParents.Exists(sParentAtom) Then
        Set ChildrenOfAParentAsADictionary = mdicChildrenOfParents.Item(sParentAtom)
    Else
        Set ChildrenOfAParentAsADictionary = New Scripting.Dictionary
    End If
End Function

'*********************************************************************************************************
'* Name:        AddBoxFunction
'* Description: A wrapper to RecordAParentsPotentialChild; this is called whilst reading
'*              the VLC C++ source code
'*********************************************************************************************************
Public Function AddBoxFunction(ByVal sAtom As String, ByVal sFunctionName As String, _
        ByVal sParentAtom As String, ByVal sSrcLine As String) As Variant
    
    Dim sAtom2 As String, sParentAtom2 As String
    sAtom2 = AtomFourCC(sAtom)
    sParentAtom2 = AtomFourCC(sParentAtom)
    
    Call RecordAParentsPotentialChild(sParentAtom2, sAtom2)

End Function

Private Function AtomFourCC(ByVal sAtom As String) As String
    '* this strips the identifier of leading prefixes to give
    '* the core four character identifier
    If sAtom = "0" Then
        AtomFourCC = ""
    Else
        Debug.Assert Left$(sAtom, 5) = "ATOM_"
        AtomFourCC = Mid$(sAtom, 6)
    End If
End Function

That is the classes done. So now three more modules. Next is the modVLCSourceProcessor module

modVLCSourceProcessor module

Option Explicit
Option Private Module

'***********************************************************************************
'* Module Name: modVLCSourceProcessor
'* Copyright exceldevelopmentplatform.blogspot.com 2nd November 2019
'*
'* Other class and module dependencies:
'*  BoxFunctionTable, DefinedSymbols
'*
'* Description:
'*  This modules reads the VLC Media Player C++ sources file on github and scrapes
'*  (1) four character codes identifiers found in mp4 files, such as moov, trak, trhd etc.
'*  (2) parent-child relationships between atoms defined in the box function block of code
'*
'* Other comments:
'*  Ordinarily requires internet access to call out to github, to get the files
'*  (a) modules\demux\libmp4.h  and
'*  (b) modules\demux\libmp4.c
'*  however it is possible to work with a local copies
'*  copy in libmp4.h and libmp4.c into a module in this workbook called srcLibMp_h and srcLibMp_c
'*  please comment it out the code (it is C++ and so will not compile obvs)
'*  then add a conditional compilation constant VLCLOCAL=1
'***********************************************************************************

'*********************************************************************************************************
'* Name:        ReadVLCSource
'* Description: This module's sole entry point.  Call here to read the VLC media player source files from github.
'*              Plus we added some extra parent-child realtionships not found in VLC media player source.
'*
'* Returns    : an instance of BoxFunctionTable class which can service requests regarding parent-child
'*              relationships and an instance of DefinedSymbols class which can service requests regarding symbols
'*********************************************************************************************************

Public Function ReadVLCSource(ByRef poDefinedSymbols As DefinedSymbols, _
                ByRef poBoxFunctionTable As BoxFunctionTable)

    Dim vaLibMpSrcs
    vaLibMpSrcs = GetVLCSourceCode()

    If poDefinedSymbols Is Nothing Then
        Set poDefinedSymbols = ReadDefinedSymbols(vaLibMpSrcs(0))
    End If

    If poBoxFunctionTable Is Nothing Then
        Set poBoxFunctionTable = ReadBoxFunctionTable(vaLibMpSrcs(1))
        
        '* manually add some not found in vlc source
        Call poBoxFunctionTable.RecordAParentsPotentialChild("dinf", "dref")
        Call poBoxFunctionTable.RecordAParentsPotentialChild("dinf", "urn ")
        Call poBoxFunctionTable.RecordAParentsPotentialChild("dinf", "url ")
        'Stop
    End If
    

End Function

'************************************************************
'* test routine
'************************************************************
Private Sub TestReadBoxFunctionTable()
    Dim vaLibMpSrcs
    vaLibMpSrcs = GetVLCSourceCode()

    Dim oBoxFunctionTable As BoxFunctionTable
    Set oBoxFunctionTable = ReadBoxFunctionTable(vaLibMpSrcs(1))
    
    Debug.Print "Potential children of moov are:" & Join(oBoxFunctionTable.ChildrenOfAParentAsADictionary("moov").Keys)
    Debug.Print "Potential children of trak are:" & Join(oBoxFunctionTable.ChildrenOfAParentAsADictionary("trak").Keys)
    Debug.Print "Potential children of mdia are:" & Join(oBoxFunctionTable.ChildrenOfAParentAsADictionary("mdia").Keys)
    Debug.Print "Potential children of minf are:" & Join(oBoxFunctionTable.ChildrenOfAParentAsADictionary("minf").Keys)
    Debug.Print "Potential children of stbl are:" & Join(oBoxFunctionTable.ChildrenOfAParentAsADictionary("stbl").Keys)
    
    Stop
End Sub

'*********************************************************************************************************
'* Name:        ReadBoxFunctionTable
'* Description: Given the source code lines from lipmp4.c this code will look for lines of code such as
'*
'*              (a) { ATOM_minf,    MP4_ReadBoxContainer,     ATOM_mdia },
'*              (b) { ATOM_stbl,    MP4_ReadBoxContainer,     ATOM_minf },
'*
'*              where it will parse out (a) 'minf' and 'mdia' and (b) 'stbl' and 'minf'
'*              the atom on the left is a potential child of the atom on the right
'*
'* Returns    : an instance of BoxFunctionTable class which can service requests regarding parent-child
'*              relationships
'*********************************************************************************************************

Private Function ReadBoxFunctionTable(vCFileLines As Variant) As BoxFunctionTable
    Debug.Assert IsArray(vCFileLines)

    Dim oBoxFunctionTable As BoxFunctionTable
    Set oBoxFunctionTable = New BoxFunctionTable
    
    

    Dim bInBoxFunctionTable As Boolean: bInBoxFunctionTable = False


    '\{ (ATOM_\w*), *(MP4_ReadBox\w*), * (0|ATOM_\w*) *\}, * *.*
    Dim regexBoxFunction As Object 'VBScript_RegExp_55.RegExp
    Set regexBoxFunction = VBA.CreateObject("VBScript.RegExp")
    regexBoxFunction.IgnoreCase = True
    regexBoxFunction.Global = True
    regexBoxFunction.Pattern = "\{ (0|ATOM_\w*) *, *(MP4_ReadBox\w*), * (0|ATOM_\w*) *\}, * *.*"

    Dim lLineLoop As Long
    
    For lLineLoop = LBound(vCFileLines) To UBound(vCFileLines)
        Dim vLineLoop As Variant
        vLineLoop = vCFileLines(lLineLoop)
        
        If Trim(vCFileLines(lLineLoop)) = "/* Containers */" Then
            If Trim(vCFileLines(lLineLoop - 1)) = "{" _
            And Trim(vCFileLines(lLineLoop - 2)) = "} MP4_Box_Function [] =" Then bInBoxFunctionTable = True
        End If
        
        If InStr(1, vLineLoop, "{ 0,              MP4_ReadBox_default,   0 }", vbBinaryCompare) > 0 Then bInBoxFunctionTable = False
            
        If bInBoxFunctionTable Then
            Dim sTrimmed As String
            sTrimmed = Trim(vLineLoop)
            If Not (Left$(sTrimmed, 2) = "/*" And Right$(sTrimmed, 2) = "*/") And Len(sTrimmed) > 0 And sTrimmed <> "{" And sTrimmed <> "/*" Then
                Debug.Assert InStr(1, sTrimmed, "MP4_ReadBox", vbTextCompare) > 0
                If regexBoxFunction.Test(sTrimmed) Then
                    
                    Dim matchCol As Object 'VBScript_RegExp_55.MatchCollection
                    Set matchCol = regexBoxFunction.Execute(sTrimmed)
                    
                    Dim match As Object 'VBScript_RegExp_55.match
                    Set match = matchCol.Item(0)
                    Debug.Assert match.SubMatches.count = 3
                    
                    oBoxFunctionTable.AddBoxFunction match.SubMatches.Item(0), match.SubMatches.Item(1), _
                                match.SubMatches.Item(2), sTrimmed

                Else
                    Debug.Print "failed to parse:" & sTrimmed
                End If
            End If
        End If
    Next

    Set ReadBoxFunctionTable = oBoxFunctionTable
End Function

'************************************************************
'* test routine
'************************************************************
Private Sub TestReadDefinedSymbols()
    Dim vaLibMpSrcs
    vaLibMpSrcs = GetVLCSourceCode()

    Dim oDefinedSymbols As DefinedSymbols
    Set oDefinedSymbols = ReadDefinedSymbols(vaLibMpSrcs(0))
    
    Debug.Assert oDefinedSymbols.LookupMapEntry("BRAND", "smoo", False) = "smoo"
    Debug.Assert oDefinedSymbols.LookupMapEntry("BRAND", "smoo", True) = "smoo"
    
    Debug.Assert oDefinedSymbols.LookupMapEntry("ATOM", "url", False) = "url "
    Debug.Assert oDefinedSymbols.LookupMapEntry("ATOM", "url ", True) = "url"
    
    Debug.Assert oDefinedSymbols.LookupMapEntry("ATOM", "ms55", False) = "ms" & Chr$(0) & "U"
    Debug.Assert oDefinedSymbols.LookupMapEntry("ATOM", "ms" & Chr$(0) & "U", True) = "ms55"
        
    Stop
End Sub
    

'*********************************************************************************************************
'* Name:        ReadDefinedSymbols
'* Description: Given the source code lines from lipmp4.h this code will look for lines of code such as
'*
'*              (a) #define ATOM_ipma VLC_FOURCC('i','p','m','a')
'*              (b) #define ATOM_0x40PRM VLC_FOURCC( '@', 'P', 'R', 'M' )
'*
'*              where it will parse out (a) 'ipma' and 'ipma' and (b) '0x40PRM' and '@PRM'
'*              most of the time but not always the source identifier is identical to the four character code
'*
'* Returns    : an instance of DefinedSymbols class which can service requests regarding symbols
'*********************************************************************************************************

Private Function ReadDefinedSymbols(vHeaderLines As Variant) As DefinedSymbols
    Debug.Assert IsArray(vHeaderLines)

    Dim oDefinedSymbols As DefinedSymbols
    Set oDefinedSymbols = New DefinedSymbols
    
    Dim regexFourCC As Object 'VBScript_RegExp_55.RegExp
    Set regexFourCC = VBA.CreateObject("VBScript.RegExp")
    regexFourCC.IgnoreCase = True
    regexFourCC.Global = True
    regexFourCC.Pattern = "#define *(.*)_(.*) *VLC_FOURCC\( *('.'|0x\w{1,2}) *, *('.'|0x\w{1,2}) *, *('.'|0x\w{1,2}) *, *('.'|0x\w{1,2}) *\) *.*"
    'Stop
    Dim vLineLoop As Variant
    For Each vLineLoop In vHeaderLines
        If InStr(1, vLineLoop, "VLC_FOURCC", vbBinaryCompare) > 0 Then
            If regexFourCC.Test(vLineLoop) Then
                Dim matchCol As Object 'VBScript_RegExp_55.MatchCollection
                Set matchCol = regexFourCC.Execute(vLineLoop)
                
                Dim match As Object 'VBScript_RegExp_55.match
                Set match = matchCol.Item(0)
                Debug.Assert match.SubMatches.count = 6
                
                Dim sSymbolCat As String
                sSymbolCat = Trim(match.SubMatches.Item(0))
                
                Dim sSymbolKey As String
                sSymbolKey = Trim(match.SubMatches.Item(1))
                
                Dim sSymbolValue As String: sSymbolValue = ""
                Dim lCharLoop As Long
                For lCharLoop = 2 To 5
                    Dim sSubMatch As String
                    sSubMatch = Trim(match.SubMatches.Item(lCharLoop))
                    
                    Dim sChar As String
                    If InStr(1, sSubMatch, "'", vbBinaryCompare) > 0 Then
                        sChar = VBA.Replace(sSubMatch, "'", "")
                    Else
                        sSubMatch = "&h" & Mid$(sSubMatch, 3)
                        Dim lChar As Long
                        lChar = Val(sSubMatch)
                        sChar = Chr$(lChar)
                    End If
                    sSymbolValue = sSymbolValue & sChar
                Next
            Else
                Debug.Print "Regular expression failed to parse line:" & vLineLoop
            End If
            oDefinedSymbols.AddMapEntry sSymbolCat, sSymbolKey, sSymbolValue, vLineLoop
        End If
    Next
    Set ReadDefinedSymbols = oDefinedSymbols
End Function

'************************************************************
'* test routine
'************************************************************
Private Sub TestGetVLCSourceCode()
    Dim vaLibMpSrcs
    vaLibMpSrcs = GetVLCSourceCode()
    Stop

End Sub

'*********************************************************************************************************
'* Name:        GetVLCSourceCode
'* Description: Will acquire code from either GitHub or a local copy in a module in this workbook
'* Returns    : A variant array of strings, each element is a line
'*********************************************************************************************************

Private Function GetVLCSourceCode()
    #If VLCLOCAL = 1 Then
        GetVLCSourceCode = GetVLCSourceCodeInner(True)
    #Else
        GetVLCSourceCode = GetVLCSourceCodeInner(False)
    #End If
End Function

'*********************************************************************************************************
'* Name:        GetVLCSourceCodeInner
'* Description: Will acquire code from either GitHub or a local copy in a module in this workbook
'* Returns    : A variant array of strings, each element is a line
'*********************************************************************************************************

Private Function GetVLCSourceCodeInner(ByVal bLocalCopy As Boolean)

    Dim vSources(0 To 1) As Variant
    
    Dim vSrcSuffixes As Variant
    vSrcSuffixes = Array("h", "c")

    Dim lFileLoop As Long
    
    If bLocalCopy Then
        '* this code is switched on with a conditional constant
        '* I have copied into my workbook a copy of the source files
        
        For lFileLoop = 0 To 1
            Dim objLibMpSrcVBComp As Object
            Set objLibMpSrcVBComp = GetVBComponentOERN("srcLibMp_" & vSrcSuffixes(lFileLoop))
        
            Dim dicSrc As Object
            Set dicSrc = VBA.CreateObject("Scripting.Dictionary")
            
            Dim lLineLoop As Long
            For lLineLoop = 1 To objLibMpSrcVBComp.CountOfLines
                Dim sLine As String
                sLine = objLibMpSrcVBComp.Lines(lLineLoop, 1)
                dicSrc.Add dicSrc.count, Mid(sLine, 2)
            
            Next lLineLoop
            vSources(lFileLoop) = dicSrc.Items
        Next lFileLoop
        
    Else
        Dim oXHR As MSXML2.XMLHTTP60
        
        For lFileLoop = 0 To 1
        
            Set oXHR = New MSXML2.XMLHTTP60
            oXHR.Open "GET", "https://raw.githubusercontent.com/videolan/vlc/master/modules/demux/mp4/libmp4." & vSrcSuffixes(lFileLoop), False
            oXHR.send
            
            vSources(lFileLoop) = VBA.Split(oXHR.responseText, Chr$(10))
    
        Next lFileLoop
    
    End If

    GetVLCSourceCodeInner = vSources

End Function

Private Function GetVBComponentOERN(ByVal sName As String) As Object
    '* kills errors
    On Error Resume Next
    Set GetVBComponentOERN = ThisWorkbook.VBProject.VBComponents.Item(sName).CodeModule
End Function

So now all the helper classes and modules are in place. Next the main module, the modMpegToXml module.

modMpegToXml module

Option Explicit

'**********************************************************************************************************
'* Module Name: modMpegToXml
'* Copyright exceldevelopmentplatform.blogspot.com 2nd November 2019
'*
'* Requires Tools Reference
'*  Microsoft Scripting Runtime
'*  Microsoft XML, v6.0
'*
'* Other class and module dependencies:
'*  modMyFiles, modLVCSourceProcessor, modXmlReports, BoxFunctionTable, DefinedSymbols
'*
'* Python dependency:
'*  sadly VBA cannot handle numbers bigger than 32-bit arithmetically so I had to enlist a Python COM class
'*  to help convert large numbers to a string, that Python code is in file PythonBigNumbersComServer.py
'*  and will need running from command line to register the COM class
'*
'* Description:
'*  This is main module that orchestrates logic from the other classes and modules.  It reads an mp4 file
'*  recursively parsing the atom structure replicating the nested structure in a more readable xml file.
'*
'*  I wrote this because I was unhappy with existing mp4 file examiners which did not handle
'*  fragmented mp4 files or dash files.  But I did not want to write a GUI so I wrote to an xml file instead.
'*
'**********************************************************************************************************


Private fso As New Scripting.FileSystemObject

Private mbytes() As Byte
Private mlByteCount As Long

Private moDefinedSymbols As DefinedSymbols
Private moBoxFunctionTable As BoxFunctionTable
Private mxmlMpeg As MSXML2.DOMDocument60
Private mxmlCurrentNode As MSXML2.IXMLDOMElement

Private mlAtomCount As Long

Private mlOmissionThreshold As Long '* 0 means show none, positive integers n means show the first n

Private Enum MP4_TRUN_FLAGS
    MP4_TRUN_DATA_OFFSET = 1            '(1<<0)
    MP4_TRUN_FIRST_FLAGS = 4            '(1<<2)
    MP4_TRUN_SAMPLE_DURATION = 256      '(1<<8)
    MP4_TRUN_SAMPLE_SIZE = 512          '(1<<9)
    MP4_TRUN_SAMPLE_FLAGS = 1024        '(1<<10)
    MP4_TRUN_SAMPLE_TIME_OFFSET = 2048  '(1<<11)
End Enum



'*********************************************************************************************************
'* Name:        BatchXmlReportOnMpegFile
'* Description: Top level entry point which allows batch of mp4 files (mpeg file) and reports on each.
'*              Pass in a dictionary of files.  One can also specify a working folder (it will use temp if blank)
'*********************************************************************************************************
Public Sub BatchXmlReportOnMpegFile(ByVal dicMepgFiles As Scripting.Dictionary, ByVal bCancelColoring As Boolean, ByVal sWorkFolder As String)
    
    RemoveReports
    
    Dim sMepgFile
    For Each sMepgFile In dicMepgFiles.Keys
        DoEvents
        XmlReportOnMpegFile sMepgFile, bCancelColoring, sWorkFolder
    Next
    
End Sub

'*********************************************************************************************************
'* test routine
'*********************************************************************************************************
Private Sub TestBatchXmlReportOnMpegFile()

    Dim dicMepgFiles As Scripting.Dictionary
    Set dicMepgFiles = modMyFiles.MyMepgFiles() '* I have defined mine in a separate module, modMyFiles

    BatchXmlReportOnMpegFile dicMepgFiles, False, ""
    'End
End Sub


'*********************************************************************************************************
'* Name:        XmlReportOnMpegFile
'* Description: Top level entry point which examines an mp4 file (mpeg file) and reports the nested atom
'*              structure into a nested xml report.  Then it writes the xml report to a worksheet by calling
'*              modXmlReports.PrettyReportXml.
'*              One can also specify a working folder (it will use temp if blank)
'*********************************************************************************************************
Public Sub XmlReportOnMpegFile(ByVal sMepgFile As String, ByVal bCancelColoring As Boolean, ByVal sWorkFolder As String)

    Application.StatusBar = False
    mlOmissionThreshold = 5

    '* need symbols and parent-child atom relationships information
    Call modVLCSourceProcessor.ReadVLCSource(moDefinedSymbols, moBoxFunctionTable)

    Debug.Assert fso.FileExists(sMepgFile)

    Set mxmlMpeg = New MSXML2.DOMDocument60
    Debug.Assert mxmlMpeg.LoadXML(Chr$(60) & "mpeg/>")
    Set mxmlCurrentNode = mxmlMpeg.DocumentElement

    
    mlAtomCount = 0

    mbytes() = ReadByteFile(sMepgFile)
    
    mlByteCount = UBound(mbytes) - LBound(mbytes) + 1
    
    mxmlCurrentNode.setAttribute "size", mlByteCount
    
    ReadAtom "", 0, mlByteCount - 1, 0
    
    Dim sXmlReportFile As String
    sXmlReportFile = XmlReportFileName(sMepgFile)
    mxmlMpeg.Save sXmlReportFile
    
    modXmlReports.PrettyReportXml ThisWorkbook, sXmlReportFile, bCancelColoring, sWorkFolder
    

    
End Sub

'*********************************************************************************************************
'* Name:        XmlReportFileName
'* Description: returns name of a wotrking file to which will write the xml
'*********************************************************************************************************
Private Function XmlReportFileName(ByVal sMepgFile As String) As String
    '* we want to work with our file which we will place in same directory as ThisWorkbook
    Dim filMpeg As Scripting.File
    Set filMpeg = fso.GetFile(sMepgFile)

    XmlReportFileName = fso.BuildPath(TempFolder, filMpeg.name & ".xml")
End Function

'*********************************************************************************************************
'* Name:        TempFolder
'* Description: create and locate a folder within the system's temporary folder
'*********************************************************************************************************
Private Function TempFolder() As String
    Dim fso As Scripting.FileSystemObject
    Set fso = New Scripting.FileSystemObject
    
    Const TemporaryFolder As Long = 2
    TempFolder = fso.GetSpecialFolder(TemporaryFolder)
    
    If Not fso.FolderExists(fso.BuildPath(TempFolder, "modMpegToXml")) Then
    
        Dim fldTemp As Scripting.Folder
        Set fldTemp = fso.GetFolder(TempFolder)
        fldTemp.SubFolders.Add "modMpegToXml"
    
        Debug.Assert fso.FolderExists(fso.BuildPath(TempFolder, "modMpegToXml"))
    End If
    TempFolder = fso.BuildPath(TempFolder, "modMpegToXml")
    
    Set fso = Nothing
    
End Function

'Private Function ThisWorkbookHomeFolder() As String
'    'Debug.Assert ThisWorkbook.Saved = True
'    ThisWorkbookHomeFolder = fso.GetFile(ThisWorkbook.FullName).ParentFolder.ShortPath
'
'    '* alternative
'    'Dim vSplit
'    'vSplit = VBA.Split(ThisWorkbook.FullName, "\")
'    'ReDim Preserve vSplit(0 To UBound(vSplit) - 1)
'    'ThisWorkbookHomeFolder = VBA.Join(vSplit, "\")
'End Function


'*********************************************************************************************************
'* Name:        ReadAtom
'* Description: Recursive routine at the heart of the parsing logic.
'*
'*              (1) Establishes list of potential child atoms for a given parent atom.
'*              (2) Calls FindAtomAtPosition2() to find a child atom
'*              (3) For each atom it finds it will (a) create an Xml element in the report, (b) establish its size,
'*                  (c) for full atoms read version and flags (d) adorn with any atom specific attributes ,
'*                  (e) adorn description and (f) if it can have children then recursively call into ReadAtom()
'*                  to look for those child atoms
'*              (4) Then look for another atom at this level, i.e. a sibling atom
'*              (5) if no more atoms found then quit routine return to caller
'*
'*
'*********************************************************************************************************
Private Sub ReadAtom(ByVal sParent As String, ByVal lPosition As Long, ByVal lEndOfParent As Long, ByVal lRecursionLevel As Long)
    Dim dicChildrenOfAParent As Scripting.Dictionary
    Set dicChildrenOfAParent = moBoxFunctionTable.ChildrenOfAParentAsADictionary(sParent)
    
    If dicChildrenOfAParent.count = 0 Then Exit Sub
    
    Dim lSize As Long
    
    Do
        DoEvents
        Dim sAtom As String: sAtom = ""
        Dim lAtomFoundAt As Long
        lAtomFoundAt = FindAtomAtPosition2(lPosition, lEndOfParent, dicChildrenOfAParent, sAtom)
        If lAtomFoundAt < 0 Then
            '* something went wrong, we have to abandon this branch
            GoTo SingleExit
        End If
        lSize = FourBytesToLong(lAtomFoundAt - 4)
        
        If lSize = 0 Then
            '* something went wrong, we have to abandon this branch
            GoTo SingleExit
        End If
        Dim lNextAtomAt As Long
        lNextAtomAt = lAtomFoundAt - 4 + lSize
        Debug.Print "Found atom '" & sAtom & "' at position " & lAtomFoundAt - 4 & " of size " & lSize & " which thus spans to " & lPosition + lSize & " (&h" & VBA.Hex$(lPosition + lSize) & ")"
        
        Dim xmlAtom As MSXML2.IXMLDOMElement
        Set xmlAtom = mxmlMpeg.createElement(sAtom)
        xmlAtom.setAttribute "size", lSize
        
        Dim lVersion As Long: lVersion = 0
        Dim lFlags As Long: lFlags = 0
        
        If FullBoxAtoms.Exists(sAtom) Then
            
            Dim idx As Long
            idx = lPosition + 8
            
            lVersion = BytesToLong(mbytes, 1, idx)
            
            lFlags = BytesToLong(mbytes, 3, idx)
            
            Call xmlAtom.setAttribute("version", lVersion)
            Call xmlAtom.setAttribute("flags", FlagsToString(sAtom, lFlags))
            
        End If
        
        AtomAttributes sAtom, xmlAtom, lPosition, lSize, lVersion, lFlags
        
        If AtomDescriptions().Exists(sAtom) Then xmlAtom.setAttribute "desc", AtomDescriptions().Item(sAtom)
        
        mxmlCurrentNode.appendChild xmlAtom
        mlAtomCount = mlAtomCount + 1
        
        If moBoxFunctionTable.ChildrenOfAParentAsADictionary(sAtom).count > 0 Then
            Set mxmlCurrentNode = xmlAtom
            ReadAtom sAtom, lAtomFoundAt + 4, lNextAtomAt - 1, lRecursionLevel + 1
        
        End If
        
        lPosition = lNextAtomAt
    
    Loop Until lPosition >= lEndOfParent

SingleExit:
    If mxmlCurrentNode.nodeName <> "mpeg" Then
        Set mxmlCurrentNode = mxmlCurrentNode.ParentNode
    End If

End Sub

'*********************************************************************************************************
'* Name:        AtomDescriptions
'* Description: associates four letter character codes with descriptions
'*********************************************************************************************************
Private Function AtomDescriptions() As Scripting.Dictionary
    Static dic As Scripting.Dictionary
    Static dicAmbiguous As Scripting.Dictionary
    If dicAmbiguous Is Nothing Then
        Set dicAmbiguous = New Scripting.Dictionary
        dicAmbiguous.Add "hnti", "trackhintinformation"
        'dicAmbiguous.Add "hnti", "moviehintinformation"
        
    End If
    
    If dic Is Nothing Then
        Set dic = New Scripting.Dictionary
        
        dic.Add "ftyp", "FileTypeBox"
        dic.Add "moov", "MovieBox"
        dic.Add "mdat", "MediaDataBox"
        dic.Add "mvhd", "MovieHeaderBox"
        dic.Add "trak", "TrackBox"
        dic.Add "tkhd", "TrackHeaderBox"
        dic.Add "tref", "TrackReferenceBox"
        dic.Add "mdia", "MediaBox"
        dic.Add "mdhd", "MediaHeaderBox"
        dic.Add "hdlr", "HandlerBox"
        dic.Add "minf", "MediaInformationBox"
        dic.Add "vmhd", "VideoMediaHeaderBox"
        dic.Add "smhd", "SoundMediaHeaderBox"
        dic.Add "hmhd", "HintMediaHeaderBox"
        dic.Add "nmhd", "NullMediaHeaderBox"
        dic.Add "dinf", "DataInformationBox"
        dic.Add "url ", "DataEntryUrlBox"
        dic.Add "urn ", "DataEntryUrnBox"
        dic.Add "dref", "DataReferenceBox"
        dic.Add "stbl", "SampleTableBox"
        dic.Add "stts", "TimeToSampleBox"
        dic.Add "ctts", "CompositionOffsetBox"
        dic.Add "stsd", "SampleDescriptionBox"
        dic.Add "stsz", "SampleSizeBox"
        dic.Add "stz2", "CompactSampleSizeBox"
        dic.Add "stsc", "SampleToChunkBox"
        dic.Add "stco", "ChunkOffsetBox"
        dic.Add "co64", "ChunkLargeOffsetBox"
        dic.Add "stss", "SyncSampleBox"
        dic.Add "stsh", "ShadowSyncSampleBox"
        dic.Add "stdp", "DegradationPriorityBox"
        dic.Add "padb", "PaddingBitsBox"
        dic.Add "free", "FreeSpaceBox"
        dic.Add "skip", "FreeSpaceBox"
        dic.Add "edts", "EditBox"
        dic.Add "elst", "EditListBox"
        dic.Add "udta", "UserDataBox"
        dic.Add "cprt", "CopyrightBox"
        dic.Add "mvex", "MovieExtendsBox"
        dic.Add "mehd", "MovieExtendsHeaderBox"
        dic.Add "trex", "TrackExtendsBox"
        dic.Add "moof", "MovieFragmentBox"
        dic.Add "mfhd", "MovieFragmentHeaderBox"
        dic.Add "traf", "TrackFragmentBox"
        dic.Add "tfhd", "TrackFragmentHeaderBox"
        dic.Add "trun", "TrackRunBox"
        dic.Add "mfra", "MovieFragmentRandomAccessBox"
        dic.Add "tfra", "TrackFragmentRandomAccessBox"
        dic.Add "mfro", "MovieFragmentRandomAccessOffsetBox"
        dic.Add "sdtp", "SampleDependencyTypeBox"
        dic.Add "sbgp", "SampleToGroupBox"
        dic.Add "sgpd", "SampleGroupDescriptionBox"
        dic.Add "stsl", "SampleScaleBox"
        dic.Add "subs", "SubSampleInformationBox"
        dic.Add "pdin", "ProgressiveDownloadInfoBox"
        dic.Add "meta", "MetaBox"
        dic.Add "xml ", "XMLBox"
        dic.Add "bxml", "BinaryXMLBox"
        dic.Add "iloc", "ItemLocationBox"
        dic.Add "pitm", "PrimaryItemBox"
        dic.Add "ipro", "ItemProtectionBox"
        dic.Add "infe", "ItemInfoEntry"
        dic.Add "iinf", "ItemInfoBox"
        dic.Add "sinf", "ProtectionSchemeInfoBox"
        dic.Add "frma", "OriginalFormatBox"
        dic.Add "ipmc", "IPMPControlBox"
        dic.Add "schm", "SchemeTypeBox"
        dic.Add "schi", "SchemeInformationBox"
        dic.Add "srpp", "SRTPProcessBox"
        'dic.Add "hnti", "moviehintinformation"
        dic.Add "rtp ", "rtpmoviehintinformation"
        'dic.Add "hnti", "trackhintinformation"
        
        dic.Add "sdp ", "rtptracksdphintinformation"
        dic.Add "hinf", "hintstatisticsbox"
        dic.Add "trpy", "hintBytesSent"
        dic.Add "nump", "hintPacketsSent"
        dic.Add "tpyl", "hintBytesSent"
        
        dic.Add "totl", "hintBytesSent"
        dic.Add "npck", "hintPacketsSent"
        dic.Add "tpay", "hintBytesSent"
        dic.Add "maxr", "hintmaxrate"
        
        dic.Add "dmed", "hintmediaBytesSent"
        dic.Add "dimm", "hintimmediateBytesSent"
        dic.Add "drep", "hintrepeatedBytesSent"
        dic.Add "tmin", "hintminrelativetime"
        
        dic.Add "tmax", "hintmaxrelativetime"
        dic.Add "pmax", "hintlargestpacket"
        dic.Add "dmax", "hintlongestpacket"
        dic.Add "payt", "hintpayloadID"
        
        '* not in the spec
        
        dic.Add "tfdt", "TrackFragmentDecodeTimeBox"
        
    End If

    Set AtomDescriptions = dic

End Function

'*********************************************************************************************************
'*********************************************************************************************************
'       ______ ___  __  __      _   _   _        _ _           _                              _ _
'    / \|_   _/ _ \|  \/  |    / \ | |_| |_ _ __(_) |__  _   _| |_ ___  ___   _ __ ___  _   _| |_(_)_ __   ___  ___
'   / _ \ | || | | | |\/| |   / _ \| __| __| '__| | '_ \| | | | __/ _ \/ __| | '__/ _ \| | | | __| | '_ \ / _ \/ __|
'  / ___ \| || |_| | |  | |  / ___ \ |_| |_| |  | | |_) | |_| | ||  __/\__ \ | | | (_) | |_| | |_| | | | |  __/\__ \
' /_/   \_\_| \___/|_|  |_| /_/   \_\__|\__|_|  |_|_.__/ \__,_|\__\___||___/ |_|  \___/ \__,_|\__|_|_| |_|\___||___/
'*
'*
'* Description: a set of routins which adorns various atom with extra atom specific attributes
'*********************************************************************************************************
'*********************************************************************************************************


'*********************************************************************************************************
'* Name:        AtomAttributes
'* Description: convert a stream of bytes to a string (implies ASCII / UTF-8)
'*********************************************************************************************************
Private Function AtomAttributes(ByVal sAtom As String, ByVal xmlAtom As MSXML2.IXMLDOMElement, _
            ByVal lPosition As Long, ByVal lSize As Long, ByVal lVersion As Long, ByVal lFlags As Long)

    Select Case sAtom
    Case "ftyp":
        FtypAttributes xmlAtom, lPosition, lSize
    Case "mvhd"
        MvhdAttributes xmlAtom, lPosition, lSize, lVersion
    Case "tkhd":
        TkhdAttributes xmlAtom, lPosition, lSize, lVersion
    Case "mfhd":
        MfhdAttributes xmlAtom, lPosition, lSize
    Case "tfhd":
        TfhdAttributes xmlAtom, lPosition, lSize
    Case "trun":
        TrunAttributes xmlAtom, lPosition, lSize, lVersion, lFlags
    Case "tfdt":
        TfdtAttributes xmlAtom, lPosition, lSize, lVersion
    Case "mehd":
        MehdAttributes xmlAtom, lPosition, lSize, lVersion
    Case "trex":
        TrexAttributes xmlAtom, lPosition, lSize, lVersion
    Case "elst":
        ElstAttributes xmlAtom, lPosition, lSize, lVersion
    Case "mdhd":
        MdhdAttributes xmlAtom, lPosition, lSize, lVersion
    Case "hdlr":
        HdlrAttributes xmlAtom, lPosition, lSize, lVersion
    Case "vmhd":
        VmhdAttributes xmlAtom, lPosition, lSize, lVersion, lFlags
    Case "smhd":
        SmhdAttributes xmlAtom, lPosition, lSize, lVersion, lFlags
    Case "stsd":
        StsdAttributes xmlAtom, lPosition, lSize, lVersion, lFlags
    Case "stts":
        SttsAttributes xmlAtom, lPosition, lSize, lVersion, lFlags
    Case "stss":
        StssAttributes xmlAtom, lPosition, lSize, lVersion, lFlags
    Case "stsc":
        StscAttributes xmlAtom, lPosition, lSize, lVersion, lFlags
    Case "stco":
        StcoAttributes xmlAtom, lPosition, lSize, lVersion, lFlags
    Case "stsz":
        StszAttributes xmlAtom, lPosition, lSize, lVersion, lFlags
    Case "stts":
        StszAttributes xmlAtom, lPosition, lSize, lVersion, lFlags
    Case "sgpd":
        SgpdAttributes xmlAtom, lPosition, lSize, lVersion, lFlags
    Case "sbgp":
        SbgpAttributes xmlAtom, lPosition, lSize, lVersion, lFlags
    Case "ctts":
        CttsAttributes xmlAtom, lPosition, lSize, lVersion, lFlags
    Case "dref":
        DrefAttributes xmlAtom, lPosition, lSize, lVersion, lFlags
    End Select

End Function
Private Function DrefAttributes(ByVal xmlAtom As MSXML2.IXMLDOMElement, ByVal lPosition As Long, ByVal lSize As Long, _
                                            ByVal lVersion As Long, ByVal lFlags As Long)
    '* DataReferenceBox
                                            
    Dim idx As Long
    idx = lPosition + 12
                                            
    Dim lEntryCount As Long
    lEntryCount = BytesToLong(mbytes, 4, idx)
    xmlAtom.setAttribute "entry_count", lEntryCount

    Dim lEntryLoop As Long
    For lEntryLoop = 1 To lEntryCount
        DoEvents
        If lEntryLoop > mlOmissionThreshold Then Exit For
    
        Dim xmlEntry As MSXML2.IXMLDOMElement
        Set xmlEntry = xmlAtom.OwnerDocument.createElement("entry")
        xmlAtom.appendChild xmlEntry

        Dim sDataEntry As String
        sDataEntry = BytesToLong(mbytes, lSize - idx, idx)
        
        Dim lNullTerm As Long
        lNullTerm = InStr(1, sDataEntry, Chr$(0), vbBinaryCompare)
        If lNullTerm > 0 Then
            sDataEntry = Left$(sDataEntry, lNullTerm - 1)
        End If
        
        xmlEntry.setAttribute "data_entry", sDataEntry
        
    Next
    
    If lEntryCount > mlOmissionThreshold Then
        xmlAtom.appendChild xmlAtom.OwnerDocument.createElement("omission")
    End If
                                            
                                            
End Function


Private Function CttsAttributes(ByVal xmlAtom As MSXML2.IXMLDOMElement, ByVal lPosition As Long, ByVal lSize As Long, _
                                            ByVal lVersion As Long, ByVal lFlags As Long)
    '* CompositionOffsetBox

    Dim idx As Long
    idx = lPosition + 12

    Dim lEntryCount As Long
    lEntryCount = BytesToLong(mbytes, 4, idx)
    xmlAtom.setAttribute "entry_count", lEntryCount

    Dim lEntryLoop As Long
    For lEntryLoop = 1 To lEntryCount
        DoEvents
        If lEntryLoop > mlOmissionThreshold Then Exit For
    
        Dim xmlEntry As MSXML2.IXMLDOMElement
        Set xmlEntry = xmlAtom.OwnerDocument.createElement("entry")
        xmlAtom.appendChild xmlEntry

        xmlEntry.setAttribute "sample_count", BytesToLong(mbytes, 4, idx)
        xmlEntry.setAttribute "sample_offset", BytesToLong(mbytes, 4, idx)
        
    Next
    
    If lEntryCount > mlOmissionThreshold Then
        xmlAtom.appendChild xmlAtom.OwnerDocument.createElement("omission")
    End If

End Function

Private Function SgpdAttributes(ByVal xmlAtom As MSXML2.IXMLDOMElement, ByVal lPosition As Long, ByVal lSize As Long, _
                                            ByVal lVersion As Long, ByVal lFlags As Long)
    '* SampleGroupDescriptionBox
    
    Dim idx As Long
    idx = lPosition + 12
    
    Dim sHandlerType As String
    sHandlerType = BytesToString(mbytes, 4, idx)
    
    xmlAtom.setAttribute "handler_type", sHandlerType
    xmlAtom.setAttribute "grouping_type", BytesToLong(mbytes, 4, idx)
    
    Dim lEntryCount As Long
    lEntryCount = BytesToLong(mbytes, 4, idx)
    xmlAtom.setAttribute "entry_count", lEntryCount
    
    Dim lLoop As Long
    For lLoop = 1 To lEntryCount
        DoEvents
        If lLoop > mlOmissionThreshold Then Exit For
        
        Dim xmlEntry As MSXML2.IXMLDOMElement
        Set xmlEntry = xmlAtom.OwnerDocument.createElement("entry")
        xmlAtom.appendChild xmlEntry

        Select Case sHandlerType
        Case "vide":
            'TODO
        Case "soun":
            'TODO
        Case "hint":
            'TODO
        Case "roll":
            xmlEntry.setAttribute "roll_distance", BytesToLong(mbytes, 2, idx)
        End Select
    Next

    If lEntryCount > mlOmissionThreshold Then
        xmlAtom.appendChild xmlAtom.OwnerDocument.createElement("omission")
    End If
End Function

Private Function SbgpAttributes(ByVal xmlAtom As MSXML2.IXMLDOMElement, ByVal lPosition As Long, ByVal lSize As Long, _
                                            ByVal lVersion As Long, ByVal lFlags As Long)
    '* SampleToGroupBox
    
    Dim idx As Long
    idx = lPosition + 12

    xmlAtom.setAttribute "grouping_type", BytesToLong(mbytes, 4, idx)
    Dim lEntries As Long
    lEntries = BytesToLong(mbytes, 4, idx)

    xmlAtom.setAttribute "entry_count", lEntries
    
    Dim lLoop As Long
    For lLoop = 1 To lEntries
        DoEvents
        If lLoop > mlOmissionThreshold Then Exit For
        
        Dim xmlEntry As MSXML2.IXMLDOMElement
        Set xmlEntry = xmlAtom.OwnerDocument.createElement("entry")
        xmlAtom.appendChild xmlEntry

        xmlEntry.setAttribute "sample_count", BytesToLong(mbytes, 4, idx)
        xmlEntry.setAttribute "group_description_index", BytesToLong(mbytes, 4, idx)
    Next

    If lEntries > mlOmissionThreshold Then
        xmlAtom.appendChild xmlAtom.OwnerDocument.createElement("omission")
    End If
    
End Function


Private Function StssAttributes(ByVal xmlAtom As MSXML2.IXMLDOMElement, ByVal lPosition As Long, ByVal lSize As Long, ByVal lVersion As Long, ByVal lFlags As Long)
    '* SyncSampleBox
    Dim idx As Long
    idx = lPosition + 12

    Dim lEntries As Long
    lEntries = BytesToLong(mbytes, 4, idx)
    xmlAtom.setAttribute "entry_count", lEntries

    Dim lLoop As Long
    For lLoop = 1 To lEntries
        DoEvents
        If lLoop > mlOmissionThreshold Then Exit For
        
        Dim xmlEntry As MSXML2.IXMLDOMElement
        Set xmlEntry = xmlAtom.OwnerDocument.createElement("entry")
        xmlAtom.appendChild xmlEntry

        xmlEntry.setAttribute "sample_number", BytesToLong(mbytes, 4, idx)
    Next

    If lEntries > mlOmissionThreshold Then
        xmlAtom.appendChild xmlAtom.OwnerDocument.createElement("omission")
    End If


End Function

Private Function StcoAttributes(ByVal xmlAtom As MSXML2.IXMLDOMElement, ByVal lPosition As Long, ByVal lSize As Long, ByVal lVersion As Long, ByVal lFlags As Long)
    '* ChunkOffsetBox
    Dim idx As Long
    idx = lPosition + 12

    Dim lEntries As Long
    lEntries = BytesToLong(mbytes, 4, idx)
    xmlAtom.setAttribute "entry_count", lEntries
    
    Dim lLoop As Long
    For lLoop = 1 To lEntries
        DoEvents
        If lLoop > mlOmissionThreshold Then Exit For
        
        Dim xmlEntry As MSXML2.IXMLDOMElement
        Set xmlEntry = xmlAtom.OwnerDocument.createElement("entry")
        xmlAtom.appendChild xmlEntry

        xmlEntry.setAttribute "chunk_offset", BytesToLong(mbytes, 4, idx)
    Next

    If lEntries > mlOmissionThreshold Then
        xmlAtom.appendChild xmlAtom.OwnerDocument.createElement("omission")
    End If
    

End Function

Private Function StszAttributes(ByVal xmlAtom As MSXML2.IXMLDOMElement, ByVal lPosition As Long, ByVal lSize As Long, ByVal lVersion As Long, ByVal lFlags As Long)
    '* SampleSizeBox
    Dim idx As Long
    idx = lPosition + 12
    
    Dim lGlobalSampleSize As Long
    lGlobalSampleSize = BytesToLong(mbytes, 4, idx)
    xmlAtom.setAttribute "sample_size", lGlobalSampleSize

    Dim lCount As Long
    lCount = BytesToLong(mbytes, 4, idx)
    xmlAtom.setAttribute "sample_count", lCount

    If lGlobalSampleSize = 0 Then
        Dim lLoop As Long
        For lLoop = 1 To lCount
            DoEvents
            If lLoop > mlOmissionThreshold Then Exit For
            
            Dim xmlEntry As MSXML2.IXMLDOMElement
            Set xmlEntry = xmlAtom.OwnerDocument.createElement("entry")
            xmlAtom.appendChild xmlEntry
    
            xmlEntry.setAttribute "entry_size", BytesToLong(mbytes, 4, idx)
        Next

        If lCount > mlOmissionThreshold Then
            xmlAtom.appendChild xmlAtom.OwnerDocument.createElement("omission")
        End If

    End If

End Function

Private Function StscAttributes(ByVal xmlAtom As MSXML2.IXMLDOMElement, ByVal lPosition As Long, ByVal lSize As Long, ByVal lVersion As Long, ByVal lFlags As Long)
    '* SampleToChunkBox
    Dim idx As Long
    idx = lPosition + 12

    Dim lEntries As Long
    lEntries = BytesToLong(mbytes, 4, idx)
    
    xmlAtom.setAttribute "entry_count", lEntries
    
    Dim lLoop As Long
    For lLoop = 1 To lEntries
        DoEvents
        If lLoop > mlOmissionThreshold Then Exit For
        
        Dim xmlEntry As MSXML2.IXMLDOMElement
        Set xmlEntry = xmlAtom.OwnerDocument.createElement("entry")
        xmlAtom.appendChild xmlEntry
        
        xmlEntry.setAttribute "first_chunk", BytesToLong(mbytes, 4, idx)
        xmlEntry.setAttribute "samples_per_chunk", BytesToLong(mbytes, 4, idx)
        xmlEntry.setAttribute "sample_description_index", BytesToLong(mbytes, 4, idx)
        
    Next

    If lEntries > mlOmissionThreshold Then
        xmlAtom.appendChild xmlAtom.OwnerDocument.createElement("omission")
    End If
End Function


Private Function SttsAttributes(ByVal xmlAtom As MSXML2.IXMLDOMElement, ByVal lPosition As Long, ByVal lSize As Long, ByVal lVersion As Long, ByVal lFlags As Long)
    '* TimeToSampleBox
    Dim idx As Long
    idx = lPosition + 12

    Dim entry_count As Long
    entry_count = BytesToLong(mbytes, 4, idx)
    xmlAtom.setAttribute "entry_count", entry_count
    
    Dim lLoop As Long
    For lLoop = 1 To entry_count
        DoEvents
        If lLoop > mlOmissionThreshold Then Exit For
        
        Dim xmlSttsSample As MSXML2.IXMLDOMElement
        Set xmlSttsSample = xmlAtom.OwnerDocument.createElement("entry")
        xmlAtom.appendChild xmlSttsSample
        
        xmlSttsSample.setAttribute "sample_count", BytesToLong(mbytes, 4, idx)
        xmlSttsSample.setAttribute "sample_delta", BytesToLong(mbytes, 4, idx)
    Next
    
    If entry_count > mlOmissionThreshold Then
        xmlAtom.appendChild xmlAtom.OwnerDocument.createElement("omission")
    End If
    
End Function

Private Function StsdAttributes(ByVal xmlAtom As MSXML2.IXMLDOMElement, ByVal lPosition As Long, ByVal lSize As Long, ByVal lVersion As Long, ByVal lFlags As Long)
    '* SampleDescriptionBox
        
    Dim idx As Long
    idx = lPosition + 12

    Dim entry_count As Long
    entry_count = BytesToLong(mbytes, 4, idx)
    xmlAtom.setAttribute "entry_count", entry_count
    
    Dim lLoop As Long
    For lLoop = 1 To entry_count
        
        Dim xmlEntry As MSXML2.IXMLDOMElement
        Set xmlEntry = xmlAtom.OwnerDocument.createElement("entry")
        xmlAtom.appendChild xmlEntry
        
        'xmlEntry.setAttribute "sample_count", BytesToLong(mbytes, 4, idx)
        'xmlEntry.setAttribute "sample_delta", BytesToLong(mbytes, 4, idx)
    Next
    
    

End Function

Private Function SmhdAttributes(ByVal xmlAtom As MSXML2.IXMLDOMElement, ByVal lPosition As Long, ByVal lSize As Long, ByVal lVersion As Long, ByVal lFlags As Long)
    '* SoundMediaHeaderBox
    Dim idx As Long
    idx = lPosition + 12

    xmlAtom.setAttribute "balance", BytesToLong(mbytes, 2, idx)
    xmlAtom.setAttribute "reserved", BytesToLong(mbytes, 2, idx)

End Function


Private Function VmhdAttributes(ByVal xmlAtom As MSXML2.IXMLDOMElement, ByVal lPosition As Long, ByVal lSize As Long, ByVal lVersion As Long, ByVal lFlags As Long)
    '* VideoMediaHeaderBox
    Dim idx As Long
    idx = lPosition + 12

    xmlAtom.setAttribute "graphicsmode", BytesToLong(mbytes, 2, idx)
    xmlAtom.setAttribute "opcolor_0", BytesToLong(mbytes, 2, idx)
    xmlAtom.setAttribute "opcolor_1", BytesToLong(mbytes, 2, idx)
    xmlAtom.setAttribute "opcolor_2", BytesToLong(mbytes, 2, idx)
End Function

Private Function HdlrAttributes(ByVal xmlAtom As MSXML2.IXMLDOMElement, ByVal lPosition As Long, ByVal lSize As Long, ByVal lVersion As Long)
    '* HandlerBox
    Dim idx As Long
    idx = lPosition + 12
    
    xmlAtom.setAttribute "pre_defined", BytesToLong(mbytes, 4, idx)
    xmlAtom.setAttribute "handler_type", BytesToString(mbytes, 4, idx)
    
    Dim lReservedIdx As Long
    For lReservedIdx = 0 To 2
        xmlAtom.setAttribute "reserved_" & lReservedIdx, BytesToLong(mbytes, 4, idx)
    Next
    
    xmlAtom.setAttribute "name", BytesToString(mbytes, lPosition + lSize - idx, (idx))
End Function

Private Function MdhdAttributes(ByVal xmlAtom As MSXML2.IXMLDOMElement, ByVal lPosition As Long, ByVal lSize As Long, ByVal lVersion As Long)
    '* MediaHeaderBox
    Dim idx As Long
    idx = lPosition + 12

    If lVersion = 1 Then
        xmlAtom.setAttribute "creation_time", BytesToVeryLongDecimalString(mbytes, 8, idx)
        xmlAtom.setAttribute "modification_time", BytesToVeryLongDecimalString(mbytes, 8, idx)
        xmlAtom.setAttribute "timescale", BytesToLong(mbytes, 4, idx)
        xmlAtom.setAttribute "duration", BytesToVeryLongDecimalString(mbytes, 8, idx)
    Else
        xmlAtom.setAttribute "creation_time", BytesToLong(mbytes, 4, idx)
        xmlAtom.setAttribute "modification_time", BytesToLong(mbytes, 4, idx)
        xmlAtom.setAttribute "timescale", BytesToLong(mbytes, 4, idx)
        xmlAtom.setAttribute "duration", BytesToLong(mbytes, 4, idx)
    End If
    Dim languagesPack As Long
    languagesPack = BytesToLong(mbytes, 2, idx)
    
    xmlAtom.setAttribute "language", ISO639_2T(languagesPack)
    xmlAtom.setAttribute "pre_defined", BytesToLong(mbytes, 2, idx)
End Function

Private Function ISO639_2T(ByVal lThreeFiveBitCharacters As Long) As String
    '* "Each character is packed as the difference between its ASCII value and 0x60. Since the code
    '*  is confined to being three lower-case letters, these values are strictly positive"
    '* typical results are 'eng' for English and 'und' for undefined/undetermined
    Dim lLoop As Long
    For lLoop = 1 To 3
        ISO639_2T = Chr$(96 + (lThreeFiveBitCharacters And 31)) & ISO639_2T
        lThreeFiveBitCharacters = lThreeFiveBitCharacters / 32
    Next
End Function

Private Function ElstAttributes(ByVal xmlAtom As MSXML2.IXMLDOMElement, ByVal lPosition As Long, ByVal lSize As Long, ByVal lVersion As Long)
    '* EditListBox
    Dim idx As Long
    idx = lPosition + 12

    Dim lEntryCount As Long
    lEntryCount = BytesToLong(mbytes, 4, idx)
    xmlAtom.setAttribute "entry_count", lEntryCount

    Dim lEntryLoop As Long
    For lEntryLoop = 1 To lEntryCount
        If lVersion = 1 Then
            xmlAtom.setAttribute "segment_duration", BytesToVeryLongDecimalString(mbytes(), 8, idx)
            xmlAtom.setAttribute "media_time", BytesToVeryLongDecimalString(mbytes(), 8, idx)
        Else
            xmlAtom.setAttribute "segment_duration", BytesToLong(mbytes(), 4, idx)
            xmlAtom.setAttribute "media_time", BytesToLong(mbytes(), 4, idx)
        End If
        xmlAtom.setAttribute "media_rate_integer", BytesToLong(mbytes(), 2, idx)
        xmlAtom.setAttribute "media_rate_fraction", BytesToLong(mbytes(), 2, idx)
    Next
End Function


Private Function TrexAttributes(ByVal xmlAtom As MSXML2.IXMLDOMElement, ByVal lPosition As Long, ByVal lSize As Long, ByVal lVersion As Long)
    '* TrackExtendsBox
    Dim idx As Long
    idx = lPosition + 12
    
    xmlAtom.setAttribute "track_ID", BytesToLong(mbytes, 4, idx)
    xmlAtom.setAttribute "default_sample_description_index", BytesToLong(mbytes, 4, idx)
    xmlAtom.setAttribute "default_sample_duration", BytesToLong(mbytes, 4, idx)
    xmlAtom.setAttribute "default_sample_size", BytesToLong(mbytes, 4, idx)
    xmlAtom.setAttribute "default_sample_flags", BytesToLong(mbytes, 4, idx)
End Function

Private Function MehdAttributes(ByVal xmlAtom As MSXML2.IXMLDOMElement, ByVal lPosition As Long, ByVal lSize As Long, ByVal lVersion As Long)
    '* MovieExtendsHeaderBox
    xmlAtom.setAttribute "fragment_duration", BytesToVeryLongDecimalString(mbytes, VBA.IIf(lVersion = 1, 8, 4), (lPosition + 12))
End Function

Private Function MfhdAttributes(ByVal xmlAtom As MSXML2.IXMLDOMElement, ByVal lPosition As Long, ByVal lSize As Long)
    '* MovieFragmentHeaderBox
    xmlAtom.setAttribute "sequence_number", BytesToLongPtr(mbytes, 8, (lPosition + 8))
End Function

Private Function MvhdAttributes(ByVal xmlAtom As MSXML2.IXMLDOMElement, ByVal lPosition As Long, ByVal lSize As Long, ByVal lVersion As Long)
    '* MovieHeaderBox
    Dim idx As Long
    idx = lPosition + 12
    If lVersion = 1 Then
        xmlAtom.setAttribute "creationtime", BytesToLongPtr(mbytes, 8, idx)
        xmlAtom.setAttribute "modificationtime", BytesToLongPtr(mbytes, 8, idx)
        xmlAtom.setAttribute "timescale", BytesToLong(mbytes, 4, idx)
        xmlAtom.setAttribute "duration", BytesToLongPtr(mbytes, 8, idx)
                    
    Else
        xmlAtom.setAttribute "creationtime", BytesToLong(mbytes, 4, idx)
        xmlAtom.setAttribute "modificationtime", BytesToLong(mbytes, 4, idx)
        xmlAtom.setAttribute "timescale", BytesToLong(mbytes, 4, idx)
        xmlAtom.setAttribute "duration", BytesToLong(mbytes, 4, idx)
    
    End If

    xmlAtom.setAttribute "preferredrate", BytesToLong(mbytes, 4, idx)
    xmlAtom.setAttribute "preferredvolume", BytesToLong(mbytes, 2, idx)
    xmlAtom.setAttribute "reserved1", BytesToLong(mbytes, 2, idx)
    
    xmlAtom.setAttribute "reserved2_0", BytesToLong(mbytes, 4, idx)
    xmlAtom.setAttribute "reserved2_1", BytesToLong(mbytes, 4, idx)
    
    Dim lMatrixIdx As Long
    For lMatrixIdx = 0 To 8
        xmlAtom.setAttribute "matrix_" & lMatrixIdx, BytesToLong(mbytes, 4, idx)
    Next

    Dim lPreDefinedIdx As Long
    For lPreDefinedIdx = 0 To 5
        xmlAtom.setAttribute "pre_defined_" & lPreDefinedIdx, BytesToLong(mbytes, 4, idx)
    Next
    
    
    xmlAtom.setAttribute "nexttrackid", BytesToVeryLongDecimalString(mbytes, 4, idx)
End Function

Private Function TkhdAttributes(ByVal xmlAtom As MSXML2.IXMLDOMElement, ByVal lPosition As Long, _
                    ByVal lSize As Long, ByVal lVersion As Long)
    '* TrackHeaderBox
    Dim idx As Long
    idx = lPosition + 12
    If lVersion = 1 Then
        xmlAtom.setAttribute "creation_time", BytesToLongPtr(mbytes, 8, idx)
        xmlAtom.setAttribute "modification_time", BytesToLongPtr(mbytes, 8, idx)
        xmlAtom.setAttribute "track_ID", BytesToLong(mbytes, 4, idx)
        xmlAtom.setAttribute "reserved", BytesToLong(mbytes, 4, idx)
        xmlAtom.setAttribute "duration", BytesToLongPtr(mbytes, 8, idx)
                    
    Else
        xmlAtom.setAttribute "creation_time", BytesToLong(mbytes, 4, idx)
        xmlAtom.setAttribute "modification_time", BytesToLong(mbytes, 4, idx)
        xmlAtom.setAttribute "track_ID", BytesToLong(mbytes, 4, idx)
        xmlAtom.setAttribute "reserved", BytesToLong(mbytes, 4, idx)
        xmlAtom.setAttribute "duration", BytesToLong(mbytes, 4, idx)
    
    End If

    xmlAtom.setAttribute "reserved1_0", BytesToLong(mbytes, 4, idx)
    xmlAtom.setAttribute "reserved1_1", BytesToLong(mbytes, 4, idx)
    
    xmlAtom.setAttribute "layer", BytesToLong(mbytes, 2, idx)
    xmlAtom.setAttribute "alternationgroup", BytesToLong(mbytes, 2, idx)
    xmlAtom.setAttribute "volume", BytesToLong(mbytes, 2, idx)
    xmlAtom.setAttribute "reserved2", BytesToLong(mbytes, 2, idx)
    
    Dim lMatrixIdx As Long
    For lMatrixIdx = 0 To 8
        xmlAtom.setAttribute "matrixstructure_" & lMatrixIdx, BytesToLong(mbytes, 4, idx)
    Next
    
    xmlAtom.setAttribute "trackwidth", BytesToLong(mbytes, 4, idx)
    xmlAtom.setAttribute "trackheight", BytesToLong(mbytes, 4, idx)
End Function

Private Function TrunAttributes(ByVal xmlAtom As MSXML2.IXMLDOMElement, ByVal lPosition As Long, ByVal lSize As Long, ByVal lVersion As Long, ByVal lFlags As Long)
    '* TrackRunBox
    Dim idx As Long
    idx = lPosition + 12
    
  
    Dim lSampleCount As Long
    lSampleCount = BytesToLong(mbytes(), 4, idx)
    
    xmlAtom.setAttribute "sample_count", lSampleCount
    
    If lFlags And MP4_TRUN_DATA_OFFSET = 1 Then
        xmlAtom.setAttribute "data_offset", BytesToLong(mbytes(), 4, idx)
    End If
    
    If lFlags And MP4_TRUN_FIRST_FLAGS = 1 Then
        xmlAtom.setAttribute "first_sample_flags", BytesToLong(mbytes(), 4, idx)
    End If
    
    Dim bSampleHasDuration As Boolean
    bSampleHasDuration = lFlags And MP4_TRUN_SAMPLE_DURATION
    
    Dim bSampleHasSize As Boolean
    bSampleHasSize = lFlags And MP4_TRUN_SAMPLE_SIZE
    
    Dim bSampleHasFlags As Boolean
    bSampleHasFlags = lFlags And MP4_TRUN_SAMPLE_FLAGS
    
    Dim bSampleHasTimeOffset As Boolean
    bSampleHasTimeOffset = lFlags And MP4_TRUN_SAMPLE_TIME_OFFSET
    
    Dim entry_size As Long
    entry_size = VBA.IIf(bSampleHasDuration, 1, 0) + _
                VBA.IIf(bSampleHasSize, 1, 0) + _
                VBA.IIf(bSampleHasFlags, 1, 0) + _
                VBA.IIf(bSampleHasTimeOffset, 1, 0)
    
    Debug.Assert entry_size = 1  '* we assuming the trun table is sample lengths
    
    Dim lSampleSizesTotalled As Long
    lSampleSizesTotalled = 0

    Dim lSampleLoop As Long
    For lSampleLoop = 0 To lSampleCount - 1
        
        
        Dim lSampleDuration As Long: lSampleDuration = 0
        Dim lSampleSize As Long: lSampleSize = 0
        Dim lSampleFlags As Long: lSampleFlags = 0
        Dim lSampleTimeOffset As Long: lSampleTimeOffset = 0
        
        If bSampleHasDuration Then lSampleDuration = BytesToLong(mbytes(), 4, idx)
        If bSampleHasSize Then
            lSampleSize = BytesToLong(mbytes(), 4, idx)
            lSampleSizesTotalled = lSampleSizesTotalled + lSampleSize
        End If
        If bSampleHasFlags Then lSampleFlags = BytesToLong(mbytes(), 4, idx)
        If bSampleHasTimeOffset Then lSampleTimeOffset = BytesToLong(mbytes(), 4, idx)
        
        If lSampleLoop <= mlOmissionThreshold Then
            Dim xmlSample As MSXML2.IXMLDOMElement
            Set xmlSample = xmlAtom.OwnerDocument.createElement("entry")
                
            xmlAtom.appendChild xmlSample
            
            If bSampleHasDuration Then xmlSample.setAttribute "sample_duration", lSampleDuration
            If bSampleHasSize Then xmlSample.setAttribute "sample_size", lSampleSize
            If bSampleHasFlags Then xmlSample.setAttribute "sample_flags", lSampleFlags
            If bSampleHasTimeOffset Then xmlSample.setAttribute "sample_composition_time_offset", lSampleTimeOffset
        
        End If
    Next lSampleLoop
    
    If lSampleCount > mlOmissionThreshold Then
        Dim xmlOmission As MSXML2.IXMLDOMElement
        Set xmlOmission = xmlAtom.OwnerDocument.createElement("omission")
        xmlAtom.appendChild xmlOmission
    End If
        
    xmlAtom.setAttribute "SampleSizesTotalled", lSampleSizesTotalled
End Function


Private Function TfdtAttributes(ByVal xmlAtom As MSXML2.IXMLDOMElement, ByVal lPosition As Long, ByVal lSize As Long, ByVal lVersion As Long)
    '* TrackFragmentDecodeTimeBox
    lPosition = lPosition + 12
    
    xmlAtom.setAttribute "base_media_decode_time", BytesToVeryLongDecimalString(mbytes(), VBA.IIf(lVersion = 0, 4, 8), lPosition)
End Function

Private Function TfhdAttributes(ByVal xmlAtom As MSXML2.IXMLDOMElement, ByVal lPosition As Long, ByVal lSize As Long)
    '* TrackFragmentHeaderBox
    lPosition = lPosition + 12
    xmlAtom.setAttribute "track_ID", BytesToLong(mbytes(), 4, lPosition)
    'Stop
    If lSize = 36 Then
        '* we have optional fields
        xmlAtom.setAttribute "base_data_offset", BytesToLongPtr(mbytes(), 8, lPosition)
        xmlAtom.setAttribute "sample_description_index", BytesToLong(mbytes(), 4, lPosition)
        xmlAtom.setAttribute "default_sample_duration", BytesToLong(mbytes(), 4, lPosition)
        xmlAtom.setAttribute "default_sample_size", BytesToLong(mbytes(), 4, lPosition)
        xmlAtom.setAttribute "default_sample_flags", BytesToLong(mbytes(), 4, lPosition)
    End If
End Function


Private Function FtypAttributes(ByVal xmlAtom As MSXML2.IXMLDOMElement, ByVal lPosition As Long, ByVal lSize As Long)
    '* FileTypeBox
    lPosition = lPosition + 8
    xmlAtom.setAttribute "major_brand", BytesToString(mbytes(), 4, lPosition)
    xmlAtom.setAttribute "minor_version", BytesToLong(mbytes(), 4, lPosition)
    
    Dim lCompatibleBrandsLen As Long
    lCompatibleBrandsLen = lSize - lPosition
    
    Dim lCompatibleBrandsCount As Long
    lCompatibleBrandsCount = lCompatibleBrandsLen / 4
    
    Dim sCompatibleBrands As String
    
    If lCompatibleBrandsCount > 0 Then
    
        sCompatibleBrands = BytesToString(mbytes(), lCompatibleBrandsLen, lPosition) '* eat what's left
        
        '* add comma separators
        
        Dim sCompatibleBrandsCSV As String
        sCompatibleBrandsCSV = ""
        
        Dim lBrandLoop As Long
        For lBrandLoop = 1 To lCompatibleBrandsCount
            sCompatibleBrandsCSV = sCompatibleBrandsCSV & VBA.IIf(Len(sCompatibleBrandsCSV) > 0, ",", "") & Mid$(sCompatibleBrands, 4 * (lBrandLoop - 1) + 1, 4)
        Next
    End If
    xmlAtom.setAttribute "compatible_brands", sCompatibleBrandsCSV
End Function

'*********************************************************************************************************
'* Name:        BytesToString
'* Description: convert a stream of bytes to a string (implies ASCII / UTF-8)
'*********************************************************************************************************
Private Function BytesToString(ByRef bytes() As Byte, ByVal cBytes As Long, ByRef plPosition As Long) As String
    Dim lLoop As Long
    For lLoop = 0 To cBytes - 1
        BytesToString = BytesToString & Chr$(bytes(plPosition + lLoop))
    Next
    plPosition = plPosition + cBytes
End Function

'*********************************************************************************************************
'* Name:        FullBoxAtoms
'* Description: serves two purposes
'*              (1) which atom are 'FullBox' and so have minimum size of 12 bits and
'*              (2) where flags are given it details the enumeration so a numer can be decomposed
'*********************************************************************************************************
Private Function FullBoxAtoms() As Scripting.Dictionary

    Static dicFullBoxAtoms As Scripting.Dictionary
    If dicFullBoxAtoms Is Nothing Then
        Set dicFullBoxAtoms = New Scripting.Dictionary
        dicFullBoxAtoms.CompareMode = TextCompare
    
        Dim vFullBoxAtoms As Variant
        vFullBoxAtoms = Array( _
            Array("stco", ""), _
            Array("stsz", ""), _
            Array("stsc", ""), _
            Array("stsd", ""), _
            Array("stts", ""), _
            Array("stss", ""), _
            Array("ctts", ""), _
            Array("dref", ""), _
            Array("smhd", ""), _
            Array("hdlr", ""), _
            Array("mfhd", ""), _
            Array("mdhd", ""), _
            Array("mvhd", ""), _
            Array("tfdt", ""), _
            Array("trex", ""), _
            Array("elst", ""), _
            Array("mehd", ""), _
            Array("vmhd", ""), _
            Array("sgpd", ""), _
            Array("sbgp", ""), _
            Array("tfhd", "base-data-offset-present|sample-description-index-present||default-sample-duration-present|default-sample-size-present|default-sample-flags-present|||||||||||duration-is-empty|default-base-is-moof"), _
            Array("tkhd", "Track_enabled|Track_in_movie|Track_In_preview"), _
            Array("trun", "data-offset-present||first-sample-flags-present||||||sample-duration-present|sample-size-present|sample-flags-present|sample-composition-time-offsets-present"))
    
        Dim vLoop As Variant
        For Each vLoop In vFullBoxAtoms
            dicFullBoxAtoms.Add vLoop(0), vLoop(1)
        Next vLoop
    End If
    
    Set FullBoxAtoms = dicFullBoxAtoms
End Function

'************************************************************
'* test routine
'************************************************************
Private Sub TestFlagsToString()
    Debug.Assert FlagsToString("tkhd", 5) = "(5) (h1) Track_enabled,(h4) Track_In_preview"
    Debug.Assert FlagsToString("tkhd", 0) = "(0)"
    Debug.Assert FlagsToString("tkhd", 4) = "(4) (h4) Track_In_preview"
End Sub

'*********************************************************************************************************
'* Name:        FlagsToString
'* Description: decompose a binary flags enum to a list of comma separated strings
'*********************************************************************************************************
Private Function FlagsToString(ByVal sAtom As String, ByVal lFlags As Long, Optional lStartBit As Long) As String
    Dim sFlagsEnum As String
    
    If FullBoxAtoms().Exists(sAtom) Then
        sFlagsEnum = FullBoxAtoms().Item(sAtom)
    End If
    If Len(sFlagsEnum) > 0 Then
        FlagsToString = "(" & CStr(lFlags) & ") " & FlagsToStringInner(sFlagsEnum, lFlags)
    Else
        FlagsToString = CStr(lFlags)
    End If
    
    FlagsToString = Trim(FlagsToString)
End Function

'*********************************************************************************************************
'* Name:        FlagsToStringInner
'* Description: decompose a binary flags enum to a list of comma separated strings
'*********************************************************************************************************
Private Function FlagsToStringInner(ByVal sFlagsEnum As String, ByVal lFlags As Long, Optional lStartBit As Long) As String
    Dim vFlags
    vFlags = VBA.Split(sFlagsEnum, "|")
    FlagsToStringInner = ""
    Dim idx As Long
    idx = 0
    
    Dim bDebug As Boolean
    bDebug = lFlags > 1512
    'Debug.Assert lFlags < 1512
    
    
    Dim lBit As LongPtr
    lBit = 1
    
    Dim lFlagsCopy As Long
    lFlagsCopy = lFlags
    
    Do
        DoEvents
        If lFlagsCopy Mod 2 = 1 Then
            FlagsToStringInner = FlagsToStringInner & VBA.IIf(Len(FlagsToStringInner) > 0, ",", "") & "(h" & Hex$(lBit) & ") " & vFlags(idx)
            lFlagsCopy = lFlagsCopy - 1  '* eat the bit
            If bDebug Then
                Debug.Print FlagsToStringInner
            End If
        End If
        lFlagsCopy = lFlagsCopy / 2
        lBit = lBit * 2
        idx = idx + 1
    Loop While lFlagsCopy > 0
    
End Function

'*********************************************************************************************************
'* Name:        FindAtomAtPosition2
'* Description: given a list of potential children and an end of parent limit we go look for child atoms
'*********************************************************************************************************
Private Function FindAtomAtPosition2(ByVal lPosition As Long, ByVal lEndOfParent As Long, dicChildrenOfAParent As Scripting.Dictionary, _
            ByRef psAtom As String)

    FindAtomAtPosition2 = -1
    Dim lOffset As Long
    lOffset = 0
    
    Do
        DoEvents
        Dim sFourCC As String
        sFourCC = FourBytesToFourCC(lPosition + lOffset)
        
        If dicChildrenOfAParent.Exists(sFourCC) Then
            FindAtomAtPosition2 = lPosition + lOffset
            psAtom = sFourCC
            GoTo SingleExit
        End If
        lOffset = lOffset + 1
    Loop Until lOffset + lPosition >= lEndOfParent

SingleExit:

End Function

'*********************************************************************************************************
'* Name:        FourBytesToFourCC
'* Description: Read four bytes and convert to a four characer string
'*********************************************************************************************************
Private Function FourBytesToFourCC(ByVal lPosition As Long)
    On Error Resume Next
    If lPosition + 3 > UBound(mbytes) Then
        FourBytesToFourCC = ""
    Else
        FourBytesToFourCC = Chr$(mbytes(lPosition + 0)) + Chr$(mbytes(lPosition + 1)) + Chr$(mbytes(lPosition + 2)) + Chr$(mbytes(lPosition + 3))
    End If
End Function

'*********************************************************************************************************
'* Name:        FourBytesToLong
'* Description: Read four bytes and convert to a 32-bit Long
'*********************************************************************************************************
Private Function FourBytesToLong(ByVal lPosition As Long) As Long
    Dim lWork As Long
    Debug.Assert lPosition >= 0
    lWork = mbytes(lPosition)
    lWork = lWork * 256 + mbytes(lPosition + 1)
    lWork = lWork * 256 + mbytes(lPosition + 2)
    lWork = lWork * 256 + mbytes(lPosition + 3)
    FourBytesToLong = lWork
End Function

'*********************************************************************************************************
'* Name:        ReadByteFile
'* Description: Read a file's contents into a byte array
'*********************************************************************************************************
Private Function ReadByteFile(ByVal sFileName As String) As Byte()
    Debug.Assert fso.FileExists(sFileName)

    Dim fileNum As Integer
    Dim bytes() As Byte

    fileNum = FreeFile
    Open sFileName For Binary As fileNum
    ReDim bytes(LOF(fileNum) - 1)
    Get fileNum, , bytes
    Close fileNum

    ReadByteFile = bytes
End Function

'*********************************************************************************************************
'* Name:        BytesToLong
'* Description: Convert a stream of bytes to a 32-bit Long
'*********************************************************************************************************
Private Function BytesToLong(ByRef bytes() As Byte, ByVal cBytes As Long, ByRef plPosition As Long, Optional bLittleEndian As Boolean = False) As Long
    BytesToLong = 0
    Dim lLoop As Long
    If bLittleEndian Then
        For lLoop = cBytes - 1 To 0 Step -1
            BytesToLong = BytesToLong * 256 + bytes(plPosition + lLoop)
        Next
    Else
        For lLoop = 0 To cBytes - 1
            BytesToLong = BytesToLong * 256 + bytes(plPosition + lLoop)
        Next
    End If

    plPosition = plPosition + cBytes
End Function

'*********************************************************************************************************
'* Name:        BytesToLongPtr
'* Description: Convert a long stream of bytes to a long point (LongPtr) to try to to break out of 32-bit Long boundary
'*********************************************************************************************************
Private Function BytesToLongPtr(ByRef bytes() As Byte, ByVal cBytes As Long, ByRef plPosition As Long, Optional bLittleEndian As Boolean = False) As LongPtr
    BytesToLongPtr = 0
    Dim lLoop As Long
    If bLittleEndian Then
        For lLoop = cBytes - 1 To 0 Step -1
            BytesToLongPtr = BytesToLongPtr * 256# + bytes(plPosition + lLoop)
        Next
    Else
        For lLoop = 0 To cBytes - 1
            BytesToLongPtr = BytesToLongPtr * 256# + bytes(plPosition + lLoop)
        Next
    End If

    plPosition = plPosition + cBytes
End Function

'*********************************************************************************************************
'* Name:        BytesToLongArray
'* Description: Convert a long stream of bytes to an array of long to break out of 32-bit Long boundary
'*********************************************************************************************************
Private Function BytesToLongArray(ByRef bytes() As Byte, ByVal cBytes As Long, ByRef plPosition As Long, Optional bLittleEndian As Boolean = False) As Long()
    Dim cLongs As Long
    cLongs = cBytes \ 4 + 1
    
    ReDim alReturn(0 To cLongs - 1) As Long
    
    Dim lLoop As Long
    For lLoop = 0 To cBytes - 1
        alReturn(lLoop) = BytesToLong(bytes, cBytes, plPosition, bLittleEndian)
    Next lLoop
    
    BytesToLongArray = alReturn
    
End Function

'*********************************************************************************************************
'* Name:        RemoveReports
'* Description: Clear down our workbook of previous reports
'*********************************************************************************************************
Private Sub RemoveReports()
    On Error GoTo SingleExit
    Dim ws As Excel.Worksheet
    
    Dim lLoop As Long
    For lLoop = ThisWorkbook.Worksheets.count To 1 Step -1
        Set ws = ThisWorkbook.Worksheets.Item(lLoop)
        If Left$(ws.Cells(1, 1), 5) = Chr$(60) & "mpeg" Then
            Application.DisplayAlerts = False
            ws.Delete
            Application.DisplayAlerts = True
        End If
    
    Next
SingleExit:
    Application.DisplayAlerts = True
End Sub


'*********************************************************************************************************
'* Name:        BytesToVeryLongDecimalString
'* Description: Converts a long string of bytes into a decimal string
'*
'* Dependency:  Requires Python COM Class found in file PythonBigNumbersComServer.py to be registered
'*
'*********************************************************************************************************
Private Function BytesToVeryLongDecimalString(ByRef bytes() As Byte, ByVal cBytes As Long, ByRef plPosition As Long, Optional bLittleEndian As Boolean = False) As String
    BytesToVeryLongDecimalString = ""

    If bLittleEndian Then
        'not yet implemented
    Else
        Static server As Object
        If server Is Nothing Then
            Set server = VBA.CreateObject("PythonInVBA.PythonBigNumbersComServer")
        End If

        Dim lLoop As Long
        ReDim bytessubarray(0 To cBytes - 1) As Byte
        For lLoop = 0 To cBytes - 1
            bytessubarray(lLoop) = bytes(plPosition + lLoop)
        Next lLoop

        'Stop
        BytesToVeryLongDecimalString = server.LongByteArrayToDecimalString(bytessubarray)
        'Stop
    End If

    plPosition = plPosition + cBytes
End Function

Finally, I hived off data specific to me in a module called modMyFiles. This is to emphasise that your files will be located elsewhere.

modMyFiles module

Option Explicit

'***********************************************************************************
'* Module Name: modMyFiles
'* Copyright exceldevelopmentplatform.blogspot.com 2nd November 2019
'*
'* Description:
'*  This module simply contains file locations of mp4 files to work with
'*  It allows me to isolate the details of my files, as opposed to your files dear reader
'*
'***********************************************************************************


Public Function MyMepgFiles() As Scripting.Dictionary
    Dim dic As Scripting.Dictionary
    Set dic = New Scripting.Dictionary
    
    '* these will differ for you, dear reader!
    dic.Add "C:\Users\Simon\Documents\Expression\Expression Encoder\Output\ENVY 01-11-2019 22.03.33\newsnight.mp4", ""

    
    Set MyMepgFiles = dic

End Function