[macro]visualstudio2010 マクロ

■VisualStudioマクロ
メソッドの一覧を作ってみた。
マイナーでVS2012ではなくなったらしい。AddInならある？
マイナーで参考サイト少ない。

■資料
ほとんどここから
　http://shimaji.exblog.jp/12436379
MSDN
　http://msdn.microsoft.com/ja-jp/library/EnvDTE(v=vs.100).aspx
何かのテンプレ
　http://www.dotnetwise.com/Icons/Blog/Utilities.vb.txt

■ソース

Imports System
Imports EnvDTE
Imports EnvDTE80
Imports EnvDTE90
Imports EnvDTE90a
Imports EnvDTE100
Imports System.Diagnostics

Imports System.Collections
Imports System.Xml
Imports System.Text
Imports System.Text.RegularExpressions

Public Module Module1

    '=SUBSTITUTE(E3,"★",CHAR(10))
    '=LEN($G3)-LEN(SUBSTITUTE($G3,"★",""))

    'ソリューションに属すすべてのコードファイルから関数を検索し列挙する。
    Public Sub EnumFunctions()
        Dim cnt As Integer
        Dim p As Project
        'ソリューションのすべてのプロジェクトを調べる
        cnt = 0
        For Each p In DTE.Solution.Projects
            'If cnt > 1 Then
            '    Exit For
            'End If

            '除外プロジェクト
            If p.Name.Contains("Applications") Or p.Name.Contains("StandardMes") Or p.Name.Contains("WcfService") Or p.Name.Contains("SummaryRawMaterialsInventory") Then
                Continue For
            End If
            'プロジェクト名
            'Debug.Print(p.Name)
            'EnumProjectItems(p.ProjectItems)

            '一覧形式で出力
            EnumProjectItems2(p.ProjectItems, p.Name)

            cnt = cnt + 1
        Next p
    End Sub

    'プロジェクト要素の検索と出力
    Private Sub EnumProjectItems(ByRef items As ProjectItems)
        Dim pi As ProjectItem

        'プロジェクトの中のすべてのプロジェクトアイテムを調べる
        For Each pi In items
            If Not pi.FileCodeModel Is Nothing Then
                Debug.Print(vbTab + pi.Name)
                EnumCodeElements(pi.FileCodeModel.CodeElements)

            End If
            'プロジェクトアイテム検索のネスト
            If Not pi.ProjectItems Is Nothing Then
                EnumProjectItems(pi.ProjectItems)
            End If
        Next pi
    End Sub

    'プロジェクト要素の検索と出力
    Private Function EnumProjectItems2(ByRef items As ProjectItems, ByVal title As String) As String
        Dim pi As ProjectItem

        Dim fullPath As String
        Dim name As String
        Dim data As String

        'プロジェクトの中のすべてのプロジェクトアイテムを調べる
        For Each pi In items
            data = ""
            If Not pi.FileCodeModel Is Nothing Then

                '対象ファイルパス
                fullPath = pi.FileNames(0)
                fullPath = Replace(fullPath, "C:\", "")

                '対象ファイル名
                name = pi.Name

                '対象ファイルパスからファイル名を除外
                fullPath = Replace(fullPath, name, "")

                '末尾の「\」を除く
                fullPath = fullPath.TrimEnd("\")

                data = title & vbTab & fullPath & vbTab & name
                'Debug.Print(data)

                EnumCodeElements2(pi.FileCodeModel.CodeElements, data)

            End If
            'プロジェクトアイテム検索のネスト
            If Not pi.ProjectItems Is Nothing Then
                EnumProjectItems2(pi.ProjectItems, title)
            End If
        Next pi
    End Function

    'コード要素の検索と出力
    Private Sub EnumCodeElements(ByRef elems As CodeElements)

        Dim func As CodeFunction 'コード関数

        Dim elem As CodeElement 'コード要素
        For Each elem In elems


            '探し当てたのが関数名であれば出力ウィンドウ(デバッグ)に名称を出力
            If elem.Kind = vsCMElement.vsCMElementFunction Then

                ' キャスト
                func = elem
                Dim i As Integer

                ' 修飾子がPublicのみ
                If func.Access <> vsCMAccess.vsCMAccessPublic Then
                    Continue For
                End If

                ' ブロックコメント
                Debug.Print("---- " + func.DocComment)

                ' ネームスペースありの名前
                Debug.Print("--- " + elem.FullName)
                ' 関数名
                Debug.Print("--- " + elem.Name)
                ' パラメータ名
                For i = 1 To func.Parameters.Count
                    'Debug.Print("---- [" + i.ToString + "]:" + func.Parameters.Item(i).Name)
                    Dim start As TextPoint = func.Parameters.Item(i).GetStartPoint()
                    Dim finish As TextPoint = func.Parameters.Item(i).GetEndPoint()
                    Debug.Print("---- [" + i.ToString + "]:" & start.CreateEditPoint.GetText(finish))
                Next

                ' 改行
                Debug.Print("")
                Debug.Print("")

            End If
            'コード要素検索のネスト
            If Not elem.Children Is Nothing Then
                EnumCodeElements(elem.Children)
            End If
        Next elem
    End Sub

    'メソッド横一列表示用
    Private Sub EnumCodeElements2(ByRef elems As CodeElements, ByVal title As String)

        Dim func As CodeFunction 'コード関数
        Dim elem As CodeElement 'コード要素

        Dim result As String

        Dim delemiter As String = "★"
        For Each elem In elems

            '探し当てたのが関数名であれば出力ウィンドウ(デバッグ)に名称を出力
            If elem.Kind = vsCMElement.vsCMElementFunction Then

                ' キャスト
                func = elem
                Dim i As Integer

                ' 修飾子がPublicのみ
                If func.Access <> vsCMAccess.vsCMAccessPublic Then
                    Continue For
                End If

                ' パラメータ
                Dim param As String
                param = ""
                For i = 1 To func.Parameters.Count
                    Dim start As TextPoint = func.Parameters.Item(i).GetStartPoint()
                    Dim finish As TextPoint = func.Parameters.Item(i).GetEndPoint()
                    param &= (start.CreateEditPoint.GetText(finish) & delemiter)
                Next
                '末尾のdelemiter削除
                param = param.TrimEnd(delemiter)

                Dim fullName As String = elem.FullName
                Dim name As String = elem.Name
                Dim returnVal As String

                'ネームスペースからメソッド名を削除
                fullName = fullName.Replace(name, "")
                '末尾の「.」を削除
                fullName = fullName.TrimEnd(".")

                ' 戻り値を取得
                If Not func.Type.TypeKind = vsCMTypeRef.vsCMTypeRefOther Then
                    returnVal = func.Type.CodeType.FullName.ToString
                End If

                'ブロックコメントからsummaryを取得

                'DocCommentの<summary>を抜出
                Dim outComment As String = GetXmlComment(func.DocComment, "summary")

                ' ネームスペース、メソッド名、引数（カンマ区切り）
                Debug.Print(title & vbTab & fullName & vbTab & name & vbTab & outComment & vbTab & returnVal & vbTab & param)

            End If
            'コード要素検索のネスト
            If Not elem.Children Is Nothing Then
                EnumCodeElements2(elem.Children, title)
            End If
        Next elem
    End Sub

    'クラス一覧表示
    Private Sub EnumCodeElements3(ByRef elems As CodeElements, ByVal title As String)

        Dim kurasu As CodeClass 'クラス
        Dim elem As CodeElement 'コード要素

        Dim result As String

        Dim delemiter As String = "★"
        For Each elem In elems

            If elem.Kind = vsCMElement.vsCMElementClass Then

                'キャスト？
                kurasu = elem

                Dim fullName As String = kurasu.FullName
                Dim name As String = kurasu.Name

                'ネームスペースからメソッド名を削除
                fullName = fullName.Replace(name, "")
                '末尾の「.」を削除
                fullName = fullName.TrimEnd(".")

                'DocCommentの<summary>を抜出
                Dim outComment As String = GetXmlComment(kurasu.DocComment, "summary")

                ' ネームスペース、メソッド名、引数（カンマ区切り）
                Debug.Print(title & vbTab & fullName & vbTab & name & vbTab & outComment)

            End If

            'コード要素検索のネスト
            If Not elem.Children Is Nothing Then
                EnumCodeElements3(elem.Children, title)
            End If

        Next elem
    End Sub

    'DocCommentの<要素>を抜出
    Private Function GetXmlComment(ByVal comment As String, ByVal attributeName As String) As String

        Dim outComment = ""

        If comment Is Nothing Or comment = "" Then
            Return ""
        End If

        '<summary></summary>など
        Dim startAtr As String = "<" & attributeName & ">"
        Dim endAtr As String = ""

        Dim startSummary As Integer = comment.IndexOf(startAtr)
        Dim endSummary As Integer = comment.IndexOf(endAtr)

        If (startSummary > -1 And startSummary < endSummary) Then
            startSummary += startAtr.Length
            Dim innerComment = comment.Substring(startSummary, endSummary - startSummary).Trim()
            If (innerComment.Length <> 0) Then
                'summaryコメントの取得
                outComment = innerComment
            End If
        End If

        '改行と<para></para>を取り除く

        outComment = outComment.Replace(vbCrLf, "")
        outComment = outComment.Replace(vbCr, "")
        outComment = outComment.Replace(vbLf, "")
        outComment = outComment.Replace("<para>", "")
        outComment = outComment.Replace("</para>", "")

        Return outComment
    End Function

End Module