Vs宏 工具汇总

转自：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
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

作者：NewSea     出处：http://newsea.cnblogs.com/    QQ,MSN：iamnewsea@hotmail.com   如无特别标记说明，均为NewSea原创，版权私有，翻载必纠。欢迎交流，转载，但要在页面明显位置给出原文连接。谢谢。