Vs宏工具汇总

原创

小哥 2年前 (2023-05-24) 阅读数 87 #大杂烩

转自：http://www.cnblogs.com/newsea/archive/2012/11/28/2792457.html

工作中使用的几个宏,感觉非常有用.做一个总结

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

添加 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 文件(无意义)

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(""
            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