[VB.Net]
Imports System.ComponentModel
Imports System.Runtime.InteropServices

Module DTEUtils

    Public ReadOnly VS2002MonikerBase As String = "!VisualStudio.DTE.7:"
    Public ReadOnly VS2003MonikerBase As String =
"!VisualStudio.DTE.7.1:"

    Public Enum VisualStudioVersion
        [VS2002]
        [VS2003]
    End Enum

    Private Class Win32API
        <DllImport("ole32.dll")> _
        Public Shared Function GetRunningObjectTable(ByVal reserved As
Integer, <Out()> ByRef prot As UCOMIRunningObjectTable) As Integer
        End Function

        <DllImport("ole32.dll")> _
        Public Shared Function CreateBindCtx(ByVal reserved As Integer,
<Out()> ByRef ppbc As UCOMIBindCtx) As Integer
        End Function
    End Class

    Public Overloads Function GetVisualStudioMoniker(ByVal version As
VisualStudioVersion) As String
        Dim strBase As String

        Select Case version
            Case VisualStudioVersion.VS2002
                strBase = VS2002MonikerBase
            Case VisualStudioVersion.VS2003
                strBase = VS2003MonikerBase
        End Select

        Return strBase &
System.Diagnostics.Process.GetCurrentProcess().Id.ToString()
    End Function

    Public Overloads Function GetVisualStudioMoniker() As String
        Return GetVisualStudioMoniker(VisualStudioVersion.VS2002)
    End Function

    Public Function GetDTE() As Object
        Dim strMoniker As String =
GetVisualStudioMoniker(VisualStudioVersion.VS2002)
        Dim objDTE As Object = GetMSDEVFromGIT(strMoniker)

        If objDTE Is Nothing Then
            strMoniker =
GetVisualStudioMoniker(VisualStudioVersion.VS2003)
            objDTE = GetMSDEVFromGIT(strMoniker)
        End If

        Return objDTE
    End Function

    Public Overloads Function GetProjectUrl() As String
        Return GetProjectUrl(GetDTE())
    End Function

    Public Overloads Function GetProjectUrl(ByVal DTE As Object) As
String
        Dim strUrl As String

        Try
            Dim projs() As Object = DTE.ActiveSolutionProjects
            Dim proj As Object = projs(0)
            strUrl = proj.Properties.Item("URL").Value
        Catch exc As Exception
            Console.WriteLine(exc.Message,
exc.GetBaseException.GetType.Name)
            Console.WriteLine(exc.StackTrace)
        End Try

        If Right(strUrl, 1) = "/" Then strUrl = Left(strUrl, Len(strUrl)
- 1)

        Return strUrl
    End Function


    Public Overloads Function GetProjectLocalPath() As String
        Return GetProjectLocalPath(GetDTE())
    End Function

    Public Overloads Function GetProjectLocalPath(ByVal DTE As Object)
As String
        Dim strPath As String

        Try
            Dim projs() As Object = DTE.ActiveSolutionProjects
            Dim proj As Object = projs(0)
            strPath = proj.Properties.Item("LocalPath").Value
        Catch exc As Exception
            Console.WriteLine(exc.Message,
exc.GetBaseException.GetType.Name)
            Console.WriteLine(exc.StackTrace)
        End Try

        If Right(strPath, 1) = "/" Then strPath = Left(strPath,
Len(strPath) - 1)

        Return strPath
    End Function


    Public Function GetMSDEVFromGIT(ByVal strProgID As String) As Object

        Dim prot As UCOMIRunningObjectTable
        Dim pMonkEnum As UCOMIEnumMoniker

        Win32API.GetRunningObjectTable(0, prot)
        prot.EnumRunning(pMonkEnum)
        pMonkEnum.Reset()

        Dim fetched As Integer

        Dim pmon(1) As UCOMIMoniker


        While pMonkEnum.Next(1, pmon, fetched) = 0
            Dim pCtx As UCOMIBindCtx
            Win32API.CreateBindCtx(0, pCtx)

            Dim str As String
            pmon(0).GetDisplayName(pCtx, Nothing, str)

            If str = strProgID Then
                Dim objReturnObject As Object
                prot.GetObject(pmon(0), objReturnObject)
                Return objReturnObject

            End If

        End While

        Return Nothing

    End Function


Public Function GetCurrentWebFormUrl()

       Dim svc As IWebFormsDocumentService =
       Me.GetService(GetType(IWebFormsDocumentService))
       Return svc.DocumentUrl

End Function

End Module