equals-forty-two.com

Imports System
Imports EnvDTE
Imports EnvDTE80
Imports EnvDTE90
Imports EnvDTE90a
Imports EnvDTE100
Imports System.Diagnostics
Imports Microsoft.VisualStudio.VCProject
Imports Microsoft.VisualStudio.VCProjectEngine
 
Public Module Quickies
 
    Sub RegKeySave(ByVal i_RegKey As String, _
               ByVal i_Value As String, _
      Optional ByVal i_Type As String = "REG_SZ")
        Dim myWS As Object
 
        'access Windows scripting
        myWS = CreateObject("WScript.Shell")
        'write registry key
        myWS.RegWrite(i_RegKey, i_Value, i_Type)
 
    End Sub
 
    Function GetMiscDumpPane() As OutputWindowPane
 
        Dim ow As OutputWindow = DTE.Windows.Item(Constants.vsWindowKindOutput).Object
        Dim pane As OutputWindowPane
 
        Try
            pane = ow.OutputWindowPanes.Item("MyMacrosPane")
        Catch ex As Exception
            pane = ow.OutputWindowPanes.Add("MyMacrosPane")
        End Try
        Return pane
    End Function
 
    Sub SetAutoDebug(ByVal state As Boolean)
 
        Dim linkerOutput As String
        Dim itemName As String
        Dim projectName As String
        Dim project As EnvDTE.Project
 
        If DTE.ActiveSolutionProjects.Length <> 1 Then
            MsgBox("Select one project within the Solution Explorer, then re-run this macro.")
            Exit Sub
        End If
 
        Dim pane As OutputWindowPane = GetMiscDumpPane()
 
        project = DTE.ActiveSolutionProjects(0)
        itemName = project.FullName()
 
        ' Get linker option
        If project.Kind = vcContextGuids.vcContextGuidVCProject Then
            Dim vcProj As VCProject = project.Object
            Dim configs As IVCCollection = vcProj.Configurations
 
            projectName = vcProj.Name
 
            Dim cfg As VCConfiguration = configs.Item(1)
            If cfg Is Nothing Then
                pane.OutputString("Project " & vcProj.Name & " has no valid configuration" & vbCr)
                Exit Sub
            End If
 
            Dim tools As IVCCollection = cfg.Tools
            Dim linkerTool As VCLinkerTool = tools.Item("VCLinkerTool")
            If linkerTool Is Nothing Then
                pane.OutputString("Project " & vcProj.Name & " has no output" & vbCr)
                Exit Sub
            End If
 
            linkerOutput = linkerTool.OutputFile
            linkerOutput = linkerOutput.Substring(linkerOutput.IndexOf("$(OutDir)") + 9)
 
        End If
 
        If state = True Then
            ' On
            RegKeySave("HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows NT\CurrentVersion\Image File Execution Options\" & linkerOutput & "\debugger", "vsjitdebugger.exe")
 
            pane.OutputString("Project " & linkerOutput & " => Auto debug ON" & vbCr)
        Else
            ' Off
            RegKeySave("HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows NT\CurrentVersion\Image File Execution Options\" & linkerOutput & "\debugger", "")
 
            pane.OutputString("Project " & linkerOutput & " => Auto debug OFF" & vbCr)
        End If
 
    End Sub
 
    Sub SetAutoDebugOn()
        SetAutoDebug(True)
    End Sub
 
    Sub SetAutoDebugOff()
        SetAutoDebug(False)
    End Sub
 
End Module