Vs宏 工具汇总

工作中用到的几个宏,感觉很有用.做一个汇总

1.把 Dll 拷贝到: C:\Program Files (x86)\Microsoft Visual Studio 10.0\Common7\IDE\PublicAssemblies

2. 添加  dll 引用,以及 System.Core.dll 4.0

3.添加 Base 文件 ,如下: 

Imports System
Imports EnvDTE
Imports EnvDTE80
Imports EnvDTE90
Imports EnvDTE90a
Imports EnvDTE100
Imports System.Diagnostics
Imports System.IO
Imports System.Windows.Forms
Imports System.Threading
Imports System.Linq
Imports MyCmn


Public Module Base

    Function GetFileName(ByVal item As EnvDTE.SelectedItem) As String
        If (item.ProjectItem Is Nothing) Then
            GetFileName = item.Project.FullName
        Else
            GetFileName = item.ProjectItem.Properties.Item("FullPath").Value
        End If
    End Function

    Public ClipString As String
    'Udi 2012年9月20日
    Function GetClipString()
        ClipString = Clipboard.GetDataObject().GetData(System.Windows.Forms.DataFormats.StringFormat)
    End Function

End Module

4.添加 Udi 文件(无意义) 

Imports System
Imports EnvDTE
Imports EnvDTE80
Imports EnvDTE90
Imports EnvDTE90a
Imports EnvDTE100
Imports System.Diagnostics
Imports System.IO
Imports System.Windows.Forms
Imports System.Threading
Imports System.Linq
Imports MyCmn


Public Module Udi

    'Udi 2012年9月20日
    Function CopyFileToPath(ByVal fileName As String) As String
        CopyFileToPath = ""

        Dim strDesc As String
        Dim strFileName As String
        Dim strSrc As String
        Dim solutionPathArray = DTE.Solution.FullName.Split("\").ToArray()
        Dim path = ""
        Dim process As System.Diagnostics.Process

        For i = 0 To solutionPathArray.Length
            If (i = solutionPathArray.Length - 1) Then
                Exit For
            End If
            path = path + solutionPathArray(i) + "\"
        Next
        'String.Join("\", solutionPathArray.GetSub(1, solutionPathArray.Count() - 1))
        strSrc = fileName
        strDesc = "D:\NewApp_" + Date.Today.ToString("yyyy-MM-dd") + "\" + strSrc.Substring(path.Length)
        Try
            Dim di = New System.IO.FileInfo(strDesc)
            If System.IO.Directory.Exists(di.DirectoryName) = False Then
                System.IO.Directory.CreateDirectory(di.DirectoryName)
            End If

            System.IO.File.Copy(fileName, strDesc, True)

        Catch ex As System.Exception
            CopyFileToPath = "目标:[" + strDesc + "]" + vbLf + vbLf + ex.Message
            process = New System.Diagnostics.Process()
            process.StartInfo = New System.Diagnostics.ProcessStartInfo("explorer.exe")
            Dim fi = New FileInfo(strDesc)
            process.StartInfo.Arguments = fi.DirectoryName
            process.Start()

        End Try

    End Function

    'Udi 2012年9月20日
    Sub CopyFileToPathWithMsg()

        Dim files = New System.Collections.Generic.List(Of String)

        For i As Integer = 1 To DTE.SelectedItems.Count
            Dim fileName = Base.GetFileName(DTE.SelectedItems.Item(i)) ' DirectCast(DTE.SelectedItems.Item(i).ProjectItem, EnvDTE.ProjectItem).Properties.Item("FullPath").Value
            files.Add(fileName)

            If (System.IO.Directory.Exists(fileName)) Then

                Dim fs = System.IO.Directory.GetFiles(fileName, SearchOption.AllDirectories)

                For j As Integer = 0 To fs.Length - 1
                    Dim res = CopyFileToPath(fs(j))
                    If (res.Length > 0) Then
                        MsgBox("拷贝失败:" + res, MsgBoxStyle.Exclamation Or MsgBoxStyle.OkOnly)
                        Exit Sub
                    End If
                Next
            ElseIf (System.IO.File.Exists(fileName)) Then

                Dim res = CopyFileToPath(fileName)
                If (res.Length > 0) Then
                    MsgBox("拷贝失败:" + res, MsgBoxStyle.Exclamation Or MsgBoxStyle.OkOnly)
                    Exit Sub
                End If
            Else
                MsgBox("找不到文件：" + fileName)
                Exit Sub
            End If

        Next

        MsgBox("拷贝成功: " + vbNewLine + files.Join(vbNewLine), MsgBoxStyle.OkOnly Or MsgBoxStyle.Information, "成功.")

    End Sub



    'Udi 2012年9月20日
    Sub SelectInSolution()
        Dim fileFullName = DTE.ActiveDocument.FullName
        Dim solutionFullName = DTE.Solution.FullName

        Dim solutionPath = solutionFullName.Substring(0, solutionFullName.LastIndexOf("\"))

        Dim filePath = fileFullName.Substring(solutionPath.Length)

        Dim soPath = "LongFor_PM\Host" + filePath


        DTE.Windows.Item(Constants.vsWindowKindSolutionExplorer).Activate()
        DTE.ActiveWindow.Object.GetItem("LongFor_PM\Host").UIHierarchyItems.Expanded = True


        Dim sect = soPath.Substring("LongFor_PM\Host\".Length).Split("\").ToArray()


        For i As Integer = 0 To sect.Length - 1
            If sect(i) = "MyBiz" Then sect(i) = "PmBiz"

            DTE.ActiveWindow.Object.GetItem("LongFor_PM\Host\" + String.Join("\", System.Linq.Enumerable.Take(sect, i + 1).ToArray())).UIHierarchyItems.Expanded = True
        Next

        soPath = soPath.Replace("\MyBiz\", "\PmBiz\")
        DTE.ActiveWindow.Object.GetItem(soPath).Select(vsUISelectionType.vsUISelectionTypeSelect)

    End Sub

    'Udi 2012年9月20日
    Sub OpenMvc()

        Dim ClipBoardThread As System.Threading.Thread
        ClipBoardThread = New System.Threading.Thread(AddressOf Base.GetClipString)
        With ClipBoardThread
            .ApartmentState = ApartmentState.STA
            .IsBackground = True
            .Start()
            '-- Wait for copy to happen
            .Join()
        End With



        ClipBoardThread = Nothing

        Dim url = InputBox("输入 LongFor - PM 网址(IIS 需要配置成应用程序)，支持如下格式：" + vbNewLine _
                             + vbNewLine + _
                           "1. http://localhost/pm/Admin/Home/Index.aspx 格式 " + vbNewLine + _
                           "2. /pm/Admin/Home/Index.aspx 格式" + vbNewLine + _
                           "3. ~/Admin/Home/Index.aspx 格式" + vbNewLine + _
                           "4. localhost/pm/Admin/Home/Index.aspx 格式 " + vbNewLine + _
                          "", "直接打开URL小工具", Base.ClipString)

        url = url.Trim()

        If (url.Length = 0) Then Return

        Dim path As String

        path = New FileInfo(DTE.Solution.FullName).DirectoryName


        If (url.StartsWith("http://") = False) Then

            If (url.StartsWith("/")) Then
                url = "http://localhost" + url
            ElseIf (url.StartsWith("~/")) Then
                url = "http://localhost/pm" + url.Substring(1)
            Else
                url = "http://" + url
            End If
        End If

        Dim sect = url.Substring(url.IndexOf("/", "http://".Length + 1) + 1).Split("/")

        Dim area = sect(1)
        Dim controller = sect(2)
        Dim action = sect(3).Split(".")(0)

        Dim cs As String
        Dim aspx As String

        Dim isMvc = False

        If (",Admin,cs,Host,".IndexOf("," + area + ",", StringComparison.CurrentCultureIgnoreCase) >= 0) Then
            path += "\MyWeb\Area\"
            isMvc = True
        ElseIf (",Cost,Master,Sys,Property,Report".IndexOf("," + area + ",", StringComparison.CurrentCultureIgnoreCase) >= 0) Then
            path += "\MyWeb\pm\"
            isMvc = True
        Else
            path += "\MyWeb\"

            cs = path + area + "\" + controller + "\" + action + ".aspx.cs"
            aspx = path + area + "\" + controller + "\" + action + ".aspx"
        End If

        If (isMvc) Then
            cs = path + area + "\Controllers\" + controller + ".cs"
            If (File.Exists(cs) = False) Then cs = path + area + "\Controllers\" + controller + "Controller.cs"

            aspx = path + area + "\Views\" + controller + "\" + action + ".aspx"
        End If

        If (File.Exists(cs)) Then
            DTE.ItemOperations.OpenFile(cs)
            FindWord(action)
        End If

        If (File.Exists(aspx)) Then DTE.ItemOperations.OpenFile(aspx)
    End Sub



    Sub FindWord(ByVal word As String)
        DTE.ExecuteCommand("Edit.Find")
        DTE.Find.FindWhat = word
        DTE.Find.Target = vsFindTarget.vsFindTargetCurrentDocument
        DTE.Find.MatchCase = True
        DTE.Find.MatchWholeWord = True
        DTE.Find.Backwards = False
        DTE.Find.MatchInHiddenText = False
        DTE.Find.PatternSyntax = vsFindPatternSyntax.vsFindPatternSyntaxLiteral
        DTE.Find.Action = vsFindAction.vsFindActionFind
        If (DTE.Find.Execute() = vsFindResult.vsFindResultNotFound) Then
            Exit Sub
        End If
        DTE.Windows.Item("{CF2DDC32-8CAD-11D2-9302-005345000000}").Close()
    End Sub


    '补全自闭合标签。像 input br meta
    Sub TidyHtmlSolo()

        For i As Integer = 1 To DTE.SelectedItems.Count
            Dim fileName = Base.GetFileName(DTE.SelectedItems.Item(i)) 'DirectCast(DTE.SelectedItems.Item(i).ProjectItem, EnvDTE.ProjectItem).Properties.Item("FullPath").Value


            If (System.IO.Directory.Exists(fileName)) Then

                Dim fs = Directory.GetFiles(fileName, "*.aspx", SearchOption.AllDirectories).ToList()
                fs.AddRange(Directory.GetFiles(fileName, "*.Master", SearchOption.AllDirectories))

                For j As Integer = 0 To fs.Count - 1

                    TidyOneHtmlSolo(fs(j))

                Next
            ElseIf (System.IO.File.Exists(fileName)) Then
                TidyOneHtmlSolo(fileName)
            Else
                MsgBox("找不到文件：" + fileName)
                Exit Sub
            End If

        Next
    End Sub

    Function TidyOneHtmlSolo(ByVal fileName As String)
        If (File.Exists(fileName) = False) Then
            MsgBox("找不到文件：" + fileName)
            Exit Function
        End If

        Dim txt = File.ReadAllText(fileName, System.Text.Encoding.Default)

        Dim html = New HtmlCharLoad(txt)
        Dim list = html.Load(HtmlNodeProc.ProcType.None)


        For i As Integer = 0 To list.Count - 1
            Dim o = list(i)
            If o.Type = HtmlNode.NodeType.Text Then

                Dim txtNode = CType(o, MyCmn.HtmlTextNode).Text.Trim()
                If (txtNode.StartsWith("<!DOCTYPE", StringComparison.CurrentCultureIgnoreCase)) Then
                    CType(o, MyCmn.HtmlTextNode).Text = "<!DOCTYPE html>"
                End If

            ElseIf o.Type = HtmlNode.NodeType.Tag Then
                Dim tag = CType(o, HtmlTagNode)
                If tag.TagName.ToLower().IsIn(New String() {"input", "br", "meta", "link"}) Then
                    If (tag.IsSole = False And i < list.Count - 1) Then
                        Dim n = list(i + 1)
                        If (n.Type <> HtmlNode.NodeType.CloseTag) Then
                            tag.IsSole = True
                        End If
                    End If


                ElseIf tag.TagName.Equals("html", StringComparison.CurrentCultureIgnoreCase) Then
                    tag.Attrs.Clear()

                    Dim atrId = New HtmlAttrNode()
                    atrId.Name = "id"
                    atrId.Value = "html_" + IIf(fileName.Contains("Main"), "Main", "Style")

                    'Dim atrXmlns = New HtmlAttrNode()
                    'atrXmlns.Name = "xmlns"
                    'atrXmlns.Value = "http://www.w3.org/1999/xhtml"

                    tag.Attrs.Add(atrId)
                    'tag.Attrs.Add(atrXmlns)
                End If
            End If
        Next


        File.WriteAllText(fileName, String.Join("", list.Select(Function(a) a.ToString()).ToArray()), System.Text.Encoding.UTF8)
    End Function
End Module

5. 定义快捷键.

随笔链接:

Vs宏 之 整理HTML文档格式　　http://www.cnblogs.com/newsea/archive/2012/11/23/2784337.html

VS宏 之 选中解决方案中的文件　　http://www.cnblogs.com/newsea/archive/2012/09/06/2673319.html

Vs宏 之 打开URL指定的文件　　http://www.cnblogs.com/newsea/archive/2012/08/13/2636480.html

VS 宏 之 转换Json数据格式　　http://www.cnblogs.com/newsea/archive/2012/05/28/2521368.html