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