Ugly workaround to get the vbext_ProcKind of a procedure is breaking encapsulation

Question

This is a follow up to Extending the VBAExtensibility Library. It turns out that code had a really nasty bug. Anytime vbeProcedure.StartLine got called, I was running the risk of hitting runtime error 35 because CodeModule.ProcStartLine has to be told what kind of procedure it's looking for. Everything blows up when you call it with vbext_pk_proc, but you're really looking for a class property.

To clarify, this is a dangerous call.

CodeModule.ProcStartLine(procedureName, vbext_pk_proc)

My solution was to parse the code module line by line checking for some keywords so I could determine what vbext_ProcKind to pass it. I have one huge issue with how I've fixed it: vbeCodeModule now knows more about what it means to be a procedure than I like. I feel like I'm breaking encapsulation. In my original version, vbeCodeModule knew just enough to create a list of procedures. That's it. VbeProcedures were responsible for reporting information about themselves. My concerns are deepened by the difficulty I'm having in testing this code. If it was part of VbeProcedure, I could expose it publicly and testing would be a breeze. As part of VbeCodeModule, I don't really want it to be public.

I already posted this code as an answer, but I would like to have it reviewed. I'm posting the entirety of both classes here, but I'm particularly interested in IsSignature, GetProcedureType, and GetProcedures in the vbeCodeModule class.

The full project is over at GitHub.

vbeCodeModule

' requires Microsoft Visual Basic for Applications Extensibility 5.3 library
Option Explicit

Private mCodeModule As CodeModule
Private mVbeProcedures As vbeProcedures

Public Property Get CodeModule() As CodeModule
    Set CodeModule = mCodeModule
End Property

Public Property Let CodeModule(ByRef codeMod As CodeModule)
    Me.Initialize codeMod
End Property

Public Property Get vbeProcedures()
    Set vbeProcedures = mVbeProcedures
End Property

Public Sub Insert(ComponentType As vbext_ComponentType)
    'Dim project As VBProject
    'Set project = VBIDE.VBE
    'project.VBComponents.Add ComponentType
End Sub

Public Function Create(codeMod As CodeModule) As vbeCodeModule
' allows calls from other projects without breaking the exisiting API

    Set Create = New vbeCodeModule
    Create.Initialize codeMod
End Function

Public Sub Initialize(codeMod As CodeModule)
    Set mCodeModule = codeMod
    Set mVbeProcedures = GetProcedures(mCodeModule)
End Sub

Private Sub Class_Terminate()
    Set mVbeProcedures = Nothing
    Set mCodeModule = Nothing
End Sub

Private Function GetProcedures(codeMod As CodeModule) As vbeProcedures
    Dim procName As String
    Dim procs As New vbeProcedures
    Dim proc As vbeProcedure
    Dim line As String
    Dim procKind As vbext_ProcKind

    Dim lineNumber As Long
    For lineNumber = 1 To codeMod.CountOfLines
        line = codeMod.Lines(lineNumber, 1)
        If IsSignature(line) Then
            procKind = GetProcedureType(line)
            procName = codeMod.ProcOfLine(lineNumber, procKind)

            Set proc = New vbeProcedure
            proc.Initialize procName, codeMod, procKind
        End If
    Next lineNumber

    Set GetProcedures = procs

End Function

Private Function GetProcedureType(signatureLine As String) As vbext_ProcKind
    If InStr(1, signatureLine, "Property Get") > 0 Then
        GetProcedureType = vbext_pk_Get
    ElseIf InStr(1, signatureLine, "Property Let") > 0 Then
        GetProcedureType = vbext_pk_Let
    ElseIf InStr(1, signatureLine, "Property Set") > 0 Then
        GetProcedureType = vbext_pk_Set
    ElseIf InStr(1, signatureLine, "Sub") > 0 Or InStr(1, signatureLine, "Function") > 0 Then
        GetProcedureType = vbext_pk_Proc
    Else
        Const InvalidProcedureCallOrArgument As Long = 5
        Err.Raise InvalidProcedureCallOrArgument
    End If
End Function

Private Function IsSignature(line As String) As Boolean

    If line = vbNullString Then Exit Function
    If IsDeclaration Then Exit Function

    ' pattern:
    '   any number of characters;
    '   Doesn't start with a comment;
    '   any number of characters;
    '   space;
    '   word;
    '   space;
    '   any number of characters

    If line Like "[!']* Property *" Then
        IsSignature = True
    ElseIf line Like "[!']* Function *" Then
        IsSignature = True
    ElseIf line Like "[!']* Sub *" Then
        IsSignature = True
    End If

End Function

Private Function IsDeclaration(line As String) As Boolean
    IsDeclaration = InStr(1, line, "Const") > 0 Or InStr(1, line, "Dim") > 0
End Function

vbeProcedure

' requires Microsoft Visual Basic for Applications Extensibility 5.3 library

Option Explicit

' error handling values
Private Const BaseErrorNum As Long = 3500

Public Enum vbeProcedureError
        vbeObjectNotIntializedError = vbObjectError + BaseErrorNum
        vbeReadOnlyPropertyError
        vbeInvalidArgError
End Enum

Public Enum MemberType
    mt_PropertyGetter
    mt_PropertyLetter
    mt_PropertySetter
    mt_Function
    mt_Sub
End Enum

Public Enum MemberAccessibility
    ma_Public
    ma_Private
    ma_Friend
End Enum

Private Const ObjectNotIntializedMsg = "Object Not Initialized"
Private Const ReadOnlyPropertyMsg = "Property is Read-Only after initialization"

' exposed property variables
Private Type TVbeProcedure
    ParentModule As CodeModule
    Name As String
    procKind As vbext_ProcKind
End Type

Private this As TVbeProcedure

' truly private property variables
Private isNameSet As Boolean
Private isParentModSet As Boolean

Public Property Get Name() As String
    If isNameSet Then
        Name = this.Name
    Else
        RaiseObjectNotIntializedError
    End If
End Property

Public Property Let Name(ByVal vNewValue As String)
    If Not isNameSet Then
        If vNewValue = vbNullString Then
            RaiseInvalidArgError "Name", "The Name property can not be set to an empty string."
        End If
        this.Name = vNewValue
        isNameSet = True
    Else
        RaiseReadOnlyPropertyError
    End If
End Property

Public Property Get ParentModule() As CodeModule
    If isParentModSet Then
        Set ParentModule = this.ParentModule
    Else
        RaiseObjectNotIntializedError
    End If
End Property

Public Property Let ParentModule(ByRef vNewValue As CodeModule)
' Object assignments should use Set, but that forces Initialize() through the Getter, raising ObjectNotInitialized
    If Not isParentModSet Then
        Set this.ParentModule = vNewValue
        isParentModSet = True
    Else
        RaiseReadOnlyPropertyError
    End If
End Property

Public Property Get procKind() As vbext_ProcKind
    procKind = this.procKind
End Property

Public Property Get StartLine() As Long
    ValidateIsInitialized
    StartLine = Me.ParentModule.ProcStartLine(Me.Name, this.procKind)
End Property

Public Property Get EndLine() As Long
    ValidateIsInitialized
    EndLine = Me.StartLine + Me.CountOfLines
End Property

Public Property Get CountOfLines() As Long
    ValidateIsInitialized
    CountOfLines = Me.ParentModule.ProcCountLines(Me.Name, this.procKind)
End Property

Public Sub Initialize(Name As String, codeMod As CodeModule, procKind As vbext_ProcKind)
    Me.Name = Name
    Me.ParentModule = codeMod
    this.procKind = procKind
End Sub

Public Property Get Lines() As String
    ValidateIsInitialized
    Lines = Me.ParentModule.Lines(Me.StartLine, Me.CountOfLines)
End Property

Public Property Get Signature() As String
' @Mat's Mug [https://codereview.stackexchange.com/users/23788/mats-mug] wrote this.
    Dim code() As String
    code = Split(Me.ParentModule.Lines(Me.StartLine, Me.CountOfLines), vbNewLine)

    Dim i As Long
    For i = 0 To UBound(code)
        If code(i) <> vbNullString And Left(Trim(code(i)), 1) <> "'" Then
            Signature = code(i)
            Exit Property
        End If
    Next
End Property

'TODO: Property Body
'Public Property Get Body() As String

'End Property

Public Property Get ModuleMemberType() As MemberType
' @Mat's Mug [https://codereview.stackexchange.com/users/23788/mats-mug] wrote this.
    Dim result As MemberType
    Dim code() As String
    code = Split(Trim(Signature), " ")

    Dim modifier As String
    modifier = code(0)

    Dim mType As String, mPropType As String
    If modifier = "Property" Or modifier = "Function" Or modifier = "Sub" Then
        mType = modifier
        mPropType = code(1)
    Else
        mType = code(1)
        mPropType = code(2)
    End If

    Select Case mType
        Case "Property"

            If mPropType = "Get" Then
                ModuleMemberType = mt_PropertyGetter
            ElseIf mPropType = "Let" Then
                ModuleMemberType = mt_PropertyLetter
            ElseIf mPropType = "Set" Then
                ModuleMemberType = mt_PropertySetter
            Else
                Const InvalidProcedureCallOrArguement As Long = 5
                Err.Raise InvalidProcedureCallOrArguement
            End If

        Case "Function"
            ModuleMemberType = mt_Function

        Case "Sub"
            ModuleMemberType = mt_Sub

    End Select

End Property

Property Get Accessibility() As MemberAccessibility
' @Mat's Mug [https://codereview.stackexchange.com/users/23788/mats-mug] wrote this.
    Dim code() As String
    code() = Split(Trim(Signature), " ")

    Dim modifier As String
    modifier = code(0)

    If modifier = "Property" Or modifier = "Function" Or modifier = "Sub" Then modifier = "Public"

    Select Case modifier
        Case "Public"
            Accessibility = ma_Public
        Case "Private"
            Accessibility = ma_Private
        Case "Friend"
            Accessibility = ma_Friend
        Case Else
            Err.Raise 5
    End Select

End Property

' TODO: Property ReturnType; get the properties Type
' TODO: "Create" or "Append" sub
' TODO: "Insert" Sub
' TODO: Sort function

Private Sub RaiseObjectNotIntializedError()
    Err.Raise vbeProcedureError.vbeObjectNotIntializedError, GetErrorSource, ObjectNotIntializedMsg
End Sub

Private Sub RaiseReadOnlyPropertyError()
    Err.Raise vbeProcedureError.vbeReadOnlyPropertyError, GetErrorSource, ReadOnlyPropertyMsg
End Sub

Private Sub RaiseInvalidArgError(propertyName As String, Optional additonalInfo As String = vbNullString)
    Dim message As String
    message = "Invalid Argument" & vbCrLf & "Property: " & propertyName

    If additonalInfo = vbNullString Then
        Err.Raise vbeProcedureError.vbeInvalidArgError, GetErrorSource, message
    Else
        Err.Raise vbeProcedureError.vbeInvalidArgError, GetErrorSource, message & vbCrLf & additonalInfo
    End If
End Sub

Private Sub ValidateIsInitialized()
    If Me.ParentModule Is Nothing Then
        RaiseObjectNotIntializedError
    End If
End Sub

Private Function GetErrorSource() As String
    GetErrorSource = TypeName(Me)
End Function

Answer 1

My concerns are deepened by the difficulty I'm having in testing this code. If it was part of VbeProcedure, I could expose it publicly and testing would be a breeze. As part of VbeCodeModule, I don't really want it to be public.

VbeCodeModule needs a way of "detecting" its members. You can test whether it can find all expected members, and walk away happy. If you want to test whether a function is capable of identifying a member's procedure kind, then indeed, you need to extract it out of VbeCodeModule and make it Public. It all comes down to what you consider being a testable unit.

The only code that needs to determine a procedure's kind, is the code that scans a code module and creates VbeProcedure objects. Hence, I'd keep it a private member, and test that a module indeed has all the members you're expecting.

Here's how I solved it, based on a recommendation you made!

• Start looping at the first line following the declarations section.
• Find the procedure kind for the current line - that's either one of the VBE enum values, or -1 if the line isn't a signature.
• If you've got a procedure kind, you've found a signature; if not, you can skip to the next line.
• Using the procedure kind, you can now safely get the procedure's name, signature and body - create your VbeProcedure instance here.
• You can skip to the end of the procedure right away, using ProcStartLine and ProcCountOfLines.

Public Property Get Members() As Collection

    Dim result As New Collection

    Dim module As CodeModule
    Set module = this.encapsulated.CodeModule

    Dim procedureName As String
    Dim procedureBody As String

    Dim currentLine As Long
    currentLine = module.CountOfDeclarationLines + 1

    While currentLine < module.CountOfLines

        Dim procedureKind As vbext_ProcKind
        procedureKind = GetProcedureKind(module, currentLine)
        If procedureKind <> -1 Then

            procedureName = module.ProcOfLine(currentLine, procedureKind)

            Dim procedureLines As Long
            procedureLines = module.ProcCountLines(procedureName, procedureKind)

            procedureBody = module.lines(module.ProcStartLine(procedureName, procedureKind), procedureLines)

            result.Add Member.Create(procedureName, procedureBody)
            currentLine = module.ProcStartLine(procedureName, procedureKind) + procedureLines

        Else
            currentLine = currentLine + 1
        End If
    Wend

    Set Members = result

End Property

Where Member is, in my project, analoguous to your VbeProcedure class.

GetProcedureKind is pretty straightforward:

Private Function GetProcedureKind(ByVal module As CodeModule, ByVal line As Long) As vbext_ProcKind

    Dim result As vbext_ProcKind

    If Framework.Strings.StartsWithAny(module.lines(line, 1), False, "End", "'") Then
        result = -1
        Exit Function
    End If

    If Framework.Strings.ContainsAny(module.lines(line, 1), False, " Sub ", " Function ") _
    Or Framework.Strings.StartsWithAny(module.lines(line, 1), False, "Sub ", "Function ") Then
        result = vbext_pk_Proc

    ElseIf Framework.Strings.Contains(module.lines(line, 1), "Property Get ") Then
        result = vbext_pk_Get

    ElseIf Framework.Strings.Contains(module.lines(line, 1), "Property Let ") Then
        result = vbext_pk_Let

    ElseIf Framework.Strings.Contains(module.lines(line, 1), "Property Set ") Then
        result = vbext_pk_Set

    Else
        result = -1

    End If

    GetProcedureKind = result

End Function

The StartsWithAny case covers for signatures that use the default accessibility modifier, and the leading & trailing whitespaces in the ContainsAny case covers for members that would have "Sub" or "Function" as part of their identifier, so all these correctly get picked up:

Sub Foo()

Function Foo()

Private Sub FooFunction()

Private Function FooProperty()

And this correctly gets ignored:

'Public Function Bar()
'    is this function ignored?
'End Function

Note that IsSignature becomes moot with this approach, since the GetProcedureKind function will only return a value other than -1 when the current line is the signature line.

---

vbeCodeModule now knows more about what it means to be a procedure than I like. I feel like I'm breaking encapsulation.

I think it's the other way around: VbeProcedure knows too much about a code module!

The ParentModule As CodeModule member merely enables StartLine, EndLine, CountOfLines and Lines members to come into existence... but all these can also be obtained at the parent module's level, by passing the procedure's name and kind.

I think if VbeProcedure had a Body property, you wouldn't need to expose Lines, and you could remove the dependency on CodeModule, and remove the need to "kill" procedures, since VbeProcedure would simply become a container for some strings and enum values that VbeCodeModule assigns when it parses a module.

Doing this also keeps the CodeModule parsing logic within VbeCodeModule, and limits the parsing capabilities of VbeProcedure to parsing its own body or signature, say, to expose an Accessibility property.

Answer 2

Your IsSignature relies on IsDeclaration, which doesn't take variable names of functions into account.

If I make a function with an argument named maxDimensions, your code fails to identify the function as a function.

For example:

Public Sub Initialize(maxDimensions as Integer) for some kind of data structure object (multi-dimensional array?). You call GetProcedures, hit IsSignature, and because the line contains the word Dim (maxDimensions), it's seen as a variable and not a function or procedure.

---

There's other minor cases you should watch out for; there could be extra spaces between Property and Get/Set/Let. Also, End Function, End Sub and End Property could have a space on the end. Lines containing End Function like If IsDeclaration Then Exit Function could also cause problems if they have a space on the end. I suggest you trim excess spaces.

Answer 3

From a once over

• Impressive code, I stared at it for quite a while and found only few things worth mentioning, but these are more comments than anything else. I would be willing to maintain this even though I have not done VBa in ages
• You might also want to write a code beautifier, some of your indentation in the Enums is off
• I would expect possible corner cases in this code and have explicit (gracious) error handling around your ProcStartLine call
• I would trim code(i) before assigning to Signature
• I dont like developers having to remember that they need to initialize
• exisiting <- your code is good, do not let it be marred by mispelings

• I would place this comment:

   ' pattern:
   '   any number of characters;
   '   Doesn't start with a comment;
   '   any number of characters;
   '   space;
   '   word;
   '   space;
   '   any number of characters
  

  before Function IsSignature for enhanced readability, right now it breaks up

• I would break up the if statement here and use the awesomeness to make it more DRY

  If modifier = "Property" Or modifier = "Function" Or modifier = "Sub" Then modifier = "Public"
  
  Select Case modifier
      Case "Public"
          Accessibility = ma_Public
      Case "Private"
          Accessibility = ma_Private
      Case "Friend"
          Accessibility = ma_Friend
      Case Else
          Err.Raise 5
  End Select
  

  could be

  Select Case modifier
      Case "Public", "Property", "Function", "Sub"
          Accessibility = ma_Public
      Case "Private"
          Accessibility = ma_Private
      Case "Friend"
          Accessibility = ma_Friend
      Case Else
          Err.Raise 5
  End Select
  

  at least, if VBa case works the same as the regular VB case