Wednesday, February 01, 2006

A VS Macro to count projects classes and functions

I was playing around writing Macros for VS 2003 recently, exploring the CodeModel API and came up with this little solution profiler that counts the number of projects, classes and functions in the current solution. Microsoft has a load of VS 2005 automation samples you can download here
Option Explicit On 

Imports EnvDTE
Imports System.Diagnostics

Public Module SolutionProfiler

    Private Const newline = vbLf
    Private m_textDocument As TextDocument
    Private m_editPoint As EditPoint
    Private m_indent As Integer = 0
    Private m_writeOn As Boolean = False

    Private m_numberOfProjects As Integer = 0
    Private m_numberOfClasses As Integer = 0
    Private m_numberOfFunctions As Integer = 0
    Private m_linesOfCode As Integer = 0

    Public Sub ProfileSolution()

        DTE.ItemOperations.NewFile("General\Text File")
        m_textDocument = DTE.ActiveDocument.Object("TextDocument")
        m_editPoint = m_textDocument.StartPoint.CreateEditPoint()

        Dim solution As Solution = DTE.Solution

        For Each project As Project In solution.Projects
            WriteLine(project.Name)
            WriteProject(project)
        Next

        WriteSummary()

    End Sub

    Private Sub WriteSummary()

        m_writeOn = True
        WriteLine(String.Format("Number of Projects  = {0}", m_numberOfProjects))
        WriteLine(String.Format("Number of Classes   = {0}", m_numberOfClasses))
        WriteLine(String.Format("Number of Functions = {0}", m_numberOfFunctions))
        WriteLine(String.Format("Number of LOK       = {0}", m_linesOfCode))

    End Sub

    Private Sub WriteProject(ByVal project As Project)

        m_numberOfProjects += 1

        Dim codeModel As CodeModel = project.CodeModel
        If Not codeModel Is Nothing Then
            TabIn()
            For Each childElement As CodeElement In codeModel.CodeElements
                If TypeOf childElement Is CodeClass Then
                    WriteClass(childElement)
                End If
                If TypeOf childElement Is CodeEnum Then
                    WriteLine("Enum: " & childElement.FullName)
                End If
                If TypeOf childElement Is CodeInterface Then
                    WriteLine("Interface: " & childElement.FullName)
                End If
            Next
            TabOut()
        End If

    End Sub

    Private Sub WriteClass(ByVal codeClass As CodeClass)

        If codeClass Is Nothing Then
            Return
        End If

        m_numberOfClasses += 1

        WriteLine("Class: " & codeClass.FullName)

        TabIn()
        WriteLine("Properties")
        TabIn()
        For Each member As CodeElement In codeClass.Members
            If TypeOf member Is CodeProperty Then
                WriteProperties(member)
            End If
        Next
        TabOut()
        WriteLine("Functions")
        TabIn()
        For Each member As CodeElement In codeClass.Members
            If TypeOf member Is CodeFunction Then
                WriteFunction(member)
            End If
        Next
        TabOut()
        TabOut()

    End Sub

    Private Sub WriteProperties(ByVal codeProperty As CodeProperty)

        If codeProperty Is Nothing Then
            Return
        End If

        WriteLine(codeProperty.Name)

    End Sub

    Private Sub WriteFunction(ByVal codeFunction As CodeFunction)

        If codeFunction Is Nothing Then
            Return
        End If

        m_numberOfFunctions += 1
        WriteLine(codeFunction.Name)

        Dim startPoint As TextPoint = codeFunction.StartPoint
        Dim endPoint As TextPoint = codeFunction.EndPoint

        Dim lines As Integer = endPoint.Line - startPoint.Line
        m_linesOfCode += lines

    End Sub

    Private Sub TabIn()
        m_indent += 1
    End Sub

    Private Sub TabOut()
        m_indent -= 1
    End Sub

    Private Sub WriteLine(ByVal line As String)

        If m_writeOn Then
            m_editPoint.Insert(New String(vbTab, m_indent) & line & newline)
        End If

    End Sub

End Module


No comments: