拼搏中的麦壳饼

关注VS2010 关注.Net 4.0 关注微软 C# 源码 VB.net 源码 .Net 最新编码技巧 请访问 Visual Studio Fans 详情访问 http://www.visualstudiofans.com/
posts - 23, comments - 22, trackbacks - 0, articles - 3

2006年3月2日

Visual Studio 中的代码段(*.Snippet文件)操作类.

posted @ 2006-03-02 02:45 麦壳饼 阅读(788) 评论(1) 编辑

使用VB2005开发外接程序Connect类中需要了解的一些事件

Imports System
Imports Microsoft.VisualStudio.CommandBars
Imports Extensibility
Imports EnvDTE
Imports EnvDTE80

Public Class Connect

    Implements IDTExtensibility2
 Implements IDTCommandTarget


    Dim cmWhen As ext_ConnectMode


    '''<summary>实现外接程序对象的构造函数。请将您的初始化代码置于此方法内。</summary>
    Public Sub New()

    End Sub

    '''<summary>实现 IDTExtensibility2 接口的 OnConnection 方法。接收正在加载外接程序的通知。</summary>
    '''<param name='application'>宿主应用程序的根对象。</param>
    '''<param name='connectMode'>描述外接程序的加载方式。</param>
    '''<param name='addInInst'>表示此外接程序的对象。</param>
    '''<remarks>当程序第一次执行时不加载,如果有必要,进行一些初始化工作,等到启动环境时记下启动模式,在启动完成后再加载</remarks>
    Public Sub OnConnection(ByVal Application As Object, ByVal ConnectMode As ext_ConnectMode, ByVal AddInInst As Object, ByRef Custom As Array) Implements IDTExtensibility2.OnConnection
        chDTE = CType(Application, DTE2)
        chAddIN = CType(AddInInst, AddIn)
        If ConnectMode <> ext_ConnectMode.ext_cm_UISetup And ConnectMode <> ext_ConnectMode.ext_cm_Startup Then
            LoadCoderHelper()
        Else
            cmWhen = ConnectMode
        End If
        
    End Sub

    '''<summary>实现 IDTExtensibility2 接口的 OnDisconnection 方法。接收正在卸载外接程序的通知。</summary>
    '''<param name='disconnectMode'>描述外接程序的卸载方式。</param>
    '''<param name='custom'>特定于宿主应用程序的参数数组。</param>
    '''<remarks>只载环境要关闭或用户要求关闭时才卸载,其他方式不卸载</remarks>
    Public Sub OnDisconnection(ByVal disconnectMode As ext_DisconnectMode, ByRef custom As Array) Implements IDTExtensibility2.OnDisconnection
        Debug.Write("OnDisconnection" & custom.ToString & Now & vbNewLine)
        If disconnectMode = ext_DisconnectMode.ext_dm_HostShutdown Or _
            disconnectMode = ext_DisconnectMode.ext_dm_UserClosed Then
            UnloadCoderHelper()
        End If
    End Sub

    '''<summary>实现 IDTExtensibility2 接口的 OnAddInsUpdate 方法。接收外接程序集合已更改的通知。</summary>
    '''<param name='custom'>特定于宿主应用程序的参数数组。</param>
    '''<remarks></remarks>
    Public Sub OnAddInsUpdate(ByRef custom As Array) Implements IDTExtensibility2.OnAddInsUpdate
        'Debug.Write("OnAddInsUpdate" & custom.ToString & Now & vbNewLine)
        '  LoadCoderHelper()
    End Sub

    '''<summary>实现 IDTExtensibility2 接口的 OnStartupComplete 方法。接收宿主应用程序已完成加载的通知。</summary>
    '''<param name='custom'>特定于宿主应用程序的参数数组。</param>
    '''<remarks>如果是启动时需要加载,则载启动完成后加载,因为环境没有加载完成的情况下,将成功调用环境内的命令</remarks>
    Public Sub OnStartupComplete(ByRef custom As Array) Implements IDTExtensibility2.OnStartupComplete
        If cmWhen = ext_ConnectMode.ext_cm_Startup Then
            LoadCoderHelper()
            'chCES.Show()
        End If
    End Sub

    '''<summary>实现 IDTExtensibility2 接口的 OnBeginShutdown 方法。接收正在卸载宿主应用程序的通知。</summary>
    '''<param name='custom'>特定于宿主应用程序的参数数组。</param>
    '''<remarks>开始卸载环境时迅速卸载本程序的一些功能</remarks>
    Public Sub OnBeginShutdown(ByRef custom As Array) Implements IDTExtensibility2.OnBeginShutdown
        Debug.Write("OnBeginShutdown" & custom.ToString & Now & vbNewLine)
        UnloadCoderHelper()

    End Sub
 
    '''<summary>实现 IDTCommandTarget 接口的 QueryStatus 方法。此方法在更新该命令的可用性时调用</summary>
    '''<param name='commandName'>要确定其状态的命令的名称。</param>
    '''<param name='neededText'>该命令所需的文本。</param>
    '''<param name='status'>该命令在用户界面中的状态。</param>
    '''<param name='commandText'>neededText 参数所要求的文本。</param>
    '''<remarks></remarks>
    Public Sub QueryStatus(ByVal CommandName As String, ByVal neededText As vsCommandStatusTextWanted, ByRef status As vsCommandStatus, ByRef commandText As Object) Implements IDTCommandTarget.QueryStatus
        Debug.WriteLine("OueryStatus" & commandName & Now & vbNewLine)
        If neededText = vsCommandStatusTextWanted.vsCommandStatusTextWantedNone Then
            If GetStatus(CommandName) Then
                status = CType(vsCommandStatus.vsCommandStatusEnabled + vsCommandStatus.vsCommandStatusSupported, vsCommandStatus)
            Else
                status = vsCommandStatus.vsCommandStatusUnsupported
            End If
        End If
    End Sub

    '''<summary>实现 IDTCommandTarget 接口的 Exec 方法。此方法在调用该命令时调用。</summary>
    '''<param name='commandName'>要执行的命令的名称。</param>
    '''<param name='executeOption'>描述该命令应如何运行。</param>
    '''<param name='varIn'>从调用方传递到命令处理程序的参数。</param>
    '''<param name='varOut'>从命令处理程序传递到调用方的参数。</param>
    '''<param name='handled'>通知调用方此命令是否已被处理。</param>
    '''<remarks></remarks>
    Public Sub Exec(ByVal commandName As String, ByVal executeOption As vsCommandExecOption, ByRef varIn As Object, ByRef varOut As Object, ByRef handled As Boolean) Implements IDTCommandTarget.Exec
        handled = False
        '  chCES.Show()
        Debug.Write("Exec" & commandName & Now & vbNewLine)
        If executeOption = vsCommandExecOption.vsCommandExecOptionDoDefault Then
            handled = ToDoCommand(commandName, varIn, varOut)
        End If
 End Sub

   
   
End Class

posted @ 2006-03-02 02:17 麦壳饼 阅读(887) 评论(2) 编辑

VB2005编写外接程序的一些有用函数

以下代码对于外接程序的制作非常有用，
注意：在DTE80下处理项目需要使用DTE7中的类，而不是DTE80。

Imports System
Imports Microsoft.VisualStudio.CommandBars
Imports Extensibility
Imports EnvDTE
Imports EnvDTE80
Module modFuns

    ''' <summary>
    ''' 获取当前语言版本的菜单标题字符串.
    ''' </summary>
    ''' <param name="resKey">标准字符串名称.</param>
    ''' <returns></returns>
    ''' <remarks></remarks>
    Public Function GetDTEMenuName(ByVal resKey As String) As String
        '    功能:该代码实现从资源文件中读取DTE的菜单标题
        '完成日期:2006-01-13
        Dim ResMg As System.Resources.ResourceManager = New System.Resources.ResourceManager("CoderHelper.CommandBar", System.Reflection.Assembly.GetExecutingAssembly())
        Dim CultureInfo As System.Globalization.CultureInfo = New System.Globalization.CultureInfo(chDTE.LocaleID)
        Dim chMenuName As String = ResMg.GetString(String.Concat( _
                                    CultureInfo.TwoLetterISOLanguageName _
                                    & IIf(CultureInfo.TwoLetterISOLanguageName = "zh", _
                                    "-" & CultureInfo.ThreeLetterWindowsLanguageName.ToString, _
                                    "").ToString, resKey))
        '根据CommandBar.resx的资源分析,该资源中仅仅包含了中文的多类别,既简体和繁体两种,对这两种
        '语言而言, 需要指定 CultureInfo.ThreeLetterWindowsLanguageName是'CHS'还是'CHT',然后与zh
        '之间需要 '-'隔开故.判断如果为'zh'则追加加字符串CultureInfo.ThreeLetterWindowsLanguageName
        '然后与Concat 的第二个参数连接出一字符串给GetString()
        '该方法仅仅用于该语言资源包.且,该资源包完全能够胜任开发任何一种语言的外接程序
        Return chMenuName
    End Function
    ''' <summary>
    ''' 添加命令.
    ''' </summary>
    ''' <param name="CmdName">工具条名称</param>
    ''' <param name="SubItemName">工具条子项目名称</param>
    ''' <param name="Name">要添加的项目名称,</param>
    ''' <param name="Caption"> 要添加的项目标题.该标题还用于删除该按钮/项</param>
    ''' <param name="Position">在SubItemName 项目中的位置</param>
    ''' <param name="Tooltip">按钮的提示条</param>
    ''' <param name="IconID">按钮的图标代码,该代码未Office表情代码,如果要自定义,请设置MsoButton为假</param>
    ''' <param name="MsoButton">真时使用Office中的表情图标,假时使用附属资源DLL中的图片</param>
    ''' <param name="AtAfterItem">设定按钮的位置是否在一个按钮项的后面.</param>
    ''' <param name="AIID">参照项ID 如果AtAfterItem 为真,则按钮位置将是SubItemName 项中第 AIID +Position 项.</param>
    ''' <param name="NeedRegAlias">决定是不是需要为该命令注册别名,以便在命令窗口执行.</param>
    ''' <param name="DontAddToCmdBar"> 不要添加到按钮或工具条中或菜单项中.</param>
    ''' <returns></returns>
    ''' <remarks>注意:该函数建议采用于菜单的添加操作</remarks>
    Public Function AddCommand(ByVal CmdName As String, _
                                ByVal SubItemName As String, _
                                ByVal Name As String, _
                                ByVal Caption As String, _
                                Optional ByVal Position As Integer = 1, _
                                Optional ByVal Tooltip As String = vbNullChar, _
                                Optional ByVal IconID As Object = Nothing, _
                                Optional ByVal MsoButton As Boolean = True, _
                                Optional ByVal AtAfterItem As Boolean = False, _
                                Optional ByVal AIID As Integer = 0, _
                                Optional ByVal NeedRegAlias As Boolean = True, _
                                Optional ByVal DontAddToCmdBar As Boolean = False) As Exception

        Dim Cmds As Commands2 = CType(chDTE.Commands, Commands2)
        Dim CmdBars As CommandBars = CType(chDTE.CommandBars, CommandBars)
        Dim mnuBarCmdBar As CommandBar = CmdBars.Item(CmdName) '菜单
        Dim CmdCtrl As CommandBarControl = mnuBarCmdBar.Controls.Item(SubItemName)
        Dim CmdPopup As CommandBarPopup = CType(CmdCtrl, CommandBarPopup)
        Try
            Dim chCmdConfig As Command = Cmds.AddNamedCommand2( _
                                            chAddIN, Name, Caption, Tooltip, _
                                              MsoButton, _
                                             IconID, _
                                             Nothing, _
                                            CType(vsCommandStatus.vsCommandStatusSupported, Integer) + CType(vsCommandStatus.vsCommandStatusEnabled, Integer), _
                                            vsCommandStyle.vsCommandStylePictAndText, _
                                            vsCommandControlType.vsCommandControlTypeButton)
            If DontAddToCmdBar = False Then
                Try
                    If AIID <> 0 Then
                        chCmdConfig.AddControl(CmdPopup.CommandBar, _
                                             CInt(IIf(AtAfterItem, _
                                                      CmdPopup.CommandBar.FindControl(Id:=AIID).Index + Position, _
                                                      Position)))
                    Else
                        chCmdConfig.AddControl(CmdPopup.CommandBar, Position)
                    End If

                Catch ex As Exception
                    chOutText("向" & CmdPopup.Caption & "中添加" & chCmdConfig.Name & "不成功!")
                End Try
            End If
            If NeedRegAlias Then
                RegAlias(chAddIN.Name & ".Connect." & Name, "ch" & Name.ToLower)
                '外接程序的命令总是以外接程序名称和Connect 类的名称为前缀的.
                '同时本程序为了方便使用由本程序提供的外接,在别名前加 "ch" ,
                '程序以小写为基准.
            End If
            Return (Nothing)

        Catch ex As Exception
            chOutText("向[" & SubItemName & "]中添加[" & Caption & "]项和命令'" & Name & "'失败!")
            Return ex
        End Try
    End Function
    ''' <summary>
    '''
    ''' </summary>
    ''' <param name="Owner">拥有该命令和项的菜单或工具条</param>
    ''' <param name="Name">命令名称.</param>
    ''' <param name="Caption">要添加的项目标题.该标题还用于删除该按钮/项</param>
    ''' <param name="Position">在SubItemName 项目中的位置</param>
    ''' <param name="Tooltip">按钮的提示条</param>
    ''' <param name="IconID"> 按钮的图标代码,该代码未Office表情代码,如果要自定义,请设置MsoButton为假</param>
    ''' <param name="MsoButton">真时使用Office中的表情图标,假时使用附属资源DLL中的图片</param>
    ''' <param name="AtAfterItem">设定按钮的位置是否在一个按钮项的后面.</param>
    ''' <param name="AIID"> 参照项ID 如果AtAfterItem 为真,则按钮位置将是SubItemName 项中第 AIID +Position 项.</param>
    ''' <param name="NeedRegAlias">决定是不是需要为该命令注册别名,以便在命令窗口执行.</param>
    ''' <param name="DontAddToCmdBar">不要添加到按钮或工具条中或菜单项中.</param>
    ''' <returns></returns>
    ''' <remarks>注意:该函数建议采用于菜单的添加操作</remarks>
    Public Function AddCommand(ByVal Owner As CommandBarControl, _
                                   ByVal Name As String, _
                                   ByVal Caption As String, _
                                   Optional ByVal Position As Integer = 1, _
                                   Optional ByVal Tooltip As String = vbNullChar, _
                                   Optional ByVal IconID As Object = Nothing, _
                                   Optional ByVal MsoButton As Boolean = True, _
                                   Optional ByVal AtAfterItem As Boolean = False, _
                                   Optional ByVal AIID As Integer = 0, _
                                   Optional ByVal NeedRegAlias As Boolean = True, _
                                   Optional ByVal DontAddToCmdBar As Boolean = False) As Exception
 
        '
        Dim Cmds As Commands2 = CType(chDTE.Commands, Commands2)
        Dim CmdBars As CommandBars = CType(chDTE.CommandBars, CommandBars)
        Dim mnuBarCmdBar As CommandBar = CmdBars.Item("MenuBar") '菜单
        Dim CmdPopup As CommandBarPopup = CType(Owner, CommandBarPopup)
        Dim ctl As CommandBarControl = Nothing
        Try
            Dim chCmdConfig As Command = Cmds.AddNamedCommand2( _
                                            chAddIN, Name, Caption, Tooltip, _
                                              MsoButton, _
                                             IconID, _
                                             Nothing, _
                                            CType(vsCommandStatus.vsCommandStatusSupported, Integer) + CType(vsCommandStatus.vsCommandStatusEnabled, Integer), _
                                            vsCommandStyle.vsCommandStylePictAndText, _
                                            vsCommandControlType.vsCommandControlTypeButton)
            If DontAddToCmdBar = False Then
                Try
                    If AIID <> 0 Then
                        chCmdConfig.AddControl(CmdPopup.CommandBar, _
                                             CInt(IIf(AtAfterItem, _
                                                      CmdPopup.CommandBar.FindControl(Id:=AIID).Index + Position, _
                                                      Position)))
                    Else
                        chCmdConfig.AddControl(CmdPopup.CommandBar, Position)
                    End If

                Catch ex As Exception
                    chOutText("向" & CmdPopup.Caption & "中添加" & chCmdConfig.Name & "不成功!")
                End Try
            End If
            If NeedRegAlias Then
                RegAlias(chAddIN.Name & ".Connect." & Name, "ch" & Name.ToLower)
                '外接程序的命令总是以外接程序名称和Connect 类的名称为前缀的.
                '同时本程序为了方便使用由本程序提供的外接,在别名前加 "ch" ,
                '程序以小写为基准.
            End If
            Return Nothing

        Catch ex As Exception
            chOutText("向[" & CType(Owner, CommandBarControl).Caption & "]中添加[" & Caption & "]项和命令'" & Name & "'失败!")
            Return ex
        End Try
    End Function

    ''' <summary>
    ''' 简单的添加命令
    ''' </summary>
    ''' <param name="cName">命令名称</param>
    ''' <param name="cAlias">别名</param>
    ''' <remarks>用于添加命令行直接执行的命令.</remarks>
    Public Sub AddCmd(ByVal cName As String, Optional ByVal cAlias As String = "")
        Try
            Dim cmds As Commands2 = CType(chDTE.Commands, Commands2)
            cmds.AddNamedCommand2(chAddIN, cName, cName, cName, True)
        Catch ex As Exception
            chOutText("添加命令[" & cName & "]失败!")
        End Try
        Try
            If cAlias.Trim <> "" Then
                RegAlias(chAddIN.Name & ".Connect." & cName, "ch" & cAlias.ToLower)
            End If
        Catch ex As Exception
        End Try
    End Sub


    ''' <summary>
    ''' 删除一个命令.
    ''' </summary>
    ''' <param name="cName">名称.</param>
    ''' <param name="cAlias">别名</param>
    ''' <remarks></remarks>
    Public Sub DelCmd(ByVal cName As String, Optional ByVal cAlias As String = "")
        Try
            Dim cmds As Commands2 = CType(chDTE.Commands, Commands2)
            cmds.Item(cName).Delete()

        Catch ex As Exception
            chOutText("删除命令[" & cName & "]失败!")
        End Try
        Try
            RegAlias("", "ch" & cAlias.ToLower, True)
        Catch ex As Exception

        End Try
    End Sub


    ''' <summary>
    ''' 从菜单或工具条中删除指定的命令
    ''' </summary>
    ''' <param name="CmdName"></param>
    ''' <param name="SubItemName"></param>
    ''' <param name="Name"></param>
    ''' <param name="Caption"></param>
    ''' <returns></returns>
    ''' <remarks></remarks>
    Public Function DeleteCommand(ByVal CmdName As String, ByVal SubItemName As String, ByVal Name As String, ByVal Caption As String) As Exception
        'CmdName 工具条名称, SubItemName 工具条子项目名称,Name 要添加的项目名称,
        'Caption 要添加的项目标题.此方法内用于删除该按钮/项
        Dim e As Exception = Nothing
        Dim Cmds As Commands2 = CType(chDTE.Commands, Commands2)
        Dim CmdBars As CommandBars = CType(chDTE.CommandBars, CommandBars)
        Dim mnuBarCmdBar As CommandBar = CmdBars.Item(CmdName) '菜单
        Dim CmdCtrl As CommandBarControl = mnuBarCmdBar.Controls.Item(SubItemName)
        Dim CmdPopup As CommandBarPopup = CType(CmdCtrl, CommandBarPopup)
        Try
            Cmds.Item(chAddIN.Name & ".Connect." & Name).Delete()
            RegAlias(chAddIN.Name & ".Connect." & Name, "ch" & Name.ToLower, True)
        Catch ex As Exception
            e = ex
        End Try
        Try
            Dim chCmdConfig As CommandBarControl = CmdPopup.Controls(Caption)
            chCmdConfig.Delete()
        Catch ex As Exception
            e = ex
        End Try
        Return e
    End Function

    ''' <summary>
    ''' 删除指定菜单或工具条中的命令.
    ''' </summary>
    ''' <param name="Owner">所有者</param>
    ''' <param name="Name">名称.</param>
    ''' <param name="Caption">标题</param>
    ''' <returns></returns>
    ''' <remarks></remarks>
    Public Function DeleteCommand(ByVal Owner As CommandBarControl, ByVal Name As String, ByVal Caption As String) As Exception
        'CmdName 工具条名称, SubItemName 工具条子项目名称,Name 要添加的项目名称,
        'Caption 要添加的项目标题.此方法内用于删除该按钮/项
        Dim e As Exception = Nothing
        Dim Cmds As Commands2 = CType(chDTE.Commands, Commands2)
        Dim CmdBars As CommandBars = CType(chDTE.CommandBars, CommandBars)
        Dim mnuBarCmdBar As CommandBar = CmdBars.Item("MenuBar") '菜单
        Dim CmdCtrl As CommandBarControl = Owner
        Dim CmdPopup As CommandBarPopup = CType(CmdCtrl, CommandBarPopup)
        Try
            Cmds.Item(chAddIN.Name & ".Connect." & Name).Delete()
            RegAlias(chAddIN.Name & ".Connect." & Name, "ch" & Name.ToLower, True)
        Catch ex As Exception
            e = ex
        End Try
        Try
            Dim chCmdConfig As CommandBarControl = CmdPopup.Controls(Caption)
            chCmdConfig.Delete()
        Catch ex As Exception
            e = ex
        End Try
        Return e
    End Function
    ''' <summary>
    ''' 注册别名.
    ''' </summary>
    ''' <param name="cCmd">完整命令</param>
    ''' <param name="cAlias">别名</param>
    ''' <param name="bDelete">是删除还是注册.T.删除.</param>
    ''' <remarks></remarks>
    Public Sub RegAlias(ByVal cCmd As String, ByVal cAlias As String, Optional ByVal bDelete As Boolean = False)
    
        Try
            chDTE.ExecuteCommand("Tools.Alias ", cAlias & "    " & IIf(bDelete, "  /delete", cCmd).ToString)
            My.Settings.chAliasList = IIf(bDelete, _
                                          Replace(My.Settings.chAliasList, cAlias & Space(4) & cCmd & vbCrLf, ""), _
                                          My.Settings.chAliasList & cAlias & Space(4) & cCmd & vbCrLf).ToString
            chOutText(IIf(bDelete, "删除", "注册").ToString & "别名'" & cAlias & "'成功!", bMustOut:=False)
        Catch ex As Exception
            chOutText(IIf(bDelete, "删除", "注册").ToString & "别名" & cAlias & "失败!")
        End Try

    End Sub


    ''' <summary>
    ''' 在输出窗口和状态条中显示文本
    ''' </summary>
    ''' <param name="Text">为要输出的文本内容</param>
    ''' <param name="cCrlf">决定是不是要换行,默认为换行</param>
    ''' <param name="bMustOut">决定该输出是不是必须输出的.</param>
    ''' <remarks>如果不是重要的信息, 用户的不显示详细信息设置将过滤该输出信息</remarks>
    Public Sub chOutText(ByVal Text As String, Optional ByVal cCrlf As Boolean = True, Optional ByVal bMustOut As Boolean = True)


        Try
            If bMustOut Or My.Settings.modFuns_OutAllInf = True Then
                '如果该字符串要求必须输出或不要求必须输出但是用户要求显示所有输出信息时执行下面的操作
                chOutWin.OutputString(Text & IIf(My.Settings.modFuns_NeedTime, Now.TimeOfDay.ToString, "").ToString & IIf(cCrlf, vbCrLf, Nothing).ToString)
                chDTE.StatusBar.Text = "CoderHelper::" & Text
            End If
        Catch ex As Exception

        End Try
    End Sub
    ''' <summary>
    ''' 这执行DTE中的命令.
    ''' </summary>
    ''' <param name="Cmd">命令名称.</param>
    ''' <param name="cParam">参数.</param>
    ''' <remarks>显示执行了何种命令..</remarks>
    Public Sub chExcCmd(ByVal Cmd As String, Optional ByVal cParam As String = "")
        Try
            chDTE.ExecuteCommand(Cmd, cParam)
            chOutText("调用:" & Cmd & "(" & cParam & ")成功!", bMustOut:=False)
        Catch ex As Exception
            chOutText("调用开发环境命令:" & Cmd & "(" & cParam & ") 时出错:" & ex.Message)
        End Try
    End Sub
    ''' <summary>
    ''' 内部调用DTE命令.
    ''' </summary>
    ''' <param name="cmd">命令名称.</param>
    ''' <param name="cparam">参数</param>
    ''' <remarks>内部调用.由本程序使用</remarks>
    Public Sub chExc(ByVal cmd As String, Optional ByVal cparam As String = "")
        Try
            chDTE.ExecuteCommand(cmd, cparam)
        Catch ex As Exception

        End Try
    End Sub
    ''' <summary>
    ''' 如果执行了命令行,向命令行当前位置输出文本信息.
    ''' </summary>
    ''' <param name="Text"></param>
    ''' <remarks></remarks>
    Public Sub chOutRet(ByVal Text As String)
        Try
            chDTE.ToolWindows.CommandWindow.OutputString(Text & vbCrLf)
        Catch ex As Exception

        End Try
    End Sub
    ''' <summary>
    ''' 在命令行运行命令.
    ''' </summary>
    ''' <param name="cmd">命令</param>
    ''' <param name="Exc">是不是立刻执行.</param>
    ''' <remarks></remarks>
    Public Sub chCmdExc(ByVal cmd As String, Optional ByVal Exc As Boolean = True)
        Try
            chDTE.ToolWindows.CommandWindow.SendInput(cmd, Exc)
        Catch ex As Exception

        End Try
    End Sub

    ''' <summary>
    ''' 添加一个工具条
    ''' </summary>
    ''' <param name="Name">工具条名称</param>
    ''' <returns>返回工具条名称</returns>
    ''' <remarks></remarks>
    Public Function SetToolBar(ByVal Name As String) As CommandBar
        Dim tm1 As CommandBars = CType(chDTE.CommandBars, CommandBars)
        Dim cmd As CommandBar
        If IsNothing(tm1.Item(Name)) Then
            cmd = tm1.Add(Name)
        Else
            cmd = tm1.Item(Name)
        End If
        Return cmd
    End Function
    ''' <summary>
    ''' 获取一个工具条名称.
    ''' </summary>
    ''' <param name="Name">存在的工具条名称.</param>
    ''' <returns></returns>
    ''' <remarks></remarks>
    Public Function SetMenuBar(ByVal Name As String) As CommandBarControl
        Dim Cmds As Commands2 = CType(chDTE.Commands, Commands2)
        Dim CmdBars As CommandBars = CType(chDTE.CommandBars, CommandBars)
        Dim mnu As CommandBar = CmdBars.Item("MenuBar") '菜单
        Try
            Dim ctl As CommandBarControl = mnu.Controls.Add(10, Before:=21)
            '添加在工具菜单后面.工具菜单的INDEX为20
            ctl.Caption = Name
            ctl.Tag = Name
            Return ctl
        Catch ex As Exception
            Return Nothing
        End Try
    End Function
    ''' <summary>
    ''' 获取一个指定名称的菜单项或工具条项对象.
    ''' </summary>
    ''' <param name="Name">名称.</param>
    ''' <param name="AIID"> </param>
    ''' <param name="OwnerName"></param>
    ''' <returns></returns>
    ''' <remarks></remarks>
    Public Function SetMenuItem(ByVal Name As String, Optional ByVal AIID As Long = 943, Optional ByVal OwnerName As String = "Tools") As CommandBarControl
        Dim Cmds As Commands2 = CType(chDTE.Commands, Commands2)
        Dim CmdBars As CommandBars = CType(chDTE.CommandBars, CommandBars)
        Dim mnuBarCmdBar As CommandBar = CmdBars.Item("MenuBar") '菜单
        Dim CmdCtrl As CommandBarControl = mnuBarCmdBar.Controls.Item(GetDTEMenuName(OwnerName))
        Dim CmdPopup As CommandBarPopup = CType(CmdCtrl, CommandBarPopup)
        Dim ret As CommandBarControl

        ' Cmds.AddCommandBar("fads", vsCommandBarType.vsCommandBarTypePopup)

        If AIID > 0 Then

            ret = CmdPopup.Controls.Add(10, Before:=CmdPopup.CommandBar.FindControl(Id:=AIID).Index + 1)
        Else
            ret = CmdPopup.Controls.Add(10, 1)
        End If
        ret.Caption = Name
        Return ret
    End Function
End Module

posted @ 2006-03-02 02:13 麦壳饼 阅读(1614) 评论(1) 编辑

Visual Basic 2005 下传输文件的简单方法。[菜鸟互动]

Imports System.IO
Imports System.Net
Imports System.Net.Sockets
Imports System.Text
Imports Microsoft.VisualBasic


''' <summary>
''' 本代码由MysticBoy 于 2006-01-26编写，2-20编写一下说明以及注释 。
''' 文件传输测试窗体，你需要添加两个按钮。不要重命名直接使用默认名称。如果需要
''' 您需要修改一下的代码。
''' </summary>
''' <remarks></remarks>
Public Class frmTran
    Dim WithEvents mtl As New FileTransmit

    ''' <summary>
    ''' 按钮1的单击时间内为启动接受
    ''' </summary>
    ''' <param name="sender"></param>
    ''' <param name="e"></param>
    ''' <remarks></remarks>
    Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
        Debug.Print(mtl.ReceiveFile(My.Application.Info.DirectoryPath)) '按钮一 ，这里准备接受文件
        '保存路径为当前程序目录
    End Sub
    ''' <summary>
    ''' 文件传输类的传输过程事件
    ''' </summary>
    ''' <param name="size">已经传输的大小</param>
    ''' <remarks></remarks>
    Private Sub mtl_Progress(ByVal size As Long) Handles mtl.Progress
        Me.Text = size '显示文件传输类的消息
        My.Application.DoEvents() '释放CPU时间
    End Sub

    ''' <summary>
    ''' 按钮二为发送一个文件。
    ''' </summary>
    ''' <param name="sender"></param>
    ''' <param name="e"></param>
    ''' <remarks></remarks>
    Private Sub Button2_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button2.Click
        MsgBox(mtl.SendFile("127.0.0.1", 1123, "E:\影视&音乐\韩国辣妹4th Why\Killer(boby vox).mpg"))
        '我们发送一个文件到 127.0.0.1 的 1123端口。
    End Sub


End Class

''' <summary>
''' 文件传输类，包括发送和接收。
''' </summary>
''' <remarks></remarks>
Class FileTransmit

    ''' <summary>
    ''' 发送文件
    ''' </summary>
    ''' <param name="RemoteHost">接受文件的主机地址</param>
    ''' <param name="RemotePort">接受文件的主机的端口</param>
    ''' <param name="FileName">要发送的文件的完整路径</param>
    ''' <param name="e">错误对象。发生错误时返回 </param>
    ''' <returns>如果发送成功返回真。</returns>
    ''' <remarks></remarks>
    Function SendFile(ByVal RemoteHost As String, ByVal RemotePort As Integer, ByVal FileName As String, Optional ByRef e As Exception = Nothing) As Boolean
        Try
            Dim client As New TcpClient(RemoteHost, RemotePort) '创建一客户端
            Dim stream As NetworkStream = client.GetStream() '获取流
            Dim data As Byte() = System.Text.Encoding.Default.GetBytes("file") '编码发送握手协议的命令通知主机接受文件
            stream.Write(data, 0, data.Length) '发送
            Dim cmd As String
            data = New Byte(10) {} '数组重新定义
            Dim bytes As Integer = stream.Read(data, 0, data.Length) '读取回应信息。等待。。。。
            cmd = System.Text.Encoding.Default.GetString(data, 0, bytes) '读取完后解码回应信息。
            If cmd = "filename" Then '如果服务器索要文件名。
                data = System.Text.Encoding.Default.GetBytes(My.Computer.FileSystem.GetFileInfo(FileName).Name)
                '编码文件名。不给路径。如：c:\111\333\222.txt 给出 222.txt
                stream.Write(data, 0, data.Length) '发送文件名
            Else '如果不是约定请求。返回。说明协议不正确。
                Return False
            End If
            data = New Byte(10) {} '数组重新定义
            bytes = stream.Read(data, 0, data.Length) '读取数据
            cmd = System.Text.Encoding.Default.GetString(data, 0, bytes) '解码响应信息
            If cmd = "filedata" Then '如果服务器要求文件数据。
                data = My.Computer.FileSystem.ReadAllBytes(FileName) '读取文件内容。
                stream.Write(data, 0, data.Length) '写入流。 发送。
            Else
                Return False  '协议不正确
            End If
            client.Close() '关闭
            Return True '成功。返回真
        Catch ex As Exception
            e = ex '返回错误信息
            Return False
        End Try
    End Function

 


    ''' <summary>
    ''' 接受过程，在该事件中您可以编写反映接受情况的代码
    ''' </summary>
    ''' <param name="size">已经接受了的文件大小。</param>
    ''' <remarks></remarks>
    Public Event Progress(ByVal size As Long)

    ''' <summary>
    ''' 接受文件
    ''' </summary>
    ''' <param name="Path">文件保存路径。</param>
    ''' <param name="LocalIPAddress">本机IP地址，在。NET中似乎是必须的。</param>
    ''' <param name="LocalPort">侦听端口</param>
    ''' <param name="Rename">如果文件存在是不是需要重名名原有文件</param>
    ''' <param name="e">异常对象，如果有错误可以使用该异常对象返回</param>
    ''' <returns>如果成功接受返回真</returns>
    ''' <remarks></remarks>
    Public Function ReceiveFile( _
                                 ByVal Path As String, _
                                 Optional ByVal LocalIPAddress As String = "127.0.0.1", _
                                 Optional ByVal LocalPort As Integer = 1123, _
                                 Optional ByVal Rename As Boolean = True, _
                                 Optional ByRef e As Exception = Nothing) As String
        Dim nType As Integer
        Dim FileName As String = Nothing
        Dim client As TcpClient
        Dim server As TcpListener
        server = Nothing
        Path = IIf(Right(Path, 1) = "\", Left(Path, Path.Length - 1), Path) '计算路径，防止多余的斜杠
        '如果路径后面带有"\"，取出，以下文件路径计算中，包含了"\"
        Try
            Dim localAddr As IPAddress = IPAddress.Parse(LocalIPAddress) '指定本机IP地址
            '不支持DNS，仅支持字符串，ipv4使用点分隔ipv6使用冒号16进制
            server = New TcpListener(localAddr, LocalPort) '创建一个侦听对象
            server.Start() '启动侦听
            Dim bytes(65535) As Byte '接受缓冲大小65535字节，VB6中的winsock为 8191。同等环境传输速度不取决缓冲区大小
            Dim data As String = Nothing
            While True
                '如果有必要呢，你可以使用线程池来实现多个连接同步等待。
                '这需要把While中的代码放在一个sub 中,相关线程池的操作请参考MSDN
                '建议:最好使用线程池 ，至少我认为线程池是最好管理的。
                client = server.AcceptTcpClient() '等待客户连接
                data = Nothing
                Dim stream As NetworkStream = client.GetStream() '接通后获取数据流
                Dim i As Integer
                i = stream.Read(bytes, 0, bytes.Length) '读取到缓冲区，i返回读取的字节数目
                While i <> 0 '如果读取到的数据大小为0就退出循环
                    Dim cmd As String
                    If bytes.Length > 0 Then
                        Select Case nType
                            Case 0
                                cmd = System.Text.Encoding.Default.GetString(bytes, 0, i) '编码数据
                                '把接受到的数据编码为本机可识别字符。该方法有效支持本机区域设置。
                                Select Case cmd '为扩展此函数，这里使用select语句。
                                    Case "file" '如果接受到的命令是file .说明客户请求发送文件 。
                                        Dim msg As Byte() = System.Text.Encoding.ASCII.GetBytes("filename")
                                        stream.Write(msg, 0, msg.Length) '此时，向客户询问文件名。以便确认是什么文件
                                        nType = 1 '设置下一个操作类型为1，既取得文件名称
                                End Select
                            Case 1
                                FileName = System.Text.Encoding.Default.GetString(bytes, 0, i)
                                '把接受到的数据编码为本机可识别字符。该方法有效支持本机区域设置。
                                If My.Computer.FileSystem.FileExists(Path & "\" & FileName) = True Then
                                    If Rename = True Then '如果重命名为真，则在名字空间前加"renamed_"
                                        Try
                                            ' 对于重名名，可能这个方法并不是最好的，建议你写一个算法。或者干脆让用户来决定保存为什么文件。
                                            My.Computer.FileSystem.RenameFile(Path & "\" & FileName, "renamed_" & Now.Ticks & "_" & FileName)
                                        Catch ex As Exception
                                            e = ex
                                            Return Nothing '如果无法重命名。返回
                                        End Try

                                    Else '如果用户不重命名，则尝试删除。如果删除不成功。返回
                                        Try '如果该文件已存在，则删除该文件。
                                            My.Computer.FileSystem.GetFileInfo(Path & "\" & FileName).Delete()
                                        Catch ex As Exception
                                            e = ex '如果文件无法删除，返回
                                            Return Nothing
                                        End Try
                                    End If
                                End If
                                Dim msg As Byte() = System.Text.Encoding.ASCII.GetBytes("filedata")
                                '按照编译字符为数组
                                stream.Write(msg, 0, msg.Length) '写入流。同vb6中的 ws.senddata :doevents
                                nType = 2 '操作类型为2时，收到的数组写入文件中。
                            Case 2
                                ReDim Preserve bytes(i - 1) '定义i个字节，0到(i-1)为i个 
                                '使用重定义保留值缩小数组             
                                My.Computer.FileSystem.WriteAllBytes(Path & "\" & FileName, _
                                                                    bytes, True) '写入到文件中
                                RaiseEvent Progress(My.Computer.FileSystem.GetFileInfo _
                                                   (Path & "\" & FileName).Length)
                                '接受过程
                        End Select
                    End If
                    ReDim bytes(65535) '重定义，清除旧数据。该操作建议.
                    Try
                        i = stream.Read(bytes, 0, bytes.Length) '从缓冲区中读取数据
                    Catch ex As Exception
                        e = ex
                        Return Nothing
                    End Try

                End While
                nType = 0 '操作类型设置为空
                client.Close() '关闭客户端
                Exit While '退出无限制的等待
            End While
        Catch ex As SocketException
            e = ex
            Return Nothing
        Finally
            server.Stop() '服务停止
        End Try
        Return Path & "\" & FileName '返回文件具体路径，来表示文件接受成功。
    End Function

End Class

posted @ 2006-03-02 02:05 麦壳饼 阅读(1592) 评论(2) 编辑