The Excel Development Platform

Monday, 30 September 2019

Video - Parsing an MP4 file

Video files, specifically MP4 files, have a curious head of encoded data at the start of the file which can be seen in a hex editor or even Notepad. Below is a screenshot of a hex editor of just such a header.

(In actual fact this is a DASH fragmented mp4 initialization vector IV file, i.e. the first file in a long stream. So is without any encoded media data but it serves as an example)

I have written some VBA code to load this file and parse it out into what are known as ATOMS. I have placed this code into Appendix A because actually I found better source code in the form of the VLC Media Player code. VLC handles all manner of mp4 files and so is a infinitely better bet.

MP4 Files are based on Apple's QuickTime Movie files

During my reaearch, a fantastic discovery was a treasure trove of documentation regarding Apple's QuickTime File Format Specification. Below is a beautiful diagram showing the nested nature of the data structure. Clicking on the image will take you Apple's website. But a word of warning, whilst MP4 is based on QuickTime it may diverge at some points. In fact there is a warning here which says...

Important: The QuickTime File Format has been used as the basis of the MPEG-4 standard and the JPEG-2000 standard, developed by the International Organization for Standardization (ISO). Although these file types have similar structures and contain many functionally identical elements, they are distinct file types.

Warning: Do not use this specification to interpret a file that conforms to a different specification, however similar.

Despite this Apple's documentation is free and well-written and definitely serves as a starting point.

MPEG Specificaation ISO/IEC 14496 parts 12 & 14

There is an official specification published by International Standards Organisation (ISO). In the document ISO/IEC 14496-12 there is a very good table which also shows the nested box/atom structure. It is reproduced below.

ftyp						*	4.3	file type and compatibility
pdin							8.43	progressive download information
moov						*	8.1	container for all the metadata
	mvhd					*	8.3	movie header, overall declarations
	trak					*	8.4	container for an individual track or stream
		tkhd				*	8.5	track header, overall information about the track
		tref					8.6	track reference container
		edts					8.25	edit list container
			elst				8.26	an edit list
		mdia				*	8.7	container for the media information in a track
			mdhd			*	8.8	media header, overall information about the media
			hdlr			*	8.9	handler, declares the media (handler) type
			minf			*	8.10	media information container
				vmhd			8.11.2	video media header, overall information (video track only)
				smhd			8.11.3	sound media header, overall information (sound track only)
				hmhd			8.11.4	hint media header, overall information (hint track only)
				nmhd			8.11.5	Null media header, overall information (some tracks only)
				dinf		*	8.12	data information box, container
					dref	*	8.13	data reference box, declares source(s) of media data in track
				stbl		*	8.14	sample table box, container for the time/space map
					stsd	*	8.16	sample descriptions (codec types, initialization etc.)
					stts	*	8.15.2	(decoding) time-to-sample
					ctts		8.15.3	(composition) time to sample
					stsc	*	8.18	sample-to-chunk, partial data-offset information
					stsz		8.17.2	sample sizes (framing)
					stz2		2 8.17.3	compact sample sizes (framing)
					stco	*	8.19	chunk offset, partial data-offset information
					co64		8.19	64 -bit chunk offset
					stss		8.20	sync sample table (random access points)
					stsh		8.21	shadow sync sample table
					padb		8.23	sample padding bits
					stdp		8.22	sample degradation priority
					sdtp		8.40.2	independent and disposable samples
					sbgp		8.40.3.2	sample-to-group
					sgpd		8.40.3.3	sample group description
					subs		8.42	sub-sample information
	mvex						8.29	movie extends box
		mehd					8.30	movie extends header box
		trex				*	8.31	track extends defaults
	ipmc						8.45.4	IPMP Control Box
moof							8.32	movie fragment
	mfhd					*	8.33	movie fragment header
	traf						8.34	track fragment
		tfhd				*	8.35	track fragment header
		trun					8.36	track fragment run
		sdtp					8.40.2	independent and disposable samples
		sbgp					8.40.3.2	sample-to-group
		subs					8.42	sub-sample information
mfra							8.37	movie fragment random access
	tfra						8.38	track fragment random access
	mfro					*	8.39	movie fragment random access offset
mdat							8.2	media data container
free							8.24	free space
skip							8.24	free space
	udta						8.27	user-data
		cprt					8.28	copyright etc.
meta							8.44.1	metadata
	hdlr					*	8.9	handler, declares the metadata (handler) type
	dinf						8.12	data information box, container
		dref					8.13	data reference box, declares source(s) of metadata items
	ipmc						8.45.4	IPMP Control Box
	iloc						8.44.3	item location
	ipro						8.44.5	item protection
		sinf					8.45.1	protection scheme information box
			frma				8.45.2	original format box
			imif				8.45.3	IPMP Information box
			schm				8.45.5	scheme type box
			schi				8.45.6	scheme information box
	iinf						8.44.6	item information
	xml						8.44.2	XML container
	bxml						8.44.2	binary XML container
	pitm						8.44.4	primary item reference

VLC Media Player Source Code

The Github page for VLC Media Player is where to find the source code. The atoms can be seen to be defined in libmp4.h, here is an excerpt ...

#define ATOM_ftyp VLC_FOURCC( 'f', 't', 'y', 'p' )
#define ATOM_moov VLC_FOURCC( 'm', 'o', 'o', 'v' )

Also defined in the libmp4.h header file are the C structs ...

typedef struct MP4_Box_data_ftyp_s
{
    uint32_t i_major_brand;
    uint32_t i_minor_version;

    uint32_t i_compatible_brands_count;
    uint32_t *i_compatible_brands;

} MP4_Box_data_ftyp_t;

You can compare the above C code with my VBA code in Appendix A. In the vlc_libmp4.c implementation file you can see the actual code to populate the data structures. So for example, the following code populates the data structure given above.

static int MP4_ReadBox_ftyp( stream_t *p_stream, MP4_Box_t *p_box )
{
    MP4_READBOX_ENTER( MP4_Box_data_ftyp_t, MP4_FreeBox_ftyp );

    MP4_GETFOURCC( p_box->data.p_ftyp->i_major_brand );
    MP4_GET4BYTES( p_box->data.p_ftyp->i_minor_version );

    p_box->data.p_ftyp->i_compatible_brands_count = i_read / 4;
    if( p_box->data.p_ftyp->i_compatible_brands_count > 0 )
    {
        uint32_t *tab = p_box->data.p_ftyp->i_compatible_brands =
            vlc_alloc( p_box->data.p_ftyp->i_compatible_brands_count,
                       sizeof(uint32_t) );

        if( unlikely( tab == NULL ) )
            MP4_READBOX_EXIT( 0 );

        for( unsigned i = 0; i < p_box->data.p_ftyp->i_compatible_brands_count; i++ )
        {
            MP4_GETFOURCC( tab[i] );
        }
    }
    else
    {
        p_box->data.p_ftyp->i_compatible_brands = NULL;
    }

    MP4_READBOX_EXIT( 1 );
}

Use Unix Tool Grep in Windows

I'm very impressed with Windows Subsystem for Linux. I used Grep to search the VLC Media Player source code. I did this by pressing SHIFT and right mouse button clicking in a Windows Explorer window and taking the context menu option 'Open Linux shell here' and type in the following ("hdlr" was my search term, substitute for yours) ...

grep -rl hdlr

So Grep is a fantastic tool which is available to Windows 10 users. There are plenty of other great Unix tools as well, looking forward to using them for my everyday Windows tasks.

Appendix A - VBA Code to read DASH IV

The listing below is my admittedly buggy and work-in-progress code for parsing a DASH IV file. I'll confess that in places I have triaged the code to skip some bytes here and there on a 'fake it 'til you make it' basis. Given its bugs and triages this is definitely not production ready so absolutely no warranty. (As a matter of fact, all code on this blog carries no warranty and you use at your own risk). But writing this code forced me to research the problem and led me to discover the VLC Media Player source code. I give the code below for illustrative purposes.

For better source code one should look at the VLC Media Player source, detailed above.

Anyway at least one can get a handle on the nested nature on the data structure. Here is a screenshot of the locals window after the parsing is complete, you can see the nested atoms.

Option Explicit

Private fso As New Scripting.FileSystemObject

Private Type udtFtyp
    lSize As Long
    type As String * 4
    major_brand As String
    minor_version As Long
    compatible_brand As String
    compatible_brand2 As String
End Type

Private Type udtFree
    size As Long
    type As String * 4
    text As String
End Type

Private Type udtStco
    '* Chunk Offset Atom
    '* https://developer.apple.com/library/archive/documentation/QuickTime/QTFF/QTFFChap2/qtff2.html#//apple_ref/doc/uid/TP40000939-CH204-BBCHAEEA
    size As Long
    type As String * 4
    version As Byte
    flags As Long ' 3 bytes
    numberofentries As Long
End Type

Private Type udtStsz
    '* Sample Size Atom
    '* https://developer.apple.com/library/archive/documentation/QuickTime/QTFF/QTFFChap2/qtff2.html#//apple_ref/doc/uid/TP40000939-CH204-BBCBBCGB
    size As Long
    type As String * 4
    version As Byte
    flags As Long ' 3 bytes
    numberofentries As Long
End Type

Private Type udtStsc
    '* Sample-to-Chunk Atom
    '* https://developer.apple.com/library/archive/documentation/QuickTime/QTFF/QTFFChap2/qtff2.html#//apple_ref/doc/uid/TP40000939-CH204-BBCIDAFD
    size As Long
    type As String * 4
    version As Byte
    flags As Long ' 3 bytes
    numberofentries As Long
End Type

Private Type udtStsdSampleDescriptions
    size As Long
    dataformat As Long
    reserved(0 To 5)
    datareferenceindex As Integer
    additionaldata() As Byte
End Type

Private Type udtStsd
    '* Sample Description Atom
    '* https://developer.apple.com/library/archive/documentation/QuickTime/QTFF/QTFFChap2/qtff2.html#//apple_ref/doc/uid/TP40000939-CH204-BBCHHGBH
    size As Long
    type As String * 4
    version As Byte
    flags As Long ' 3 bytes
    numberofentries As Long
    sampleDescriptions() As udtStsdSampleDescriptions
End Type

Private Type udtStts
    '* Time-to-Sample Atom
    '* https://developer.apple.com/library/archive/documentation/QuickTime/QTFF/QTFFChap2/qtff2.html#//apple_ref/doc/uid/TP40000939-CH204-BBCGFJII
    size As Long
    type As String * 4
    version As Byte
    flags As Long ' 3 bytes
    numberofentries As Long
End Type

Private Type udtStbl
    '* Sample Table Atom
    '* https://developer.apple.com/library/archive/documentation/QuickTime/QTFF/QTFFChap2/qtff2.html#//apple_ref/doc/uid/TP40000939-CH204-BBCBFDFF
    type As String * 4
    stsd As udtStsd
    stts As udtStts
    stsc As udtStsc
    stsz As udtStsz
    stco As udtStco
End Type

Private Type udtDrefDetails
    size As Long
    type As String * 4
    version As Byte
    flags As Long ' 3 bytes
    data() As Byte
End Type

Private Type udtDref
    '* Data Reference Atom
    '* https://developer.apple.com/library/archive/documentation/QuickTime/QTFF/QTFFChap2/qtff2.html#//apple_ref/doc/uid/TP40000939-CH204-BBCGGDAE
    size As Long
    type As String * 4
    version As Byte
    flags As Long '3 bytes
    numberofentries As Long
    details() As udtDrefDetails
End Type

Private Type udtDinf
    '* Data Information Atom
    '* https://developer.apple.com/library/archive/documentation/QuickTime/QTFF/QTFFChap2/qtff2.html#//apple_ref/doc/uid/TP40000939-CH204-BBCIFAIC
    size As Long
    type As String * 4
    dref As udtDref
End Type

Private Type udtSmhd
    '* Sound Media Information Header Atom
    '* https://developer.apple.com/library/archive/documentation/QuickTime/QTFF/QTFFChap2/qtff2.html#//apple_ref/doc/uid/TP40000939-CH204-BBCHEIJG
    size As Long
    type As String * 4
    version As Byte
    flags As Long '3 bytes
    balance As Integer
    reserved As Integer
End Type

Private Type udtMinf
    '* Media Information Atoms
    '* https://developer.apple.com/library/archive/documentation/QuickTime/QTFF/QTFFChap2/qtff2.html#//apple_ref/doc/uid/TP40000939-CH204-25647
    type As String * 4
    smhd As udtSmhd
    dinf As udtDinf
    stbl As udtStbl
End Type

Private Type udtSoun
    '* Sound Data (Media Data Atom Type)
    '* https://developer.apple.com/library/archive/documentation/QuickTime/QTFF/QTFFChap2/qtff2.html#//apple_ref/doc/uid/TP40000939-CH204-BBCIBHFD
    size As Long
    type As String * 4
End Type

Private Type udtHdlr
    '* handler reference ('hdlr') atom (Media Atom)
    '* https://developer.apple.com/library/archive/documentation/QuickTime/QTFF/QTFFChap2/qtff2.html#//apple_ref/doc/uid/TP40000939-CH204-DontLinkElementID_147
    size As Long
    type As String * 4
    version As Byte
    flags As Long '3 bytes
    componenttype As String * 4
    componentsubtype As String * 4
    componentmanufacturer As Long
    componentflags As Long
    componentflagsmask As Long
    componentname As String
End Type

Private Type udtMdhd
    '* Media Header Atom
    '* https://developer.apple.com/library/archive/documentation/QuickTime/QTFF/QTFFChap2/qtff2.html#//apple_ref/doc/uid/TP40000939-CH204-SW34
    size As Long
    type As String * 4
End Type

Private Type udtMdia
    '* Media Atom
    '* https://developer.apple.com/library/archive/documentation/QuickTime/QTFF/QTFFChap2/qtff2.html#//apple_ref/doc/uid/TP40000939-CH204-BBCHFJFA
    type As String * 4
    mdhd As udtMdhd
    hdlr As udtHdlr
    soun As udtSoun
    minf As udtMinf
End Type

Private Type udtTkhd
    '* Track Header Atom
    '* https://developer.apple.com/library/archive/documentation/QuickTime/QTFF/QTFFChap2/qtff2.html#//apple_ref/doc/uid/TP40000939-CH204-BBCEIDFA
    size As Long
    type As String * 4
    version As Byte
    flags As Long '3 bytes
    creationtime As Long
    modificationtime As Long
    trackid As Long
    reserved0 As Long
    duration As Long
    reserved1(0 To 1) As Long
    layer As Integer
    alternationgroup As Integer
    volume As Integer
    Reserved2 As Integer
    matrixstructure(0 To 35) As Byte
    trackwidth As Long
    trackheight As Long
End Type

Private Type udtTrak
    '* Track Atom
    '* https://developer.apple.com/library/archive/documentation/QuickTime/QTFF/QTFFChap2/qtff2.html#//apple_ref/doc/uid/TP40000939-CH204-BBCBEAIF
    size As Long
    type As String * 4
    tkhd As udtTkhd
    mdia As udtMdia
End Type

Private Type udtMvhd
    '* Movie Header Atom
    '* https://developer.apple.com/library/archive/documentation/QuickTime/QTFF/QTFFChap2/qtff2.html#//apple_ref/doc/uid/TP40000939-CH204-BBCGFGJG
    size As Long
    type As String * 4
    version As Long
    flags As Long
    creationtime As Long
    modificationtime As Long
    timescale As Long
    duration As Long
    preferredrate As Long
    preferredvolume As Long
    reserved As String
    matrix As String
    previewtime As Long
    previewduration As Long
    postertime As Long
    selectiontime As Long
    selectionduration As Long
    currenttime As Long
    nexttrackid As Long
End Type

Private Type udtMoov
    '* Movie Atom
    '* https://developer.apple.com/library/archive/documentation/QuickTime/QTFF/QTFFChap2/qtff2.html#//apple_ref/doc/uid/TP40000939-CH204-55911
    size As Long
    type As String * 4
    mvhd As udtMvhd
    trak As udtTrak
End Type

Private Type udtWholeFile
    ftyp As udtFtyp
    free As udtFree
    moov As udtMoov
End Type

Dim wholefile As udtWholeFile

Private Sub Start()
    
    Dim sFileName As String
    
    sFileName = TEST_FILENAME

    Dim bytes() As Byte
    bytes() = ReadByteFile(sFileName)

    Dim idx As Long
    idx = Read_ftyp(bytes(), 0)
    idx = Read_free(bytes(), idx)
    idx = Read_moov(bytes(), idx)

End Sub

Private Function Read_ftyp(ByRef bytes() As Byte, ByVal lPosition As Long)
    Debug.Assert Chr$(bytes(lPosition + 4)) + Chr$(bytes(lPosition + 5)) + Chr$(bytes(lPosition + 6)) + Chr$(bytes(lPosition + 7)) = "ftyp"

    Dim sBuffer As String
    sBuffer = BytesToString(bytes, 50, (lPosition))

    wholefile.ftyp.lSize = 16777216# * bytes(lPosition) + 65536# * bytes(lPosition + 1) + 256# * bytes(lPosition + 2) + bytes(lPosition + 3)
    lPosition = lPosition + 8
    wholefile.ftyp.major_brand = BytesToString(bytes(), 4, lPosition)
    wholefile.ftyp.minor_version = BytesToLong(bytes(), 4, lPosition)
    wholefile.ftyp.compatible_brand = BytesToString(bytes(), 4, lPosition)
    wholefile.ftyp.compatible_brand2 = BytesToString(bytes(), 4, lPosition)


    Debug.Print "[ftyp] size=8+" & CStr(wholefile.ftyp.lSize - 8)
    Debug.Print "  major_brand = " & wholefile.ftyp.major_brand
    Debug.Print "  minor_version = " & wholefile.ftyp.minor_version
    Debug.Print "  compatible_brand = " & wholefile.ftyp.compatible_brand
    Debug.Print "  compatible_brand = " & wholefile.ftyp.compatible_brand2

    Read_ftyp = lPosition ' + wholefile.ftyp.lSize
End Function

Private Function Read_free(ByRef bytes() As Byte, ByVal lPosition As Long)
    Dim sBuffer As String
    sBuffer = BytesToString(bytes, 50, (lPosition))
    
    
    Debug.Assert Chr$(bytes(lPosition + 4)) + Chr$(bytes(lPosition + 5)) + Chr$(bytes(lPosition + 6)) + Chr$(bytes(lPosition + 7)) = "free"
    wholefile.free.size = 16777216# * bytes(lPosition) + 65536# * bytes(lPosition + 1) + 256# * bytes(lPosition + 2) + bytes(lPosition + 3)
    lPosition = lPosition + 8
    wholefile.free.text = BytesToString(bytes(), wholefile.free.size - 8, lPosition)

    Debug.Print "[free] size=8+" & CStr(wholefile.free.size - 8)
    Debug.Print "  text=" & wholefile.free.text

    Read_free = lPosition '+ wholefile.free.size
End Function

Private Function Read_moov(ByRef bytes() As Byte, ByVal lPosition As Long)
    
    Dim sBuffer As String
    sBuffer = BytesToString(bytes, 50, (lPosition))
    
    Debug.Assert Chr$(bytes(lPosition + 4)) + Chr$(bytes(lPosition + 5)) + Chr$(bytes(lPosition + 6)) + Chr$(bytes(lPosition + 7)) = "moov"

    wholefile.moov.size = 16777216# * bytes(lPosition) + 65536# * bytes(lPosition + 1) + 256# * bytes(lPosition + 2) + bytes(lPosition + 3)
    wholefile.moov.type = "moov"
    lPosition = lPosition + 8

    Debug.Print "[moov] size=8+" & CStr(wholefile.moov.size - 8)

    lPosition = Read_mvhd(bytes(), lPosition)   'mvhd element starts 8 bytes in, i.e. it is first child
    lPosition = Read_trak(bytes(), lPosition)

    Read_moov = lPosition
End Function



Private Function Read_mvhd(ByRef bytes() As Byte, ByVal lPosition As Long)
    Debug.Assert Chr$(bytes(lPosition + 4)) + Chr$(bytes(lPosition + 5)) + Chr$(bytes(lPosition + 6)) + Chr$(bytes(lPosition + 7)) = "mvhd"
    
    Dim lSize As Long
    lSize = 16777216# * bytes(lPosition) + 65536# * bytes(lPosition + 1) + 256# * bytes(lPosition + 2) + bytes(lPosition + 3)

    Dim idx As Long
    idx = lPosition
    
    'Dim sBuffer As String
    'sBuffer = BytesToString(bytes, lSize + 12, (idx))

    wholefile.moov.mvhd.size = lSize

    Debug.Print "[mvhd] size=8+" & CStr(lSize - 8)

    'https://developer.apple.com/library/archive/documentation/QuickTime/QTFF/QTFFChap2/qtff2.html#//apple_ref/doc/uid/TP40000939-CH204-BBCGFGJG

    idx = lPosition + 8
    wholefile.moov.mvhd.version = BytesToLong(bytes, 1, idx)
    wholefile.moov.mvhd.flags = BytesToLong(bytes, 3, idx)
    wholefile.moov.mvhd.creationtime = BytesToLong(bytes, 4, idx)
    wholefile.moov.mvhd.modificationtime = BytesToLong(bytes, 4, idx)
    wholefile.moov.mvhd.timescale = BytesToLong(bytes, 4, idx)
    wholefile.moov.mvhd.duration = BytesToLong(bytes, 4, idx)
    wholefile.moov.mvhd.preferredrate = BytesToLong(bytes, 4, idx)
    wholefile.moov.mvhd.preferredvolume = BytesToLong(bytes, 2, idx)
    wholefile.moov.mvhd.reserved = BytesToString(bytes, 10, idx)
    wholefile.moov.mvhd.matrix = BytesToString(bytes, 36, idx)
    wholefile.moov.mvhd.previewtime = BytesToLong(bytes, 4, idx)
    wholefile.moov.mvhd.previewduration = BytesToLong(bytes, 4, idx)
    wholefile.moov.mvhd.postertime = BytesToLong(bytes, 4, idx)
    wholefile.moov.mvhd.selectiontime = BytesToLong(bytes, 4, idx)
    wholefile.moov.mvhd.selectionduration = BytesToLong(bytes, 4, idx) '94
    wholefile.moov.mvhd.currenttime = BytesToLong(bytes, 4, idx)
    wholefile.moov.mvhd.nexttrackid = BytesToLong(bytes, 4, idx)

    Debug.Print "  version = " & wholefile.moov.mvhd.version
    Debug.Print "  flags = " & wholefile.moov.mvhd.flags
    Debug.Print "  creationtime = " & wholefile.moov.mvhd.creationtime
    Debug.Print "  modificationtime = " & wholefile.moov.mvhd.modificationtime
    Debug.Print "  timescale = " & wholefile.moov.mvhd.timescale
    Debug.Print "  duration = " & wholefile.moov.mvhd.duration
    Debug.Print "  preferredrate = " & wholefile.moov.mvhd.preferredrate
    Debug.Print "  preferredvolume = " & wholefile.moov.mvhd.preferredvolume
    Debug.Print "  reserved = " & wholefile.moov.mvhd.reserved
    Debug.Print "  matrix = " & wholefile.moov.mvhd.matrix
    Debug.Print "  previewtime = " & wholefile.moov.mvhd.previewtime
    Debug.Print "  previewduration = " & wholefile.moov.mvhd.previewduration
    Debug.Print "  postertime = " & wholefile.moov.mvhd.postertime
    Debug.Print "  selectiontime = " & wholefile.moov.mvhd.selectiontime
    Debug.Print "  selectionduration = " & wholefile.moov.mvhd.selectionduration
    Debug.Print "  currenttime = " & wholefile.moov.mvhd.currenttime
    Debug.Print "  nexttrackid = " & wholefile.moov.mvhd.nexttrackid
    'mvhd is a leaf atom and has no children

    Read_mvhd = lPosition + lSize
End Function

Private Function Read_trak(ByRef bytes() As Byte, ByVal lPosition As Long)
    lPosition = lPosition + 2  '* shim, fake it till we make it
    Debug.Assert Chr$(bytes(lPosition + 4)) + Chr$(bytes(lPosition + 5)) + Chr$(bytes(lPosition + 6)) + Chr$(bytes(lPosition + 7)) = "trak"
    Dim lSize As Long
    lSize = 16777216# * bytes(lPosition) + 65536# * bytes(lPosition + 1) + 256# * bytes(lPosition + 2) + bytes(lPosition + 3)
    
    wholefile.moov.trak.type = "trak"
    wholefile.moov.trak.size = lSize
    lPosition = lPosition + 8
    
    Debug.Print "[trak] size=8+" & CStr(lSize - 8)

    lPosition = Read_tkhd(bytes(), lPosition)   'tkhd element starts 8 bytes in, i.e. it is first child
    lPosition = Read_mdia(bytes(), lPosition)
    
    Read_trak = lPosition
End Function

Private Function Read_mdia(ByRef bytes() As Byte, ByVal lPosition As Long)
    Debug.Assert Chr$(bytes(lPosition + 4)) + Chr$(bytes(lPosition + 5)) + Chr$(bytes(lPosition + 6)) + Chr$(bytes(lPosition + 7)) = "mdia"
    Dim lSize As Long
    lSize = 16777216# * bytes(lPosition) + 65536# * bytes(lPosition + 1) + 256# * bytes(lPosition + 2) + bytes(lPosition + 3)

    wholefile.moov.trak.mdia.type = "mdia"
    
    lPosition = Read_mdhd(bytes(), lPosition + 8) 'mdhd element starts 8 bytes in, i.e. it is first child
    lPosition = Read_mdia_hdlr(bytes(), lPosition)
    lPosition = Read_minf(bytes(), lPosition)
    
    Read_mdia = lPosition
End Function

Private Function Read_mdhd(ByRef bytes() As Byte, ByVal lPosition As Long)
    Debug.Assert Chr$(bytes(lPosition + 4)) + Chr$(bytes(lPosition + 5)) + Chr$(bytes(lPosition + 6)) + Chr$(bytes(lPosition + 7)) = "mdhd"

    Dim lSize As Long
    lSize = 16777216# * bytes(lPosition) + 65536# * bytes(lPosition + 1) + 256# * bytes(lPosition + 2) + bytes(lPosition + 3)

    wholefile.moov.trak.mdia.mdhd.size = lSize
    wholefile.moov.trak.mdia.mdhd.type = "mdhd"
    
    Read_mdhd = lPosition + lSize
End Function

Private Function Read_minf(ByRef bytes() As Byte, ByVal lPosition As Long)
    lPosition = lPosition + 6
    Debug.Assert Chr$(bytes(lPosition + 0)) + Chr$(bytes(lPosition + 1)) + Chr$(bytes(lPosition + 2)) + Chr$(bytes(lPosition + 3)) = "minf"
    
    'Dim sBuffer As String
    'sBuffer = BytesToString(bytes, 50, (lPosition))

    wholefile.moov.trak.mdia.minf.type = "minf"
    '*https://developer.apple.com/library/archive/documentation/QuickTime/QTFF/QTFFChap2/qtff2.html#//apple_ref/doc/uid/TP40000939-CH204-25647
    lPosition = Read_smhd(bytes, lPosition + 4)
    lPosition = Read_dinf(bytes, lPosition)
    
    Read_minf = lPosition + 44
End Function

Private Function Read_dinf(ByRef bytes() As Byte, ByVal lPosition As Long)
    Debug.Assert Chr$(bytes(lPosition + 4)) + Chr$(bytes(lPosition + 5)) + Chr$(bytes(lPosition + 6)) + Chr$(bytes(lPosition + 7)) = "dinf"
    
    Dim lSize As Long
    lSize = 16777216# * bytes(lPosition) + 65536# * bytes(lPosition + 1) + 256# * bytes(lPosition + 2) + bytes(lPosition + 3)
    
    'Dim sBuffer As String
    'sBuffer = BytesToString(bytes, 50, (lPosition))
    
    wholefile.moov.trak.mdia.minf.dinf.size = lSize
    wholefile.moov.trak.mdia.minf.dinf.type = "dinf"
    
    lPosition = Read_dref(bytes, lPosition + 8)
    lPosition = Read_stbl(bytes, lPosition)
    
    Read_dinf = lPosition + lSize
End Function

Private Function Read_stbl(ByRef bytes() As Byte, ByVal lPosition As Long)
    lPosition = lPosition + 6
    'Dim sBuffer As String
    'sBuffer = BytesToString(bytes, 50, (lPosition))
    
    Debug.Assert Chr$(bytes(lPosition + 0)) + Chr$(bytes(lPosition + 1)) + Chr$(bytes(lPosition + 2)) + Chr$(bytes(lPosition + 3)) = "stbl"
    lPosition = Read_stsd(bytes(), lPosition + 4)
    lPosition = Read_stts(bytes(), lPosition)
    lPosition = Read_stsc(bytes(), lPosition)
    lPosition = Read_stsz(bytes(), lPosition)
    lPosition = Read_stco(bytes(), lPosition)

    Read_stbl = lPosition
End Function

Private Function Read_stsd(ByRef bytes() As Byte, ByVal lPosition As Long)
    Debug.Assert Chr$(bytes(lPosition + 4)) + Chr$(bytes(lPosition + 5)) + Chr$(bytes(lPosition + 6)) + Chr$(bytes(lPosition + 7)) = "stsd"

    Dim lSize As Long
    lSize = 16777216# * bytes(lPosition) + 65536# * bytes(lPosition + 1) + 256# * bytes(lPosition + 2) + bytes(lPosition + 3)

    'Dim sBuffer As String
    'sBuffer = BytesToString(bytes, 50, (lPosition))

    wholefile.moov.trak.mdia.minf.stbl.stsd.type = "stsd"
    wholefile.moov.trak.mdia.minf.stbl.stsd.size = lSize

    Dim idx As Long
    idx = lPosition + 8
    wholefile.moov.trak.mdia.minf.stbl.stsd.version = BytesToLong(bytes, 1, idx)
    wholefile.moov.trak.mdia.minf.stbl.stsd.flags = BytesToLong(bytes, 3, idx)
    Dim lEntries As Long
    lEntries = BytesToLong(bytes, 4, idx)
    
    wholefile.moov.trak.mdia.minf.stbl.stsd.numberofentries = lEntries

    If lEntries > 0 Then
        ReDim wholefile.moov.trak.mdia.minf.stbl.stsd.sampleDescriptions(0 To lEntries - 1)
        Dim lLoop As Long
        For lLoop = 0 To lEntries - 1
            Dim lDetailsSize As Long
            lDetailsSize = 16777216# * bytes(idx) + 65536# * bytes(idx + 1) + 256# * bytes(idx + 2) + bytes(idx + 3)
            
            wholefile.moov.trak.mdia.minf.stbl.stsd.sampleDescriptions(lLoop).size = lDetailsSize
            idx = idx + 4
            wholefile.moov.trak.mdia.minf.stbl.stsd.sampleDescriptions(lLoop).dataformat = BytesToLong(bytes, 4, idx)
            
            idx = idx + 6 ' reserved 6 bytes
            wholefile.moov.trak.mdia.minf.stbl.stsd.sampleDescriptions(lLoop).datareferenceindex = BytesToLong(bytes, 2, idx)
            
            Dim lDataSize As Long
            lDataSize = lDetailsSize - 24
            If lDataSize > 0 Then
                ReDim wholefile.moov.trak.mdia.minf.stbl.stsd.sampleDescriptions(lLoop).additionaldata(0 To lDataSize - 1)
                CopyBytes bytes(), wholefile.moov.trak.mdia.minf.stbl.stsd.sampleDescriptions(lLoop).additionaldata, idx, lDataSize
            End If
            idx = idx + lDataSize
        Next lLoop
    End If

    Read_stsd = lPosition + lSize
End Function

Private Function Read_stts(ByRef bytes() As Byte, ByVal lPosition As Long)
    lPosition = lPosition + 9 '* fake it till we make it
    Debug.Assert Chr$(bytes(lPosition + 4)) + Chr$(bytes(lPosition + 5)) + Chr$(bytes(lPosition + 6)) + Chr$(bytes(lPosition + 7)) = "stts"

    Dim lSize As Long
    lSize = 16777216# * bytes(lPosition) + 65536# * bytes(lPosition + 1) + 256# * bytes(lPosition + 2) + bytes(lPosition + 3)

    'Dim sBuffer As String
    'sBuffer = BytesToString(bytes, 50, (lPosition))

    wholefile.moov.trak.mdia.minf.stbl.stts.type = "stts"
    wholefile.moov.trak.mdia.minf.stbl.stts.size = lSize

    Dim idx As Long
    idx = lPosition + 8
    wholefile.moov.trak.mdia.minf.stbl.stts.version = BytesToLong(bytes, 1, idx)
    wholefile.moov.trak.mdia.minf.stbl.stts.flags = BytesToLong(bytes, 3, idx)
    Dim lEntries As Long
    lEntries = BytesToLong(bytes, 4, idx)
    
    wholefile.moov.trak.mdia.minf.stbl.stts.numberofentries = lEntries

    Read_stts = lPosition + lSize
End Function

Private Function Read_stsc(ByRef bytes() As Byte, ByVal lPosition As Long)
    Debug.Assert Chr$(bytes(lPosition + 4)) + Chr$(bytes(lPosition + 5)) + Chr$(bytes(lPosition + 6)) + Chr$(bytes(lPosition + 7)) = "stsc"

    Dim lSize As Long
    lSize = 16777216# * bytes(lPosition) + 65536# * bytes(lPosition + 1) + 256# * bytes(lPosition + 2) + bytes(lPosition + 3)


    'Dim sBuffer As String
    'sBuffer = BytesToString(bytes, 50, (lPosition))

    wholefile.moov.trak.mdia.minf.stbl.stsc.type = "stsc"
    wholefile.moov.trak.mdia.minf.stbl.stsc.size = lSize

    Dim idx As Long
    idx = lPosition + 8
    wholefile.moov.trak.mdia.minf.stbl.stsc.version = BytesToLong(bytes, 1, idx)
    wholefile.moov.trak.mdia.minf.stbl.stsc.flags = BytesToLong(bytes, 3, idx)
    Dim lEntries As Long
    lEntries = BytesToLong(bytes, 4, idx)
    
    wholefile.moov.trak.mdia.minf.stbl.stsc.numberofentries = lEntries


    Read_stsc = lPosition + lSize
End Function

Private Function Read_stsz(ByRef bytes() As Byte, ByVal lPosition As Long)
    Debug.Assert Chr$(bytes(lPosition + 4)) + Chr$(bytes(lPosition + 5)) + Chr$(bytes(lPosition + 6)) + Chr$(bytes(lPosition + 7)) = "stsz"

    Dim lSize As Long
    lSize = 16777216# * bytes(lPosition) + 65536# * bytes(lPosition + 1) + 256# * bytes(lPosition + 2) + bytes(lPosition + 3)

    'Dim sBuffer As String
    'sBuffer = BytesToString(bytes, 50, (lPosition))

    wholefile.moov.trak.mdia.minf.stbl.stsz.type = "stsz"
    wholefile.moov.trak.mdia.minf.stbl.stsz.size = lSize

    Dim idx As Long
    idx = lPosition + 8
    wholefile.moov.trak.mdia.minf.stbl.stsz.version = BytesToLong(bytes, 1, idx)
    wholefile.moov.trak.mdia.minf.stbl.stsz.flags = BytesToLong(bytes, 3, idx)
    Dim lEntries As Long
    lEntries = BytesToLong(bytes, 4, idx)
    
    wholefile.moov.trak.mdia.minf.stbl.stsz.numberofentries = lEntries

    Read_stsz = lPosition + lSize
End Function

Private Function Read_stco(ByRef bytes() As Byte, ByVal lPosition As Long)
    Debug.Assert Chr$(bytes(lPosition + 4)) + Chr$(bytes(lPosition + 5)) + Chr$(bytes(lPosition + 6)) + Chr$(bytes(lPosition + 7)) = "stco"

    Dim lSize As Long
    lSize = 16777216# * bytes(lPosition) + 65536# * bytes(lPosition + 1) + 256# * bytes(lPosition + 2) + bytes(lPosition + 3)

    'Dim sBuffer As String
    'sBuffer = BytesToString(bytes, 50, (lPosition))

    wholefile.moov.trak.mdia.minf.stbl.stco.type = "stco"
    wholefile.moov.trak.mdia.minf.stbl.stco.size = lSize

    Dim idx As Long
    idx = lPosition + 8
    wholefile.moov.trak.mdia.minf.stbl.stco.version = BytesToLong(bytes, 1, idx)
    wholefile.moov.trak.mdia.minf.stbl.stco.flags = BytesToLong(bytes, 3, idx)
    Dim lEntries As Long
    lEntries = BytesToLong(bytes, 4, idx)
    
    wholefile.moov.trak.mdia.minf.stbl.stco.numberofentries = lEntries
    
    Read_stco = lPosition + lSize
End Function

Private Function Read_dref(ByRef bytes() As Byte, ByVal lPosition As Long)
    Debug.Assert Chr$(bytes(lPosition + 4)) + Chr$(bytes(lPosition + 5)) + Chr$(bytes(lPosition + 6)) + Chr$(bytes(lPosition + 7)) = "dref"

    Dim lSize As Long
    lSize = 16777216# * bytes(lPosition) + 65536# * bytes(lPosition + 1) + 256# * bytes(lPosition + 2) + bytes(lPosition + 3)

    'Dim sBuffer As String
    'sBuffer = BytesToString(bytes, 50, (lPosition))
    
    wholefile.moov.trak.mdia.minf.dinf.dref.size = lSize
    wholefile.moov.trak.mdia.minf.dinf.dref.type = "dref"
    
    Dim idx As Long
    idx = lPosition + 8
    wholefile.moov.trak.mdia.minf.dinf.dref.version = BytesToLong(bytes, 1, idx)
    wholefile.moov.trak.mdia.minf.dinf.dref.flags = BytesToLong(bytes, 3, idx)
    Dim lEntries As Long
    lEntries = BytesToLong(bytes, 4, idx)
    
    wholefile.moov.trak.mdia.minf.dinf.dref.numberofentries = lEntries
    If lEntries > 0 Then
        ReDim wholefile.moov.trak.mdia.minf.dinf.dref.details(0 To lEntries - 1)
        Dim lLoop As Long
        For lLoop = 0 To lEntries - 1
            Dim lDetailsSize As Long
            lDetailsSize = 16777216# * bytes(idx) + 65536# * bytes(idx + 1) + 256# * bytes(idx + 2) + bytes(idx + 3)
            
            wholefile.moov.trak.mdia.minf.dinf.dref.details(lLoop).size = lDetailsSize
            wholefile.moov.trak.mdia.minf.dinf.dref.details(lLoop).type = _
                    Chr$(bytes(idx + 4)) + Chr$(bytes(idx + 5)) + Chr$(bytes(idx + 6)) + Chr$(bytes(idx + 7))
            idx = idx + 8
            wholefile.moov.trak.mdia.minf.dinf.dref.details(lLoop).version = BytesToLong(bytes, 1, idx)
            wholefile.moov.trak.mdia.minf.dinf.dref.details(lLoop).flags = BytesToLong(bytes, 3, idx)
            
            Dim lDataSize As Long
            lDataSize = lDetailsSize - 12
            If lDataSize > 0 Then
                Stop
                CopyBytes bytes(), wholefile.moov.trak.mdia.minf.dinf.dref.details(lLoop).data, idx, lDataSize
            End If
            idx = idx + lDataSize
        Next lLoop
    End If
    
    Read_dref = lPosition + lSize
End Function

Private Function Read_smhd(ByRef bytes() As Byte, ByVal lPosition As Long)
    'Dim sBuffer As String
    'sBuffer = BytesToString(bytes, 50, (lPosition))
    Dim lSize As Long
    lSize = 16777216# * bytes(lPosition) + 65536# * bytes(lPosition + 1) + 256# * bytes(lPosition + 2) + bytes(lPosition + 3)
    
    Debug.Assert Chr$(bytes(lPosition + 4)) + Chr$(bytes(lPosition + 5)) + Chr$(bytes(lPosition + 6)) + Chr$(bytes(lPosition + 7)) = "smhd"

    Dim idx As Long
    idx = lPosition + 8

    wholefile.moov.trak.mdia.minf.smhd.type = "smhd"
    wholefile.moov.trak.mdia.minf.smhd.size = lSize
    wholefile.moov.trak.mdia.minf.smhd.version = BytesToLong(bytes, 1, idx)
    wholefile.moov.trak.mdia.minf.smhd.flags = BytesToLong(bytes, 3, idx)
    wholefile.moov.trak.mdia.minf.smhd.balance = BytesToLong(bytes, 2, idx)
    wholefile.moov.trak.mdia.minf.smhd.reserved = BytesToLong(bytes, 2, idx)
    
    Read_smhd = lPosition + lSize
End Function

Private Function Read_mdia_hdlr(ByRef bytes() As Byte, ByVal lPosition As Long)
    lPosition = lPosition + 6 '* fake it 'til we make it
    'Dim sBuffer As String
    'sBuffer = BytesToString(bytes, 50, (lPosition))
    Debug.Assert Chr$(bytes(lPosition + 4)) + Chr$(bytes(lPosition + 5)) + Chr$(bytes(lPosition + 6)) + Chr$(bytes(lPosition + 7)) = "hdlr"

    Dim lSize As Long
    lSize = 16777216# * bytes(lPosition) + 65536# * bytes(lPosition + 1) + 256# * bytes(lPosition + 2) + bytes(lPosition + 3)

    wholefile.moov.trak.mdia.hdlr.size = lSize
    wholefile.moov.trak.mdia.hdlr.type = "hdlr"
    
    Dim idx As Long
    idx = lPosition + 8
    
    wholefile.moov.trak.mdia.hdlr.version = BytesToLong(bytes, 1, idx)
    wholefile.moov.trak.mdia.hdlr.flags = BytesToLong(bytes, 3, idx)
    wholefile.moov.trak.mdia.hdlr.componenttype = BytesToLong(bytes, 4, idx)
    wholefile.moov.trak.mdia.hdlr.componentsubtype = BytesToString(bytes, 4, idx)
    idx = idx + 12 'skip the reserved
    
    Dim sRemainder As String
    sRemainder = BytesToString(bytes, lPosition + lSize - idx, (idx))
    
    wholefile.moov.trak.mdia.hdlr.componentname = sRemainder
    
    Read_mdia_hdlr = lPosition + lSize
End Function

Private Function Read_tkhd(ByRef bytes() As Byte, ByVal lPosition As Long)

    Debug.Assert Chr$(bytes(lPosition + 4)) + Chr$(bytes(lPosition + 5)) + Chr$(bytes(lPosition + 6)) + Chr$(bytes(lPosition + 7)) = "tkhd"
    Dim lSize As Long
    lSize = 16777216# * bytes(lPosition) + 65536# * bytes(lPosition + 1) + 256# * bytes(lPosition + 2) + bytes(lPosition + 3)

    Dim idx As Long
    idx = lPosition + 8

    wholefile.moov.trak.tkhd.size = lSize
    wholefile.moov.trak.tkhd.type = "tkhd"
    wholefile.moov.trak.tkhd.version = BytesToLong(bytes, 1, idx)
    wholefile.moov.trak.tkhd.flags = BytesToLong(bytes, 3, idx)
    wholefile.moov.trak.tkhd.creationtime = BytesToLong(bytes, 4, idx)
    wholefile.moov.trak.tkhd.modificationtime = BytesToLong(bytes, 4, idx)
    wholefile.moov.trak.tkhd.trackid = BytesToLong(bytes, 4, idx)
    wholefile.moov.trak.tkhd.reserved0 = BytesToLong(bytes, 4, idx)
    wholefile.moov.trak.tkhd.duration = BytesToLong(bytes, 4, idx)
    wholefile.moov.trak.tkhd.reserved1(0) = BytesToLong(bytes, 4, idx)
    wholefile.moov.trak.tkhd.reserved1(1) = BytesToLong(bytes, 4, idx)
    wholefile.moov.trak.tkhd.layer = BytesToLong(bytes, 2, idx)
    wholefile.moov.trak.tkhd.alternationgroup = BytesToLong(bytes, 2, idx)
    wholefile.moov.trak.tkhd.volume = BytesToLong(bytes, 2, idx)
    wholefile.moov.trak.tkhd.Reserved2 = BytesToLong(bytes, 2, idx)
    
    idx = idx + CopyBytes(bytes, wholefile.moov.trak.tkhd.matrixstructure, idx, 36)
    
    wholefile.moov.trak.tkhd.trackwidth = BytesToLong(bytes, 4, idx)
    wholefile.moov.trak.tkhd.trackheight = BytesToLong(bytes, 4, idx)

    Debug.Print "[trak] size=8+" & CStr(lSize - 8)

    Read_tkhd = lPosition + lSize
End Function

Private Function CopyBytes(ByRef srcbytes() As Byte, ByRef destbytes() As Byte, ByVal lIdx As Long, ByVal cBytes As Long) As Long
    Dim x
    For x = 0 To cBytes - 1
        destbytes(x) = srcbytes(x)
    Next x
    
    CopyBytes = cBytes
End Function

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

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

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

Tuesday, 27 August 2019

VBA - Export a worksheet to CSV

I just had a need to export a worksheet to CSV (comma separated value) file and was surprised that one must create a new workbook and copy over the sheet. I would have thought Microsoft would have written a nice 'ExportToCSV' method by now. Anyway the code samples of StackOVerflow did not satisfy me so I wrote my own, here is my code.

Option Explicit

Sub TestExportSheetToCsv()
    Dim sDir As String
    sDir = "C:\Users\Simon\source\repos\PythonBaseHttpPlusQueryParams\PythonBaseHttpPlusQueryParams\"
    
    ExportSheetToCsv ThisWorkbook, sDir, "DomainToBrokerMap"
    ExportSheetToCsv ThisWorkbook, sDir, "BrokerQuerySelectors"
    ExportSheetToCsv ThisWorkbook, sDir, "MarketDataItems"
    ExportSheetToCsv ThisWorkbook, sDir, "BrokerDrilldown"
    
End Sub

Sub ExportSheetToCsv(ByVal wbSrc As Excel.Workbook, ByVal sDir As String, ByVal sSheetName As String)
    Application.ScreenUpdating = False
    Dim wbExport As Excel.Workbook
    Set wbExport = Workbooks.Add

    Dim wsExport As Excel.Worksheet
    Set wsExport = ThisWorkbook.Worksheets.Item(sSheetName)
    wsExport.Copy , wbExport.Worksheets.Item(1)

    Application.DisplayAlerts = False
    wbExport.Worksheets.Item(1).Delete
    Application.DisplayAlerts = True
    
    Dim sExportFileName As String
    sExportFileName = sDir & sSheetName & ".csv"
    
    If Len(Dir(sExportFileName)) > 0 Then
        Kill sExportFileName
        Debug.Assert Len(Dir(sExportFileName)) = 0
    End If
    
    wbExport.SaveAs sExportFileName, FileFormat:=xlCSV, CreateBackup:=False
    
    Debug.Print "Exported " & sExportFileName
    
    wbExport.Close False
    Application.ScreenUpdating = True
End Sub

Friday, 9 August 2019

VBA - New Python COM classes !

So by default the Python Com Gateway class does not ship an intrinsic type library; this is a shame because Python has its own reflection capabilities and could do so easily IMHO. The official sample gives and compiles an Interface Definition Language (IDL) file but one has to maintain the IDL in sync with one's class. In this post I give code that gets Python to reflect on a class and automate the writing and compiling of the IDL into a type library.

Once you have a type library then you can create objects in VBA by adding a Tools->Reference and using New instead of using CreateObject(), you will get Intellisense . You will also get the object propertles in the VBA Locals and Watch windows.

DesignatedWrapPolicy

In Python COM behaviour is driven by policies, we want a type library so we'll need to use a DesignatedWrapPolicy policy which fortunately is the default. The doc string is worth quoting as it gives a round up of the attributes we need to give a class to make a type library appear,_typelib_guid_ and _typelib_version. This is taken from doc string of the DesignatedWrapPolicy class in win32com/server/policy.py . The opening remarks of that file also detail what a policy is.

class DesignatedWrapPolicy(MappedWrapPolicy):
  """A policy which uses a mapping to link functions and dispid
     
     A MappedWrappedPolicy which allows the wrapped object to specify, via certain
     special named attributes, exactly which methods and properties are exposed.

     All a wrapped object need do is provide the special attributes, and the policy
     will handle everything else.

     Attributes:

     _public_methods_ -- Required, unless a typelib GUID is given -- A list
                  of strings, which must be the names of methods the object
                  provides.  These methods will be exposed and callable
                  from other COM hosts.
     _public_attrs_ A list of strings, which must be the names of attributes on the object.
                  These attributes will be exposed and readable and possibly writeable from other COM hosts.
     _readonly_attrs_ -- A list of strings, which must also appear in _public_attrs.  These
                  attributes will be readable, but not writable, by other COM hosts.
     _value_ -- A method that will be called if the COM host requests the "default" method
                  (ie, calls Invoke with dispid==DISPID_VALUE)
     _NewEnum -- A method that will be called if the COM host requests an enumerator on the
                  object (ie, calls Invoke with dispid==DISPID_NEWENUM.)
                  It is the responsibility of the method to ensure the returned
                  object conforms to the required Enum interface.

    _typelib_guid_ -- The GUID of the typelibrary with interface definitions we use.
    _typelib_version_ -- A tuple of (major, minor) with a default of 1,1
    _typelib_lcid_ -- The LCID of the typelib, default = LOCALE_USER_DEFAULT

     _Evaluate -- Dunno what this means, except the host has called Invoke with dispid==DISPID_EVALUATE!
                  See the COM documentation for details.
  """

Up until now all the Python COM gateway classes on this blog have used late binding with the public methods listed in _public_methods_ . The doc string says that for early binding this will not be required but I will still use _public_methods_ to tell which methods to place in the type library. So I retain _public_methods_ (contrary to the documentation).

Official sample, pippo.py

The official code sample given to us by the great Mark Hammond (eternal thanks). The code sample consists of an IDL file, pippo.idl and a Python script implementing the COM server, pippo_server.py. Here is the pippo class

class CPippo:
    #
    # COM declarations    
    #
    _reg_clsid_ = "{05AC1CCE-3F9B-4d9a-B0B5-DFE8BE45AFA8}"
    _reg_desc_ = "Pippo Python test object"
    _reg_progid_ = "Python.Test.Pippo"
    #_reg_clsctx_ = pythoncom.CLSCTX_LOCAL_SERVER    
    ###
    ### Link to typelib
    _typelib_guid_ = '{41059C57-975F-4B36-8FF3-C5117426647A}'
    _typelib_version_ = 1, 0
    _com_interfaces_ = ['IPippo']

    def __init__(self):
        self.MyProp1 = 10

    def Method1(self):
        return wrap(CPippo())

    def Method2(self, in1, inout1):
        return in1, inout1 * 2

And the given idl is thus

 [
  object,
  uuid(F1A3CC2E-4B2A-4A81-992D-67862076949B),
  dual,
  helpstring("IPippo Interface"),
  pointer_default(unique)
 ]
 interface IPippo : IDispatch
 {  
  [id(1), helpstring("method Method1")] HRESULT Method1([out, retval] IPippo **val);
  [propget, id(2), helpstring("property MyProp1")] HRESULT MyProp1([out, retval] long *pVal);
  [id(3), helpstring("method Method2")] HRESULT Method2([in] long in1, [in, out] long *inout1,
                                                        [out, retval] long *val);
 };

But as I said above, as given one would have to maintain the class and the IDL file in synchronization which is a little painful. So now I can add a little value here and give some code which will read a Python class and then write and compile an IDL file into a type library that is in sync which the original Python class.

My test class, FooBar (housed in AComGatewayClass.py)

So here is my test class call FooBar. I have added some type annotations to demonstrate these being defined in the type library. I have placed this into a script file called AComGatewayClass.py. To import one would write from AComGatewayClass import FooBar.

We still have a _public_methods_ attribute even though that is more for late-binding; I use it to determine which methods to write to the type library.

Also, I have invented a new attribute called _reg_itfid_ which is use to snap (fix) the guid of the interface, so don't expect official documentation for that!

class FooBar(object):
    
    _typelib_guid_ = "{92F288D0-4863-4030-A4EE-36DE63DB7664}"
    _typelib_version_ = 1,0
    _typelib_lcid_ = 0

    _reg_clsid_ = "{8B994B6B-0865-4D48-8A62-2EB97C291BDA}"
    _reg_itfid_ = "{B8FFDEFA-3EFB-4725-8CDD-1F6A9E35DD7C}"  ### I have invented this to snap the interface's guid the type library
    
    _reg_progid_ = 'MyPythonProject2.FooBar'
    _com_interfaces_ = ["_FooBar"]

    _reg_policy_spec_ = "DesignatedWrapPolicy" ### not strictly required as is already the default so key driver of functionality

    _public_attrs_ = ['MyProp1']
    _public_methods_ = ['Sum','NoArgs','Baz','Benjy']

    def __init__(self):
        self.MyProp1 = 10

    def Sum(self,a:float, b:float)->float:
        return a+b

    def NoArgs(self)  :
        pass

    def Baz(self,someString) -> str :
        someBoolean:bool=True
        if someBoolean:
            return "Hello " + someString 
        else:
            return "Goodbye " + someString 

    def Benjy(self,someInt:int, someDouble:float, untyped) -> int:
        pass

def RegisterThis():
    print("Registering COM servers...")
    import win32com.server.register
    win32com.server.register.UseCommandLine(FooBar)

if __name__ == '__main__':
    RegisterThis()

IdlWriter.py

So here is the code that will take a Python class and create a type library for it. It requires the MIDL launcher I gave in the previous post and I saved to a script file MidlLauncherHelper.py . The code has a little extra logic to examine an argument type and give the correct type in the IDL which carries through to the type library. There isn't a huge amount to see, it is all string concatenation to be honest.

import pythoncom
from MidlLauncherHelper import MidlLauncher


class IdlWriter(object):
    def PythonTypeToIDLType(self,annotations,argName:str) -> str:
        try:
            if argName in annotations:
                pythonargtype = annotations[argName]
                key2 = pythonargtype.__name__
                return {
                    'bool': "VARIANT_BOOL",
                    'str':"BSTR*",
                    'float':"double",
                    'int':"long",
                    '':"VARIANT*",
                    }[key2]
            else:
                return "VARIANT*"

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


    def IdlFullFilename(self,idlFilename:str)->str:
        import os
        try:
            this_dir = os.path.dirname(__file__)
            return os.path.abspath(os.path.join(this_dir, idlFilename))
        except Exception as e:
            print("Error: " + str(e) + "\n")

    def Main(self,library:str,typelib_guid,typelib_version,coclasses,idlFilename:str):
        try:
            IdlFullFilename = self.IdlFullFilename(idlFilename)
            idlSrc = self.InspectMyClass(library,typelib_guid,typelib_version,coclasses)
            with open(IdlFullFilename, "w+") as f:
                f.write(idlSrc)
            MidlLauncher.CompileTypelib(IdlFullFilename)
        except Exception as e:
            print("Error: " + str(e) + "\n")

    def InspectMyClass(self,library:str,typelib_guid,typelib_version,coclasses):
        import inspect
        import uuid
        try:

            idl = "// Generated .IDL file (by Python code)\n//\n// typelib filename: FooBar.tlb\n"
            idl = idl + "import \"oaidl.idl\";\nimport \"ocidl.idl\";\n"
            idl = idl + "import \"unknwn.idl\";\n"
            idl = idl + "[\n  uuid(" + typelib_guid[1:-1] + "),\n  version(" + str(typelib_version[0]) + "." + str(typelib_version[1]) + ")\n]\n"
            idl = idl + "library " + library + "\n{\n"
            idl = idl + "    // TLib :     // TLib : OLE Automation : {00020430-0000-0000-C000-000000000046}\n"
            idl = idl + "    importlib(\"stdole32.tlb\");\n"
            idl = idl + "    importlib(\"stdole2.tlb\");\n\n"
            idl = idl + "    importlib(\"stdole2.tlb\");\n\n"
            
            idl = idl + "    // Forward declare all types defined in this typelib\n"

            for coclass in coclasses:
                idl = idl + "    interface " + "_" + coclass.__name__ + ";\n"

            idl = idl + "\n"

            for coclass in coclasses:
                ### rewritten to mimic pippo.idl in the win32com\test directory
                idl = idl + "    [\n"
                idl = idl + "      object,\n"
                idl = idl + "      uuid(" + coclass._reg_itfid_[1:-1] + "),\n" 
                idl = idl + "      dual,\n"
                idl = idl + "      helpstring(\"test\"),\n"
                idl = idl + "      pointer_default(unique)\n"
                idl = idl + "    ]\n"
                
                
                idl = idl + "    interface " + "_" + coclass.__name__ + " : IDispatch {\n"

                method_list2 = inspect.getmembers(coclass, inspect.isfunction)
                dispid = 1  #start from 1 as zero equates to default member
                for meth in method_list2 :
                    if meth[0] in coclass._public_methods_:
                        idl = idl + "        [id(" + str(dispid) + ")]\n"
                        idl = idl + "        HRESULT " + meth[0] + "(\n"
                        fullArgSpec = inspect.getfullargspec(meth[1])
                        argc = len(fullArgSpec.args)
                        for argIdx in range(1, argc):
                            arg = fullArgSpec.args[argIdx]
                            argType = self.PythonTypeToIDLType(fullArgSpec.annotations,arg)
                            idl = idl + "        \t\t[in] " + argType + " " + arg + ",\n"

                        argType = self.PythonTypeToIDLType(fullArgSpec.annotations,"return")

                        idl = idl + "        \t\t[out, retval] " + argType + "* retval );\n"

                    dispid = dispid + 1

                if hasattr(coclass,'_public_attrs_'):
                    for attr in coclass._public_attrs_:
                        idl = idl + "        [id(" + str(dispid) + "), propget]\n"
                        idl = idl + "        HRESULT " + attr + "([out, retval] VARIANT *pVal);\n"

                        idl = idl + "        [id(" + str(dispid) + "), propput]\n"
                        idl = idl + "        HRESULT " + attr + "([in] VARIANT rhs);\n"

                idl = idl + "\n    };\n\n"
                idl = idl + "    [\n      uuid(" + coclass._reg_clsid_[1:-1] + "),\n      version(1.0)\n    ]\n"
                idl = idl + "    coclass " + coclass.__name__ + "{\n"
                idl = idl + "        [default] interface " + "_" + coclass.__name__ + ";\n"
                idl = idl + "    };\n"
            idl = idl + "};\n"

            print(idl)
            return idl

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

if __name__ == '__main__':
    from AComGatewayClass import FooBar
    idl = IdlWriter()
    idl.Main("MyPythonProject2",FooBar._typelib_guid_,FooBar._typelib_version_,[FooBar],"MyPythonProject2.idl")
    
    print("End of execution")

By the way, you can pass in more than one class, it is written to take a list of classes.

VBA Calling Code

So now we can New a Python class in VBA thus ...

Sub TestEarlyBound()
    On Error GoTo ErrHandler
    
    Dim obj As MyPythonProject2.FooBar
    Set obj = New MyPythonProject2.FooBar
    
    Debug.Print obj.Sum(1, -2)
    obj.MyProp1 = 256
    
    Stop  ' take a moment to admire the property MyProp1 in the Locals window, this would NOT appear without a type library
    Exit Sub
ErrHandler:
    Stop
    
End Sub

Enjoy!

Python MIDL Launcher

If you ever need worked with COM type libraries then you will have no doubt bumped in MIDL which is the Microsoft Interface Definition Language compiler. This is a command line tool but if you want to incorporate it into part of your build process you are going to need to shell or launch the process. I have given a C# launcher Midl here. Also I have given a windows batch file launcher here. Below I give a Python equivalent Midl launcher.

I find this code necessary because I need to alter the environment variables PATH and INCLUDE in order to get MIDL to work. The code below also goes on to load the newly create type library and then register it as this is the majority use case (feel free to omit if not appropriate).

import pythoncom

class MidlLauncher(object):
    @staticmethod
    def CompileTypelib(idlFullFileName):
        from distutils.dep_util import newer
        import os
        import subprocess
        try:
            tlb = os.path.splitext(idlFullFileName)[0] + '.tlb'
            if os.path.isfile(idlFullFileName): 

                if newer(idlFullFileName, tlb):

                    import subprocess, os
                    midl_env = os.environ.copy()
                    
                    midl_env["PATH"] = 'C:\\Program Files (x86)\\Microsoft Visual Studio 12.0\\VC\\bin\\;' + midl_env["PATH"]
                    mustInclude = ("C:\\Program Files (x86)\\Windows Kits\\10\\Include\\10.0.16299.0\\um\\;" + 
                                          "C:\\Program Files (x86)\\Windows Kits\\10\\Include\\10.0.16299.0\\shared\\;" +
                                          "C:\\Windows\\Microsoft.NET\\Framework\\v4.0.30319;" )
                    if "INCLUDE" in midl_env:
                        midl_env["INCLUDE"] = mustInclude + midl_env["INCLUDE"]
                    else:
                        midl_env["INCLUDE"] = mustInclude 

                    midl = subprocess.Popen(["C:\\Program Files (x86)\\Windows Kits\\10\\bin\\10.0.16299.0\\x86\\midl.exe", idlFullFileName, "/tlb" , tlb],env=midl_env)
                    midl.wait()

                    print("Registering %s" % (tlb,))
                    tli = pythoncom.LoadTypeLib(tlb)
                    pythoncom.RegisterTypeLib(tli,tlb)
        except Exception as e:
            print("Error: " + str(e) + "\n")

C++ code to debug/investigate COM class creation problems

With technology sometimes debugging and diagnostics are required, COM is no exception. Presently, I have been debugging a Python COM class that was not instantiating in VBA using the New keyword. That code works now, so watch out for a post on that soon. The following code was to be an appendix to that post but is useful in its own right so I am depositing it here.

Low level C++ Code to instantiate a COM Component

This code is to probe error messages of a COM component instantiation. VBA gives some error codes which are not necessarily useful. In VBA, when an object is created with the New keyword, 'under-the-hood' a call to CoCreateInstance is made, which in turn is made up of calls to CoGetClassObject to get a class factory and then a call to CreateInstance is called on the class factory. These steps which are implicit to VBA are given explicitly below in C++ so one can step through and better diagnose any errors.

In you want to use this code you will no doubt have to change CLSID_FooBar and IID_FooBar for your specific case.

Problems that can be examined with this technique include but are not limited to (a) registration issues, (b) path problems, (c) 32bit/64 bit mismatch problems.

The code is for a C++ console application.


#include <iostream>
#include "objbase.h"
#include <combaseapi.h>
#include <assert.h>

int main()
{
 ::CoInitialize(0);
 HRESULT hr = S_OK;

 GUID CLSID_FooBar;
 CLSIDFromString(L"{25F9C67B-8DBB-4787-AA84-D3D667ED0457}", &CLSID_FooBar);

 GUID IID_FooBar;
 CLSIDFromString(L"{B8FFDEFA-3EFB-4725-8CDD-1F6A9E35DD7C}", &IID_FooBar);

 GUID IID_IUnknown;
 CLSIDFromString(L"{00000000-0000-0000-c000-000000000046", &IID_IUnknown);

 GUID IID_IDispatch;
 CLSIDFromString(L"{00020400-0000-0000-c000-000000000046", &IID_IDispatch);

 GUID IID_IClassFactory;
 CLSIDFromString(L"{00000001-0000-0000-c000-000000000046", &IID_IClassFactory);

 IClassFactory *pFactoryFooBar;
 // CLSCTX_INPROC_SERVER |  CLSCTX_LOCAL_SERVER

 { // Test 1 Create the FooBar class via class factory requesting IUnknown 
  hr = ::CoGetClassObject(CLSID_FooBar, CLSCTX_INPROC_SERVER, NULL, IID_IClassFactory, reinterpret_cast<void**>(&pFactoryFooBar));
  assert(S_OK == hr);

  IUnknown *pUnkFooBar;
  hr = pFactoryFooBar->CreateInstance(NULL, IID_IUnknown, reinterpret_cast<void**>(&pUnkFooBar));
  assert(S_OK == hr);

  IUnknown *pFooBar;
  hr = pUnkFooBar->QueryInterface(IID_FooBar, reinterpret_cast<void**>(&pUnkFooBar));
  assert(S_OK == hr);

 }

 IDispatch *pDispFooBar;
 hr = CoCreateInstance(CLSID_FooBar, NULL, CLSCTX_INPROC_SERVER, IID_IDispatch,
  reinterpret_cast<void**>(&pDispFooBar));
 assert(S_OK == hr);

 // get disp id
 DISPID id = -1; //default
 LPOLESTR string = const_cast <LPOLESTR>(L"Sum");
 hr = pDispFooBar->GetIDsOfNames(IID_NULL, &string, DISPATCH_METHOD, LOCALE_USER_DEFAULT, &id);
 assert(S_OK == hr);

 UINT ctinfo = -1;
 hr = pDispFooBar->GetTypeInfoCount(&ctinfo);
 assert(S_OK == hr);

 ::CoUninitialize();

 
}

P.S. It is possible to drill down even further because many COM servers are implemented as DLLs, we could write code to load the DLL into memory and then manually get the entry point DllGetClassFactory and call into it to get the class factory manually. One for another day perhaps because at the moment I am working with Python which does not use Dlls in that sense (at least I don't think so)

Wednesday, 7 August 2019

VBA - Python - Type Library Finder - use reflection to find a late bound object's containing library

I love finding rare stuff that works in Excel VBA, this blog is full of it! I love finding new useful type libraries of classes which drive functionality I didn't know was possible for a VBA developer. They turn up infrequently on Stack Overflow and other forum websites. Often the sample code creates an object using late binding and not with the type library. When I discover one of these I instantly want to find the containing type library to see what else is in that library. Such an investigation requires

Looking up the ProgID (the text string passed to CreateObject()) to get a CLSID
Looking up the CLSID to get the LIBID, the type library's guid
Looking up the LIBID to get the type library's full name

So for example an interesting component is created with CreateObject("WIA.ImageFile") that has a clsid of {A2E6DDA0-06EF-4df3-B7BD-5AA224BB06E8}, and type library guid of {94A0E92D-43C0-494E-AC29-FD45948A5221} which has the full name of Microsoft Windows Image Acquisition Library v2.0.

Combing though the registry is a pain so fortunately we can write some Python code and use the reflection interfaces, ITypeInfo and ITypeLib which are usually restricted to C++ developers but which Python developers have access to and in turn we can expose to Excel VBA code.

Below is a Python COM Gateway class, I have supplied many examples on this blog so the procedure should be familiar (to regular readers at least). But to recap you need to run the following script with adminstrator privileges from a command console. Once registered, the class becomes creatable from VBA using CreateObject.

class WhichTypeLibrary(object):
    _reg_clsid_ = "{521B0A5A-4359-4874-AA9E-8F99DB35F4A6}"
    _reg_progid_ = 'PythonInVBA.WhichTypeLibrary'
    _public_methods_ = ['ReportTypeLibrary'] 

    def ReportTypeLibrary(self, o):
        try:
            pt = str(type(o))
            if pt == "<class 'win32com.client.CDispatch'>":
                ti = o._lazydata_[0]
            elif pt == "<class 'PyIDispatch'>" :
                ti = o.GetTypeInfo()
            else:
                return "Error, cannot get ITypeInfo interface."

            typelib = ti.GetContainingTypeLib()[0]

            return (typelib.GetDocumentation(-1)[0] + ":\t\t" +  typelib.GetDocumentation(-1)[1] )

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

def RegisterThis():
    print("Registering COM servers...")
    import win32com.server.register
    win32com.server.register.UseCommandLine(WhichTypeLibrary)


if __name__ == '__main__':
    RegisterThis()
    print("End of execution")

VBA Client Code

So the calling VBA code is shown below. It shows passing a Workbook object to the library finder which correctly reports it as belonging the Excel type library (that's obvious but it proves the logic is working). A second object is created which is far rarer (certainly I'd not heard of it) and the Python code correctly reports the library prefix, WIA, and the library description, 'Microsoft Windows Image Acquisition Library v2.0', which can then be found in the Tools References dialog box.

Option Explicit

Sub Test()
    On Error GoTo ErrHandler
    Dim oLibFinder As Object
    Set oLibFinder = CreateObject("PythonInVBA.WhichTypeLibrary")
    
    '* a simple example, find the containing type library of a Workbook, should print "Excel:      Microsoft Excel 15.0 Object Library"
    Debug.Print oLibFinder.ReportTypeLibrary(ThisWorkbook)
    
    '* a rarer example, should print "WIA:        Microsoft Windows Image Acquisition Library v2.0"
    Dim obj As Object
    Set obj = CreateObject("WIA.ImageFile")
    
    Debug.Print oLibFinder.ReportTypeLibrary(obj)
    
SingleExit:
    Exit Sub
ErrHandler:
    Debug.Print Err.Description
    Stop
    'Resume
    
End Sub

So the above program prints...

Excel:      Microsoft Excel 15.0 Object Library
WIA:        Microsoft Windows Image Acquisition Library v2.0

Factoid - ProgIDs have limit of 39 characters

What's Next, can the above Python class report on itself? No (or at least not yet).

If you are a little cheeky and wondered what would happen if you pass the library finder class itself to see what it said you would get an error.

Error: (-2147352567, 'Exception occurred.', None, None)

This is because the standard Python COM Gateway class carries no type information by default. It is capable of shipping type information is you associate it with a type library but then the type library needs to agree with the Python source. We can write some code to read a Python class and generate a type library and that will be the subject of the next post.

Sunday, 21 July 2019

VBA - Anonymous objects

Advert: Come to the Foo Bar! See a whole working application based on Excel VBA, JSON, JavaScript, Angular with help of a beauty of C# COM Addin. The Foo Bar where the beers are easily replenished with Angular.

So in Java, C# and other object orientated languages one has the capability to create an object without assigning to a variable, call a method on it and then throw it away in a tight little block of code. The line of code would look something like this...

{  
   print((new Class1).Greeting);
}

This is called an anonymous object. If you tried this in VBA you would get a syntax error

Sub SyntaxError()
    '* the following line appears in red as a syntax error
    Debug.Print ((New Class1).Greeting)
End Sub

Where Class1 is a trivial class

Public Function Greeting()
    Greeting = "Hello world"
End Function

What is interesting is that VBA does allow the creation of an object on the fly when passing an argument thus...

Sub PassNewlyCreated()
    Bar New Class1
End Sub

Sub Bar(obj As Object)
    Debug.Print obj.Greeting
End Sub

So we can pull a trick here. If we define a function which simply passes an object on then we can get closer to the anonymous object syntax given at the top of this post. We'll call that function Anon() ...

Sub UseAnAnonymousObject()
    Debug.Print (Anon(New Class1).Greeting)
End Sub

Function Anon(obj As Object) As Object
    Set Anon = obj
End Function

Just some syntactic sugar for you there.

Tuesday, 16 July 2019

VBA - Shelling Microsoft Edge and other Protocol Activation

Just a quickie, Microsoft Edge is a new generation windows app and is activated using a protocol. So from the command line we go

start microsoft-edge:http://www.cnn.com

And this launches Microsoft Edge with a new tab with CNN web page inside. But tring to shell to this using VBA gives the error file not found. What is required is to add the command specifier C:\WINDOWS\system32\cmd.exe which is also set as the environment variable comspec. So now we can shell from VBA if we precede with the comspec thus ...

Sub ShellMicrosoftEdge()
    VBA.Shell Environ$("comspec") & " /c start microsoft-edge:http://www.cnn.com"
End Sub

Python code

For a bonus we can read this trick across to Python code. Again add the comspec ...

import os 
from subprocess import Popen

browserJob=Popen([os.environ['comspec'],'/c','start' , 'microsoft-edge:http://www.cnn.com' ])

Thoughts

As these new activation protocols proliferate with Window 8 onwards apps, don't worry it is still possible to launch/shell in a traditional manner. The links below give some further reading.

Friday, 28 June 2019

VBA - Shell a VBScript if you want multi-tasking

Whilst VBA cannot multi-thread, you can always shell to a script. You have many options for choice of script language. If you have already written some logic in VBA then you can easily convert to VBScript. The following script below will download a binary file using an XHR.

I wrote the code in VBA to begin with and debugged it until I was happy. Then I converted to VBScript. The hallmarks of a VBScript are

the absence of type clauses in Dim statements
one has to use WScript.CreateObject instead of VBA.CreateObject or New
no support for constants, so one has to use the literals themselves, typically we put the name in a comment above

The script also has extra proxy logic for that is the use case I am working on but you can take that out. For the time being it serves as an example of how constants have to be passed as literals.

So save the file below as wget.vbs

Dim xhr
set xhr = WScript.CreateObject("WinHttp.WinHttpRequest.5.1")
Call xhr.SetClientCertificate("LOCAL_MACHINE\Personal\My Certificate")

''WinHttp.WinHttpRequestOption_SslErrorIgnoreFlags=4
''WinHttp.WinHttpRequestSslErrorFlags.SslErrorFlag_Ignore_All=13056
xhr.Option(4) = 13056

'Const HTTPREQUEST_PROXYSETTING_PROXY As Long = 2
xhr.setProxy 2, "127.0.0.1:8888", ""

call xhr.Open("GET", WScript.Arguments(0), False)
xhr.setRequestHeader "Referrer-Policy", "no-referrer"
xhr.setRequestHeader "User-Agent", "Mozilla/5.0 (Windows NT 10.0; Win64; x64) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/74.0.3729.169 Safari/537.36"
call xhr.Send()



Dim strm
Set strm = WScript.CreateObject("ADODB.Stream")
strm.Type = 1
Call strm.Open()
Call strm.Write(xhr.ResponseBody)

Call strm.SaveToFile(WScript.Arguments(1))
Call strm.Close()

In the same directory save a new workbook then add the following code to call from VBA. Supply web url as the first argument and destination filename (e.g. somewhere in Temp) and the second argument. You can in the script above how it acquires the arguments using WScript.Arguments(0|1)

Sub TestShell()
    
    Dim sShell As String
    sShell = "cscript " & ThisWorkbook.Path & "\wget.vbs https://duckduckgo.com/ " & Environ("temp") & "\wget_example.txt"
    Debug.Print "Shelling" & vbNewLine & sShell
    VBA.Shell sShell
    
End Sub

The only downside to this is that one cannot return variables easily. Often a script will write to a log where the caller can inspect to determine success/error.

Thursday, 6 June 2019

Reflecting over a VBA Project and distinguishing between classes and documents modules

Welcome to another blog post in a series on the lesser known COM reflection APIs , ITypeLib and ITypeInfo, which are usually the preserve of C++ programmers but with the thanks of a great Python library, PythonCOM become readily accessible to VBA developers. In this post I am going to examine the anatomy of an Excel workbook VBA project.

You advised to read the prior posts in this series as they gently introduce this large topic with some interesting use cases. Those posts also have videos!

VBA Projects have document modules whereas VB6 projects don't

So VB6 developers have always been able to create a COM server Dll. The entry points for this are classes, but classes implement interfaces and when reading a type library one gets hold of a class's type information but to see the methods on which a class can be called one has to hop to the interface type information and read the methods information from the interface.

VBA developers cannot create a COM server Dll. However, it is surprising that VBA projects ship a whole type library implementation. With such type information client code written in C# can happily interact with VBA classes using COM interop technology.

However, matters are muddied because a VB6 project does not have any document classes like a VBA project does. So, VBA has a ThisWorkbook module which can contain code. Also, each worksheet can contain code in a 'code-behind' style. In this post, I poke around an Excel Workbook's VBA Project to see the distinguishing features. We need to learn how to do this so that we can acknowledge how code can live in the ThisWorkbook module and the worksheet code behind modules.

Our Test Workbook

So to set up the experiment we need to add some code. We need to add 3 class modules, CMyClass, CPolymorphicClass and ISnafu (which will act as an interface). We add code to these class modules. Also we add code to the ThisWorkbook module and to the Sheet1 "code-behind' module. The listings are given below along with a screenshot of the test workbook in the project explorer

No code is given for the UserForm1 but it is here to show that there is no type library information for it! Also I have skipped the code for the modPython module (actually it is given below). Standard modules are also (along with forms) invisible in terms of type library information. Also invisible are classes that have Instancing type "1 - Private", so make sure the instancing is set to "2 - PublicNotCreatable" where instructed.

Sheet1 (code-behind) module

Option Explicit

Function SomeLogic()
    'just a method signature
End Function

ThisWorkbook module

Option Explicit

Public Sub Workbook_Open()
    Application.Goto "ThisWorkbook.Test"
End Sub

Public Sub Test()
    'No code here
End Sub

CMyClass class module

You need to set the instancing to 2 - PublicNotCreatable

Option Explicit

Public Function Foo() As Long
    Foo = 42
End Function

Public Sub SayHi()
    MsgBox "hi"
End Sub

CPolymorphicClass class module

You need to set the instancing to 2 - PublicNotCreatable

Option Explicit

Implements ISnafu

Private Function ISnafu_SituationReport() As String
    ISnafu_SituationReport = "Normal"
End Function

ISnafu class module (will act as an interface)

You need to set the instancing to 2 - PublicNotCreatable

Option Explicit

Public Function SituationReport() As String

End Function

Reporting on the VBA Project's types

So its time to give the first pass of our reporting program which gives top level information for each of the ten type information artefacts in our VBA project. In the list below we give (i) the index (ii) the artefact's name (iii) artefact type (coclass, interface, dispinterface) (iv) the count of functions (v) the count of implemented types (vi) type flags and finally (vii) a GUID.

Just to note, a dispinterface is a dispatch-interface as opposed to a virtual function table or v-table interface; a v-table interface is reported just as "interface" and we'll meet this later. Sometimes, a classes implement a dual interface which has both virtual function table layout as well as the dispatch mechanism, inheriting from IDispatch. All VBA classes implement dual interfaces.

In case you didn't know. In COM, a COM class (or coclass) implements interfaces which are defined separately. In VBA (and VB6 & VB.NET), this separation between coclass and interface is kept hidden, usually the hidden interface has the name of the class but prepended with an underscore. So in the report below, Sheet1 coclass implements the _Sheet1 interface. The naming convention below is slightly broken in that the CMyClass coclass implements an interface of the same name, however you can see that hidden flag is missing so we could code around this. (Later, I'll show how to navigate from a coclass to its interface without the naming convention).

Other points of note are how the document classes, ThisWorkbook and Sheet1, as well as their interfaces, have the predeclid flag but this isn't enough to identify the document classes because we can pull a trick to make a VBA class static and so VBA classes can also have this predeclid flag.

If we look at cFuncs, the count of functions, then the _ThisWorkbook interface has 265, presumable 2 of these are the ones we added, but can we be sure? The CMyClass dispinterface reports 2 functions so this makes sense.


0. VBAProject._ThisWorkbook dispinterface cFuncs:265 cImplTypes:1 {predeclid hidden dual nonextensible oleautomation} {C0360BCF-E003-4C03-BC75-8F360DC36111}

1. VBAProject.ThisWorkbook coclass cFuncs:0 cImplTypes:1 {predeclid nonextensible} {BC5E6E4A-879E-4070-98BC-DCC7D4B374D4}

2. VBAProject._Sheet1 dispinterface cFuncs:146 cImplTypes:1 {predeclid hidden dual nonextensible oleautomation} {80868766-E6A2-4624-8DF7-C4580704534D}

3. VBAProject.Sheet1 coclass cFuncs:0 cImplTypes:1 {predeclid nonextensible} {037A1A58-A8B4-421C-B8A6-4754CA7E27F0}

4. VBAProject.CMyClass dispinterface cFuncs:2 cImplTypes:1 {cancreate dual nonextensible oleautomation} {A802C7A7-3554-4DDC-8D92-39181054A2EB}

5. VBAProject.CMyClass coclass cFuncs:0 cImplTypes:1 {cancreate nonextensible} {0991D6B1-19C9-48C0-B4FC-90902BB7762B}

6. VBAProject._CPolymorphicClass dispinterface cFuncs:0 cImplTypes:1 {cancreate hidden dual nonextensible oleautomation} {0E2D9B97-0524-4A45-B26A-5D5973E9B88A}

7. VBAProject.CPolymorphicClass coclass cFuncs:0 cImplTypes:1 {cancreate nonextensible} {61F0CE30-560F-46EB-B484-65DF3B1103B9}

8. VBAProject._ISnafu dispinterface cFuncs:1 cImplTypes:1 {cancreate hidden dual nonextensible oleautomation} {6BACFCE0-67A1-42CE-8C1F-99CC054B2D89}

9. VBAProject.ISnafu coclass cFuncs:0 cImplTypes:1 {cancreate nonextensible} {A8097492-6617-47B8-8101-A487E1682214}

So we are slightly wiser as how to get the methods of a VBA class but no closer to being able to get the user added methods of the documents classes. We need more information.

Adding the referenced/implemented types

The token cImplTypes stands for count of implemented types. This tells us if we can call ITypeInfo::GetRefTypeOfImplType and ITypeInfo::GetRefTypeInfo methods to report references type descriptions. The docs are worth quoting

If a type description describes a COM class, it retrieves the type description of the implemented interface types. For an interface, GetRefTypeOfImplType returns the type information for inherited interfaces, if any exist.

It is interesting that requesting this extra information is a two step process. We call ITypeInfo::GetRefTypeOfImplType first which returns a number and then pass this number to ITypeInfo::GetRefTypeInfo. I've added this number to the report because it will matter later. In the meantime, for coclasses ITypeInfo::GetRefTypeOfImplType returns the index number of the interface. For the dispinterfaces, ITypeInfo::GetRefTypeOfImplType returns -1 and this then retrieves the IDispatch interface. Remember, for coclasses we get the implemented interface, but for interfaces we get the inherited interface.

I've added an extra line to the report to represent calls to ITypeInfo::GetRefTypeOfImplType (result in brackets) and then ITypeInfo::GetRefTypeInfo. These extra lines all start with 0: because for each cImplTypes=1 and it is zero-based. The code could handle multiple types, in theory.

I've also used colouring so now we can see the coclasses tieing up with the interfaces.


0. VBAProject._ThisWorkbook dispinterface cFuncs:265 cImplTypes:1 {predeclid hidden dual nonextensible oleautomation} 
   0:(-1)stdole.IDispatch interface cFuncs:4 cImplTypes:1 {restricted} 

1. VBAProject.ThisWorkbook coclass cFuncs:0 cImplTypes:1 {predeclid nonextensible} 
   0:(0)VBAProject._ThisWorkbook 

2. VBAProject._Sheet1 dispinterface cFuncs:146 cImplTypes:1 {predeclid hidden dual nonextensible oleautomation} 
   0:(-1)stdole.IDispatch 

3. VBAProject.Sheet1 coclass cFuncs:0 cImplTypes:1 {predeclid nonextensible} 
   0:(2)VBAProject._Sheet1 

4. VBAProject.CMyClass dispinterface cFuncs:2 cImplTypes:1 {cancreate dual nonextensible oleautomation} 
   0:(-1)stdole.IDispatch 

5. VBAProject.CMyClass coclass cFuncs:0 cImplTypes:1 {cancreate nonextensible} 
   0:(4)VBAProject.CMyClass 

6. VBAProject._CPolymorphicClass dispinterface cFuncs:0 cImplTypes:1 {cancreate hidden dual nonextensible oleautomation} 
   0:(-1)stdole.IDispatch 

7. VBAProject.CPolymorphicClass coclass cFuncs:0 cImplTypes:1 {cancreate nonextensible} 
   0:(6)VBAProject._CPolymorphicClass 

8. VBAProject._ISnafu dispinterface cFuncs:1 cImplTypes:1 {cancreate hidden dual nonextensible oleautomation} 
   0:(-1)stdole.IDispatch 

9. VBAProject.ISnafu coclass cFuncs:0 cImplTypes:1 {cancreate nonextensible} 
   0:(8)VBAProject._ISnafu

So the report looks a little more fleshed out. But we are no further to detecting the methods within the ThisWorkbook and Sheet1 code modules. What else can we do? Well, also as per the Microsoft Docs, in the Remarks sections it says

If the TKIND_DISPATCH type description is for a dual interface, the TKIND_INTERFACE type description can be obtained by calling GetRefTypeOfImplType with an indexof –1, and by passing the returned pRefTypehandle to GetRefTypeInfo to retrieve the type information

All VBA classes have dispinterfaces which are dual, meaning a blend of a vtable and a dispatch based interface, so the above remark applies. So let's add more lines to the report.

So jackpot! We can now detect that the ThisWorkbook modules does indeed have two user added functions (methods) so it must be straightforward to acquire the method info for these. Likewise, we can see the extra reported line for _Sheet1 interface has a cFuncs of 1, so that singleton method also must be easy to query.


0. VBAProject._ThisWorkbook dispinterface cFuncs:265 cImplTypes:1 {predeclid hidden dual nonextensible oleautomation} 
  -1:(-3)VBAProject._ThisWorkbook interface cFuncs:2 cImplTypes:1 {predeclid hidden dual nonextensible oleautomation} 
   0:(-1)stdole.IDispatch interface cFuncs:4 cImplTypes:1 {restricted} 

1. VBAProject.ThisWorkbook coclass cFuncs:0 cImplTypes:1 {predeclid nonextensible} 
   0:(0)VBAProject._ThisWorkbook 

2. VBAProject._Sheet1 dispinterface cFuncs:146 cImplTypes:1 {predeclid hidden dual nonextensible oleautomation} 
  -1:(-3)VBAProject._Sheet1 interface cFuncs:1 cImplTypes:1 {predeclid hidden dual nonextensible oleautomation} 
   0:(-1)stdole.IDispatch 

3. VBAProject.Sheet1 coclass cFuncs:0 cImplTypes:1 {predeclid nonextensible} 
   0:(2)VBAProject._Sheet1 

4. VBAProject.CMyClass dispinterface cFuncs:2 cImplTypes:1 {cancreate dual nonextensible oleautomation} 
  -1:(-3)VBAProject.CMyClass interface cFuncs:2 cImplTypes:1 {cancreate dual nonextensible oleautomation} 
   0:(-1)stdole.IDispatch 

5. VBAProject.CMyClass coclass cFuncs:0 cImplTypes:1 {cancreate nonextensible} 
   0:(4)VBAProject.CMyClass 

6. VBAProject._CPolymorphicClass dispinterface cFuncs:0 cImplTypes:1 {cancreate hidden dual nonextensible oleautomation} 
  -1:(-3)VBAProject._CPolymorphicClass interface cFuncs:0 cImplTypes:1 {cancreate hidden dual nonextensible oleautomation} 
   0:(-1)stdole.IDispatch 

7. VBAProject.CPolymorphicClass coclass cFuncs:0 cImplTypes:1 {cancreate nonextensible} 
   0:(6)VBAProject._CPolymorphicClass 

8. VBAProject._ISnafu dispinterface cFuncs:1 cImplTypes:1 {cancreate hidden dual nonextensible oleautomation} 
  -1:(-3)VBAProject._ISnafu interface cFuncs:1 cImplTypes:1 {cancreate hidden dual nonextensible oleautomation} 
   0:(-1)stdole.IDispatch 

9. VBAProject.ISnafu coclass cFuncs:0 cImplTypes:1 {cancreate nonextensible} 
   0:(8)VBAProject._ISnafu

One last thing to show you

Okay, but how about the problem of identifying the document classes. First, let me show you some code which uses the Microsoft Visual Basic for Applications Extensibility 5.3 library, this will report which modules are document modules, denoted by 100. Note, that users can change the codename of Sheet1 to, for example, shFoo and ThisWorkbook to, for example, MyApp but they cannot change the VBComponent.Type property. So this is one way (a good way) of detecting document modules.

Sub ListModuleTypes()
    '* Requires tools reference to
    '* Microsoft Visual Basic for Applications Extensibility 5.3
    Dim prj As VBIDE.VBProject
    Set prj = ThisWorkbook.VBProject
    
    Dim vbc As VBIDE.VBComponent
    For Each vbc In prj.VBComponents
        Debug.Print vbc.Name, vbc.Type
    Next vbc

End Sub

Output for the above project

ThisWorkbook       100 
Sheet1             100 
CMyClass           2 
CPolymorphicClass  2 
ISnafu             2 
UserForm1          3 
modPython          1 
modTrash           1

But I am itching to show you something I discovered quite by accident. When writing code to call the ITypeInfo::GetRefTypeOfImplType and ITypeInfo::GetRefTypeInfo methods I accidentally passed 0 to the second and got back undocumented results. I've have selectively added these to the report, only the dispinterfaces. I believe they return a dispinterface's internal base class (if that makes any terminology sense!)

So for our VBA classes' dispinterface, passing zero returns "VBInternal.DClass". For the ThisWorkbook module's dispinterface, passing zero returns Excel._Workbook (along with its cannonical GUID). Equally, for the Sheet1 module's dispinterface, passing zero returns "Excel._Worksheet". So these are hard coded strings that cannot be renamed like the modules' codenames. Very useful and something we can code against without resorting the the Visual Basic for Applications Extensibility interface above.

I've marked the extra lines with the ^ symbol ...


0. VBAProject._ThisWorkbook dispinterface cFuncs:265 cImplTypes:1 {predeclid hidden dual nonextensible oleautomation} 
  -1:(-3)VBAProject._ThisWorkbook interface cFuncs:2 cImplTypes:1 {predeclid hidden dual nonextensible oleautomation} 
   0:(-1)stdole.IDispatch interface cFuncs:4 cImplTypes:1 {restricted} 
   ^:Excel._Workbook interface cFuncs:263 cImplTypes:1 {dual oleautomation dispatchable} {000208DA-0000-0000-C000-000000000046}

1. VBAProject.ThisWorkbook coclass cFuncs:0 cImplTypes:1 {predeclid nonextensible} 
   0:(0)VBAProject._ThisWorkbook 

2. VBAProject._Sheet1 dispinterface cFuncs:146 cImplTypes:1 {predeclid hidden dual nonextensible oleautomation} 
  -1:(-3)VBAProject._Sheet1 interface cFuncs:1 cImplTypes:1 {predeclid hidden dual nonextensible oleautomation} 
   0:(-1)stdole.IDispatch
   ^:Excel._Worksheet interface cFuncs:145 cImplTypes:1 {dual nonextensible oleautomation dispatchable} {000208D8-0000-0000-C000-000000000046} 

3. VBAProject.Sheet1 coclass cFuncs:0 cImplTypes:1 {predeclid nonextensible} 
   0:(2)VBAProject._Sheet1 
   ^:Excel._Worksheet interface cFuncs:145 cImplTypes:1 {dual nonextensible oleautomation dispatchable} {000208D8-0000-0000-C000-000000000046}

4. VBAProject.CMyClass dispinterface cFuncs:2 cImplTypes:1 {cancreate dual nonextensible oleautomation} 
  -1:(-3)VBAProject.CMyClass interface cFuncs:2 cImplTypes:1 {cancreate dual nonextensible oleautomation} 
   0:(-1)stdole.IDispatch 
   ^:VBInternal._DClass dispinterface cFuncs:0 cImplTypes:1 {hidden nonextensible dispatchable} {FCFB3D2B-A0FA-1068-A738-08002B3371B5}

5. VBAProject.CMyClass coclass cFuncs:0 cImplTypes:1 {cancreate nonextensible} 
   0:(4)VBAProject.CMyClass 

6. VBAProject._CPolymorphicClass dispinterface cFuncs:0 cImplTypes:1 {cancreate hidden dual nonextensible oleautomation} 
  -1:(-3)VBAProject._CPolymorphicClass interface cFuncs:0 cImplTypes:1 {cancreate hidden dual nonextensible oleautomation} 
   0:(-1)stdole.IDispatch 
   ^:VBInternal._DClass dispinterface cFuncs:0 cImplTypes:1 {hidden nonextensible dispatchable} {FCFB3D2B-A0FA-1068-A738-08002B3371B5}

7. VBAProject.CPolymorphicClass coclass cFuncs:0 cImplTypes:1 {cancreate nonextensible} 
   0:(6)VBAProject._CPolymorphicClass 

8. VBAProject._ISnafu dispinterface cFuncs:1 cImplTypes:1 {cancreate hidden dual nonextensible oleautomation} 
  -1:(-3)VBAProject._ISnafu interface cFuncs:1 cImplTypes:1 {cancreate hidden dual nonextensible oleautomation} 
   0:(-1)stdole.IDispatch 
   ^:VBInternal._DClass dispinterface cFuncs:0 cImplTypes:1 {hidden nonextensible dispatchable} {FCFB3D2B-A0FA-1068-A738-08002B3371B5}

9. VBAProject.ISnafu coclass cFuncs:0 cImplTypes:1 {cancreate nonextensible} 
   0:(8)VBAProject._ISnafu

We can also see that the function count now cross-tallies. So the Excel._Workbook base interface has 263 methods, we added 2 user methods to give a total of 265 which is the number accessible via the VBAProject._ThisWorkbook dispinterface. This very satisfactorily ties the numbers up.

One problem I have spotted is how the type information for the CPolymorphicClass does not indicate that it implements the ISnafu interface. This is disappointing as it looks like an incomplete implementation.

Source Code

So the reporting program is written in Python but we call it from Excel VBA using the Python COM gateway class pattern, so there are two listings, the Python code and a small amount of Excel VBA to call into the Python.

Python code

To make the COM registries this must be run either (i) once from the command line with administrator rights or (ii) from Visual Studio which if required will ask for an elevation to admin rights. I tend to use the latter method.

import pythoncom

class ComRegistryEx(object):
    _reg_clsid_ = "{FD538AF6-6B9C-4E53-8013-93D7466DF23D}"
    _reg_progid_ = 'PythonComTypes.ComRegistryEx'
    _public_methods_ = ['InterfaceNameFromIID']

    def InterfaceNameFromIID2(self, iid):
        siid = str(iid)
        try:
            thisProc = self._reg_progid_ + "." + inspect.stack()[0][3]
            # optimize for well-known
            if str(siid) == "{00020400-0000-0000-C000-000000000046}":
                return "IDispatch", True
            else:
                iidKey = winreg.OpenKey(winreg.HKEY_CLASSES_ROOT,"Interface\\" + siid)
                iidKeyDefault = winreg.QueryValueEx(iidKey,"")
                baseName = iidKeyDefault[0]
                winreg.CloseKey(iidKey)
                return baseName, True
        except Exception as ex:
            return None,False


class SharedLog(object):

    def __init__(self):
        self.LogContents = ""

    def Log(self,s):
        self.LogContents += s

    def ClearLog(self):
        self.LogContents = ""

    def GetLogContents(self):
        return self.LogContents


class PythonVBATypeLibraryAnatomy(object):
    _reg_clsid_ = "{6653C3BA-0484-465C-BE48-DF9BEE1BDE11}"
    _reg_progid_ = 'PythonInVBA.PythonVBATypeLibraryAnatomy'
    _public_methods_ = ['ClearLog','ReportAnatomy','GetLogContents'] 
    #_public_attrs_ = ['Log']
    #_readonly_attrs_ = ['Log']

    def __init__(self):
        self.sharedLog = SharedLog()

    def Log(self,s):
        self.sharedLog.Log(s)

    def ClearLog(self):
        self.sharedLog.ClearLog()
        
    def GetLogContents(self):
        return self.sharedLog.GetLogContents()


    def GetTypeLibrary(self, o):
        try:
            pt = str(type(o))
            if pt == "<class 'win32com.client.CDispatch'>":
                ti = o._lazydata_[0]
            elif pt == "<class 'PyIDispatch'>" :
                ti = o.GetTypeInfo()
            else:
                self.Log ( "called with type " + pt + " no attempt to acquire typeinfo\n" )
                return None

            self.Log ( "Acquired typeinfo:" + ti.GetDocumentation(-1)[0] + "\n" )
            typelib = ti.GetContainingTypeLib()[0]
            self.Log ( "Acquired containing typelib:" + typelib.GetDocumentation(-1)[0] + "\n" )

            return typelib

        except Exception as e:
            self.Log ("Error: " + str(e) + "\n")

    def ReportAnatomy(self, o):
        try:
            typelib = self.GetTypeLibrary(o)
            report = ""
            for index in range(0, typelib.GetTypeInfoCount()):
                
                ti = typelib.GetTypeInfo(index)
                typeAndTa = TypInfoAndTypeAttribute(ti,typelib, index, self.sharedLog)
                if typeAndTa.ta.typekind >= 3 and typeAndTa.ta.typekind <= 5:
                    
                    subreport = typeAndTa.Report("  ")
                    self.Log ( "acquired subreport for " + str(index) + "\n")
                    if subreport is not None:
                        report+=subreport+ " \n\n"

                    else:
                        self.Log ( "subreport is None:\n")

            return report

        except Exception as e:
            self.Log ( "[PythonVBATypeLibraryAnatomy.ReportAnatomy]Error: " + str(e) + "\n" )

class TypInfoAndTypeAttribute(object):

    def ClearLog(self):
        self.sharedLog.ClearLog()

    def Log(self,s):
        self.sharedLog.Log(s)


    def __init__(self,  ti,typelib, index, log):
        
        try:
            self.sharedLog = log 
            self.ti = ti
            self.identifier = ti.GetDocumentation(-1)[0]
            self.ta = ti.GetTypeAttr()
            self.typelib = typelib
            self.index = index
        except Exception as e:
            self.Log ( "[TypInfoAndTypeAttribute.__init__]Error: " + str(e) + "\n" )

    def ReportTypeFlags(self):
        try:
            report=""
            if ((self.ta.wTypeFlags & 1) == 1) : report +=" appobject"   #TYPEFLAG_FAPPOBJECT
            if ((self.ta.wTypeFlags & 2) == 2) : report +=" cancreate"   #TYPEFLAG_FCANCREATE
            if ((self.ta.wTypeFlags & 4) == 4) : report +=" licensed"    #TYPEFLAG_FLICENSED
            if ((self.ta.wTypeFlags & 8) == 8) : report +=" predeclid"   #TYPEFLAG_FPREDECLID
            if ((self.ta.wTypeFlags & 16) == 16) : report +=" hidden"    #TYPEFLAG_FHIDDEN
            if ((self.ta.wTypeFlags & 32) == 32) : report +=" control"   #TYPEFLAG_FCONTROL
            if ((self.ta.wTypeFlags & 64) == 64) : report +=" dual"      #TYPEFLAG_FDUAL
            if ((self.ta.wTypeFlags & 128) == 128) : report +=" nonextensible" #TYPEFLAG_FNONEXTENSIBLE
            if ((self.ta.wTypeFlags & 256) == 256) | ((self.ta.wTypeFlags & 64) == 64) : report +=" oleautomation" #TYPEFLAG_FOLEAUTOMATION,TYPEFLAG_FDUAL
            if ((self.ta.wTypeFlags & 512) == 512) : report +=" restricted"       #TYPEFLAG_FRESTRICTED
            if ((self.ta.wTypeFlags & 1024) == 1024) : report +=" aggregatable"   #TYPEFLAG_FAGGREGATABLE
            if ((self.ta.wTypeFlags & 2048) == 2048) : report +=" replaceable"     #TYPEFLAG_FREPLACEABLE
            if ((self.ta.wTypeFlags & 4096) == 4096) : report +=" dispatchable"    #TYPEFLAG_FDISPATCHABLE = 0x1000,
            if ((self.ta.wTypeFlags & 8192) == 8192) : report +=" reversebind"    #TYPEFLAG_FREVERSEBIND = 0x2000,
            if ((self.ta.wTypeFlags & 16384) == 16384) : report +=" proxy"        #TYPEFLAG_FPROXY
            return "{" + report.strip() + "}"
        except Exception as e:
            self.Log ( "[TypInfoAndTypeAttribute.ReportTypeFlags]Error: " + str(e) + "\n" )


    def ReportHref0(self, indent):
        try:
            report = "\n" + indent +  " ^:"
            try:
                tiRefType = self.ti.GetRefTypeInfo(0)
            except Exception as e:
                return "" 
            typelib= tiRefType.GetContainingTypeLib()[0]
            refTypInfo = TypInfoAndTypeAttribute(tiRefType,typelib,-1, self.sharedLog)
            subreport = refTypInfo.Report(indent + "  ", False) 
            if subreport is not None and not subreport=="":
                return report + subreport
            else:
                return ""
            

        except Exception as e:
            self.Log ( "[TypInfoAndTypeAttribute.ReportHref0]Error: " + str(e) + "\n" )

    def ReportImplTypes(self, indent, recurse):
        try:
            report=""
            if recurse:

                start = -1 if self.ta.typekind==4 else 0
                children = self.ta.cImplTypes - start 
                if (children>0):
                    
                    for index in range(start, self.ta.cImplTypes):
                        strIndex = (" " + str(index))[-2:]
                        hRefType = None
                        try:
                            hRefType = self.ti.GetRefTypeOfImplType(index)
                            
                            tiRefType = self.ti.GetRefTypeInfo(hRefType)
                            typelib= tiRefType.GetContainingTypeLib()[0]
                            refTypInfo = TypInfoAndTypeAttribute(tiRefType,typelib,-1, self.sharedLog)
                            subreport = refTypInfo.Report(indent + "  ") 
                            if subreport is not None and not subreport == "":
                                report+= "\n" + indent + strIndex + ":(" + str(hRefType) + ")" + subreport
                            else:
                                report=""
                            

                        except Exception as e:
                            if (e.strerror=="Element not found."):
                                report+= "\n" + indent +"{no more}"
                            else:
                                self.Log ( "[TypInfoAndTypeAttribute.ReportImplTypes]Unexpected error: " + str(e) + "\n" )
                                
                        
            else:
                report= "" 
            return report
        except Exception as e:
            self.Log ( "[TypInfoAndTypeAttribute.ReportImplTypes]Error: " + str(e) + "\n" )


    def ReportFullIdentifier(self):
        try:
            libname = self.typelib.GetDocumentation(-1)[0]
            return libname + "." + self.ti.GetDocumentation(-1)[0]

        except Exception as e:
            self.Log ( "[TypInfoAndTypeAttribute.ReportFullIdentifier]Error: " + str(e) + "\n" )
       

    def ReportIid(self):
        try:
            cex = ComRegistryEx()
            interfaceName2, ok = cex.InterfaceNameFromIID2(self.ta.iid)
            if ok:
                return str(self.ta.iid) + " (" + interfaceName2 + ")"
            else:
                return str(self.ta.iid)  #+ " (not well known)"
        except Exception as e:
            self.Log ( "[TypInfoAndTypeAttribute.ReportIid]Error: " + str(e) + "\n" )
        


    def Report(self,indent, recurse = True):
        try:
            siid = str(self.ta.iid)
            if siid == "{00000000-0000-0000-0000-000000000000}" or siid == "{00000000-0000-0000-C000-000000000046}" : #or siid=="{00020400-0000-0000-C000-000000000046}":
                return ""
            strindex = "" if self.index==-1 else str(self.index) + ". "
            strTaTypekind = "coclass" if self.ta.typekind == 5 else "dispinterface" if self.ta.typekind == 4 else "interface"
            report = strindex + (self.ReportFullIdentifier() + " " + strTaTypekind  + " cFuncs:" + str(self.ta.cFuncs)  
                + " cImplTypes:" + str(self.ta.cImplTypes) + " " + self.ReportTypeFlags() + " "  )
            report = report + self.ReportIid()
            if recurse:
                report = report + self.ReportImplTypes(indent, recurse)
                href0 = self.ReportHref0(indent)
                if href0 is not None:
                    report = report + href0
                else:
                    pass
            return report
        except Exception as e:
            self.Log ( "[TypInfoAndTypeAttribute.Report]Error: " + str(e) + "\n" )


def RegisterThis():
    print("Registering COM servers...")
    import win32com.server.register
    win32com.server.register.UseCommandLine(PythonVBATypeLibraryAnatomy)


if __name__ == '__main__':
    RegisterThis()
    print("End of execution")

VBA client code

Sub Test()
    Dim oMyClass As CMyClass
    Set oMyClass = New CMyClass

    Dim objAnatomy As Object
    Set objAnatomy = CreateObject("PythonInVBA.PythonVBATypeLibraryAnatomy")
    
    Dim sReport
    sReport = objAnatomy.ReportAnatomy(oMyClass)
    If Not IsNull(sReport) Then
        Debug.Print sReport
    Else
        Debug.Print objAnatomy.GetLogContents
    End If
    
    Stop
End Sub

Monday, 27 May 2019

VBA - Make the Windows Timer a library feature

In a StackOverflow bounty the issue of using the Windows timer api arose. Obviously VBA users have the Application.OnTime but this only have resolution to one second; if you want resolution to the millisecond then you need to use the Windows API. My solution is given below.

The Window SetTimer function behaves differently from Application.OnTime in that it will repeatedly fire unless you stop it; Application.OnTime fires only once (IIRC). Luckily, in the callback procedure that is called when the timer is fired the associated event id is passed as a parameter. So it is trivial to use that event id to call KillTimer and stop further firing.

The SO questioner wanted client code to be able to utilise this as a library feature for calling clients. In the version below we do not accept calling code's function pointers (i.e. using AddressOf) because this is unsafe. Instead, the user must pass in a string that can be passed to Application.Run.

Application.Run can takes the simple name of a procedure such as "UserCallBack" which will be resolved in the scope of ThisWorkbook. If client code is in a separate workbook then the client workbook name needs also to be prepended and separated with an exclamation mark e.g. "Book1.xlsm!UserCallBack"

We stash the callbacks in a dictionary to maintain state and when the timer fires we can select the right callback function and invoke it using Application.Run

Option Explicit
Option Private Module

'* Brought to you by the Excel Development Platform blog
'* exceldevelopmentplatform.blogspot.com

Private Declare Function ApiSetTimer Lib "user32.dll" Alias "SetTimer" (ByVal hWnd As Long, ByVal nIDEvent As Long, _
                        ByVal uElapse As Long, ByVal lpTimerFunc As Long) As Long

Private Declare Function ApiKillTimer Lib "user32.dll" Alias "KillTimer" (ByVal hWnd As Long, ByVal nIDEvent As Long) As Long

Private mdicCallbacks As New Scripting.Dictionary

Private Sub SetTimer(ByVal sUserCallback As String, lMilliseconds As Long)
    Dim retval As Long  ' return value
    
    Dim lUniqueId As Long
    lUniqueId = mdicCallbacks.HashVal(sUserCallback) 'should be unique enough
    
    mdicCallbacks.Add lUniqueId, sUserCallback
    
    retval = ApiSetTimer(Application.hWnd, lUniqueId, lMilliseconds, AddressOf TimerProc)
End Sub

Private Sub TimerProc(ByVal hWnd As Long, ByVal uMsg As Long, ByVal idEvent As Long, _
        ByVal dwTime As Long)
        
    ApiKillTimer Application.hWnd, idEvent
    
    Dim sUserCallback As String
    sUserCallback = mdicCallbacks.Item(idEvent)
    mdicCallbacks.Remove idEvent
    
    
    Application.Run sUserCallback
End Sub

'****************************************************************************************************************************************
' User code below
'****************************************************************************************************************************************

Private Sub TestSetTimer()
    SetTimer "UserCallBack", 500
End Sub

Private Function UserCallBack()
    Debug.Print "hello from UserCallBack"
End Function

Alternatives to Application.Run

In the above code, Application.Run is used as the mechanism to route off and callback to calling client. However, Application.Run cannot call into a class instance's method so if you really like object-orientated code then you might want to choose a different mechanism. Code is not given for these but they are not difficult and I outline them below.

Alternative to Application.Run - ThisWorkbook and CallByName

Placing a method in the ThisWorkbook module will allow it to be called from a Workbook variable. Thus you are extending the interface of the Workbook class but if the variable is declared to be of type Excel.Workbook then it won't appear in the Intellisense dropdown menu. Despite this, it's still there and still callable.

So a variant of the above timer code could store both a Workbook variable and the method (as a string) to be invoked and then use CallByName to make the call.

Alternative to Application.Run - Custom Callback Interface

The other OO friendly way to callback is to insist that calling code implement a custom callback interface. The interface would probably have just one callback method suitable for all clients. The callback interface is defined in the server code and implemented in the client code. Then the client code passes a variable typed to the custom callback interface to the server. Upon firing, the server invokes the callback method on the interface variable to make the callback.

Actually, one of the answers has some sample code for this.

Sunday, 26 May 2019

VBA - Luhn Algorithm

I'm not the world's greatest cryptographer but I am surprised how easy the 16-digit credit card number is to generate, I guess the guy (Luhn) who invented it in the 1950s had little computing power. Below is some code to check a credit card number. Further below is some code to generate your own. For test data generation purposes only, no nefarious uses please.

Option Explicit

Public Function Check(ByVal ccNumber As String)
    '* VBA implementation of Luhn algorithm
    '* Based on a Java class from
    '* https://stackoverflow.com/questions/20740444/check-credit-card-validity-using-luhn-algorithm#answer-27326507
    Dim sum As Long
    Dim alternate As Boolean
    Dim i As Long
    For i = Len(ccNumber) To 1 Step -1
        Dim n As Long
        n = CLng(Mid$(ccNumber, i, 1))
        If alternate Then
            n = n * 2
            If (n > 9) Then
                n = (n Mod 10) + 1
            End If
        End If
        sum = sum + n
        alternate = Not alternate
    Next

    Check = (sum Mod 10 = 0)

End Function

Sub TestCheck()
    '* not mine from SO https://stackoverflow.com/questions/20725761/validate-credit-card-number-using-luhn-algorithm
    Debug.Assert Check("4388576018410707")
End Sub
    
Sub GenerateTestData()
    Dim lLoop As Long
    
    Dim sStem As String
    sStem = Left("4388576018410707", 1)
    
    Dim sWork As String
    sWork = sStem
    
    Dim lDigitsToGenerate As Long
    lDigitsToGenerate = 16 - Len(sWork)
    
    Dim lRandomDigits As Long
    lRandomDigits = lDigitsToGenerate - 1
    
    For lLoop = 1 To lRandomDigits
        sWork = sWork & CStr((CInt(Rnd(1) * 10) Mod 10))
    Next lLoop
    
    Debug.Assert Len(sWork) = 15
    
    For lLoop = 0 To 9
        Dim sTry As String
        sTry = sWork & CStr(lLoop)
        
        Debug.Assert Len(sTry) = 16
        
        If Check(sTry) Then
            Debug.Print sTry
            Exit For
        End If
    Next
    
End Sub

VBA, C#, COM+ Isolate C# DLL in a separate process

If you have every authored a C# .NET class library to act as an in-process COM server Dll for use in Excel VBA then you've probably been irritated about having to close your Excel.exe session every time you wanted to rebuild the C# component. I have a fix for that, the answer is to create a COM+ application which gives a process separate to Excel.exe. I detail this in this blog post.

Also in this blog post I will show a beautiful software application called Process Explorer by Mark Russinovich of SysInternals. This beauty will track down a Dll and show which process has it loaded.

Click here for separate Youtube window

Our Simple C# Class Library COM Dll server

So for demonstration purposes we have a really simple C# class library with extra attributes to make it inter-operable with COM clients and thus act as an in-process COM Server Dll. The project name is ClassLibrary.

In the code below you see how we must define the interface separately (actually in VB.Net one can be more succinct but never mind). As mentioned in the comments one needs to make the assembly COM visible, check the 'Register for COM interop' checkbox on the build tab and don't forget to run Visual Studio with administrator rights so the the registration is successful.

The code does do very much. All it does is return a string "baz" pre-pended with a message about the current process id. I need the current process id to highlight the tools I'm going to demonstrate.

using System.Diagnostics;
using System.Runtime.InteropServices;

// (i) in AssemblyInfo.cs change to [assembly: ComVisible(true)] 
// (ii) in the Project Properties->Build tab under the Output section ensure  the 'Register for COM interop' checkbox is checked.
// (iii) You will need to run Visual Studio with admin rights so it can register the dll.

namespace ClassLibrary
{
    public interface IFoo
    {
        string bar();
    }

    [ClassInterface(ClassInterfaceType.None)]
    [ComDefaultInterface(typeof(IFoo))]
    public class CFoo : IFoo
    {
        string IFoo.bar()
        {
            return "Current process id:" + Process.GetCurrentProcess().Id +  "\nbaz";
        }
    }
}

and here is some client VBA code. Once the CreateObject() line is executed the Dll is loaded into the Excel.exe process space. We are using late binding but the Dll still gets locked. Once loaded into Excel.exe, it cannot be freed. Once loaded into Excel.exe, it is impossible for Visual Studio to build the project. One has to close the Excel.exe session; this can be really disruptive.

Option Explicit
Option Private Module

Private Sub Test1()

    Dim obj As Object 'ClassLibrary.CFoo
    Set obj = CreateObject("ClassLibrary.CFoo")
    
    Debug.Print obj.bar
    
    Stop
    Set obj = Nothing
    
End Sub

Process Explorer - by Mark Russinovic, SysInternals

So during my investigations I used Process Explorer by Mark Russinovich, Sysinternals. This is a superb program that has a ton of features worth investigating in your spare time. Relevant here is the ability to sweep through processes looking for a file that has been loaded. First though we need to run the VBA client code, run this now and allow it to halt on the Stop statement. Halting gives us time to look at where its loaded.

Here is a screenshot of it finding the C# class library loaded into Excel.

I'll give a second screenshot which will successfully show the Dll loaded into a separate COM+ process. Let's move onto COM+.

COM+ (Component Services) allows surrogate hosting for in-process Dlls with a separate process

So we need to load the Dll into a separate process and the easiest way to do this is to configure a COM+ application. On the request for a configured object, COM+ will launch a separate process call DLLHost.exe and then load the COM DLL server into that process and marshal method calls thereto.

The COM+ Microsoft Management Console

It is best to dive in and look at the COM+ administration tool before talking about it, here is the steps required to open that. These are valid for Windows 10 users (and prior editions)

Open the classic Control Panel
In the classic Control Panel, click on Adminstrative Tools icon to open Adminstrative Tools explorer
In the Adminstrative Tools explorer, double-click on the Component Services icon to open the Microsoft Management Console (MMC) for Component Services
In the Microsoft Management Console (MMC) for Component Services expand the Component Services treeview node to reveal the Computers folder
Click on (and thus expand) the Computers folder treeview node to reveal the My Computer folder icon
Click on (and thus expand) the My Computer folder icon treeview node to reveal the COM+ Applications folder icon
Click on (and thus expand) the COM+ Applications folder icon treeview node to reveal the COM+ Applications

Your MMC should look something like this below

From here we can create a new Application, the steps are as following.

Right-click on the COM+ Applications folder icon treeview node to get the context menu from which select New->Application to launch the COM+ Application Install Wizard
Click Next on the front page on the launched COM+ Application Install Wizard to move to the 'Install or Create a New Application' wizard page
On the 'Install or Create a New Application' wizard page click on 'Create an empty application' which opens the 'Create Empty Application' wizard page
On the 'Create Empty Application' wizard page, enter 'MyNewApplication' for the name and ensure the Server application radio button is selected (this is key to getting a separate process). Click 'Next' to move to the Application Identity wizard page.
Click 'Next' on the Application Identity wizard page to take the defaults and move to the Add Application Roles wizard page
Click 'Next' on the Add Application Roles wizard page to take the defaults and move to the Add Users to Roles wizard page
Click 'Next' on the Add Users to Roles wizard page to take the defaults and move to final finish page. Click Finish.

You now have a new COM+ Application, symbolised by a COM+ Application icon and labelled 'MyNewApplication'. But it has no components yet, so lets add our ClassLibrary.dll. Here are the steps.

Select the MyNewApplication COM+ application by clicking on its icon.
Expand the MyNewApplication COM+ application folder icon to reveal the contained Components folder.
Select the Components folder by clicking on its icon.
Right-click on the Components folder icon to get the context menu from which select New->Component to launch the COM+ Component Install Wizard
On the front page of the COM+ Component Install Wizard click next to move to the Import or install a component wizard page
On the Import or install a component wizard page choose 'Import component(s) that are already registered' to move to the Choose Components to Import wizard page
On the Choose Components to Import wizard page, I had to check the 32-Bit Registry checkbox before I could find ClassLibrary.CFoo
Select ClassLibrary.CFoo in the list and then click Next to move to the Finish wizard page whereupon click Finish,

Your console should now look like this...

So you now have configured your COM+ application to contain and serve instantiations of the ClassLibrary.CFoo class. ClassLibrary.Dll will be loaded in a surrogate DllHost.exe process. I will prove this by running the VBA client code again and again using Process Explorer to find the ClassLibrary.dll. YOU MUST CLOSE EXCEL.EXE AND RESTART NEW EXCEL.EXE

After closing the exiting Excel.exe session and restarting a new Excel.exe session and running the VBA client code the ClassLibrary.CFoo object was instantiated into a DllHost.exe surrogate process. Here is a screenshot proving the new location of the Dll in the DllHost.exe surrogate process (and no trace in any Excel.exe process).

More proof that the COM+ Application is running is by observing its icon in the console, it becomes an animated spinning icon!

Shutting down the COM+ Application surrogate process

So the real benefit to all this is the ability to shut the surrogate process, release the Dll from being loaded and locked and allow Visual Studio to rebuild the next version of the component. We no longer have to close the Excel session. All we need to do is shutdown the surrogate process of the COM+ Application. This is easy, here are the steps.

In the MMC, click on the MyNewApplication icon to select it.
Right-click on the MyNewApplication icon to get the context menu from which select Shutdown

There isn't much feedback to say a shutdown has happened, Process Explorer will delete the line if you are keen to see evidence. The best evidence is that Visual Studio can now rebuild the component.

One caveat, if you change the component's interface then be prepared to repeat the above configuration of the application. Other than that you can now enjoy more enduring Excel sessions; something I've got used to whilst developing Python scripts which do not lock up.

COM+ information (catalog) is NOT stored in the registry

I got a little confused about where the COM+ information was stored. I searched and search the registry but to no avail. It turns out that it is NOT stored in the registry as per this quote from the COM+ (Component Services) documentation on the COM+ catalog...

The data store that holds COM+ configuration data. Performance of COM+ administration tasks requires reading and writing data stored in the catalog. The catalog can be accessed only through the Component Services administrative tool or through the COMAdmin library.

Actually, this is probably a good thing. On numerous occasions, I have had to poke around the registry to solve a COM issue. Locking up the information is probably a step in the right direction and I guess this approach previews the .NET global assembly cache.

Monday, 30 September 2019

MP4 Files are based on Apple's QuickTime Movie files

MPEG Specificaation ISO/IEC 14496 parts 12 & 14

VLC Media Player Source Code

Use Unix Tool Grep in Windows

Links

Appendix A - VBA Code to read DASH IV

Tuesday, 27 August 2019

Friday, 9 August 2019

DesignatedWrapPolicy

Official sample, pippo.py

My test class, FooBar (housed in AComGatewayClass.py)

IdlWriter.py

VBA Calling Code

Other Links

Low level C++ Code to instantiate a COM Component

Wednesday, 7 August 2019

VBA Client Code

What's Next, can the above Python class report on itself? No (or at least not yet).

Sunday, 21 July 2019

Tuesday, 16 July 2019

Python code

Thoughts

Links

Friday, 28 June 2019

Thursday, 6 June 2019

VBA Projects have document modules whereas VB6 projects don't

Our Test Workbook

Sheet1 (code-behind) module

ThisWorkbook module

CMyClass class module

CPolymorphicClass class module

ISnafu class module (will act as an interface)

Reporting on the VBA Project's types

Adding the referenced/implemented types

One last thing to show you

Source Code

Python code

VBA client code

Monday, 27 May 2019

Alternatives to Application.Run

Alternative to Application.Run - ThisWorkbook and CallByName

Alternative to Application.Run - Custom Callback Interface

Sunday, 26 May 2019

Our Simple C# Class Library COM Dll server

Process Explorer - by Mark Russinovic, SysInternals

COM+ (Component Services) allows surrogate hosting for in-process Dlls with a separate process

The COM+ Microsoft Management Console

Shutting down the COM+ Application surrogate process

COM+ information (catalog) is NOT stored in the registry