类Windows资源管理器程序

    本来只是单纯想做一个文件遍历程序的，但是无意中就有点像Windows自带的资源管理器，所以发出来玩玩，有兴趣的朋友可以进一步改写！如果大家的升级版本比我的好，请Open Source哦···

    下面给出全部代码：

Imports System.IO

Public Class FrmMainClass FrmMain

    Private DirPath As String = Nothing     '设置的根目录路径
    Private Sum As Integer = 0
    Private Visited As Integer = 0

    Private SuccessStr As String = Nothing  '定义正确字符串变量
    Private ErrStr As String = Nothing      '定义错误字符串变量

    Private oImageList As System.Windows.Forms.ImageList = Nothing

    Delegate Function Add_Delegate()Function Add_Delegate(ByVal _Node As TreeNode) As Integer
    Delegate Sub ImageList_Add_Delegate()Sub ImageList_Add_Delegate(ByVal key As String, ByVal icon As System.Drawing.Icon)

    Private Sub Write_Stutelb1()Sub Write_Stutelb1(ByVal _Str As String)
        If (Me.IsDisposed = False AndAlso Me.StatuslbFilePath.IsDisposed = False) Then
            Me.StatuslbFilePath.Text = _Str
        End If
    End Sub

    Private Sub Write_lb()Sub Write_lb(ByVal _Str As String)
        If (Me.IsDisposed = False AndAlso Me.lbProgress.IsDisposed = False) Then
            Me.lbProgress.Text = _Str
        End If
    End Sub

窗体加载事件#Region "窗体加载事件"
    Private Sub FrmMain_Load()Sub FrmMain_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
        If Me.DirPath = Nothing Then
            Me.btnJudge.Enabled = False         '将判断按钮设置为不可用
        End If

        Me.oImageList = New ImageList()
        With Me.oImageList
            .ColorDepth = ColorDepth.Depth32Bit
            .ImageSize = New Size(24, 24)
            .TransparentColor = Color.Transparent
            .Images.Add("folder", My.Resources.folder)
            .Images.Add("selected", My.Resources.selected)
        End With

        With Me.FileTree
            .ImageList = Me.oImageList
            .SelectedImageKey = "selected"
        End With
    End Sub
#End Region

浏览按钮#Region "浏览按钮"
    Private Sub btnBrowse_Click()Sub btnBrowse_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnBrowse.Click
        Dim _FolderDig As FolderBrowserDialog = Nothing
        Try
            _FolderDig = New FolderBrowserDialog()
            If (_FolderDig.ShowDialog = Windows.Forms.DialogResult.OK) Then
                Me.DirPath = _FolderDig.SelectedPath
                Me.lbTip.Text = String.Format("搜索目录：{0}", Me.DirPath)

                If (Me.DirPath <> Nothing) Then
                    Me.btnJudge.Enabled = True         '将判断按钮设置为可用
                End If
            End If
        Catch ex As Exception
            MsgBox(ex.Message.ToString(), MsgBoxStyle.Exclamation)
        Finally
            If (_FolderDig IsNot Nothing) Then _FolderDig.Dispose()
            _FolderDig = Nothing
        End Try
    End Sub
#End Region

开始搜索按钮#Region "开始搜索按钮"
    Private Sub btnJudge_Click()Sub btnJudge_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnJudge.Click
        If (Me.DirPath = Nothing) Then Exit Sub
        Me.FileList.Items.Clear()
        Me.FileTree.Nodes.Clear()
        Me.FillTreeData(DirPath)
    End Sub
#End Region

向树形列表中填充数据－－FillTreeData(Path)#Region "向树形列表中填充数据－－FillTreeData(Path)"
    /**/''' <summary>
    ''' 向树形列表中填充数据
    ''' </summary>
    ''' <param name="_Path">根目录路径</param>
    ''' <remarks></remarks>
    Private Sub FillTreeData()Sub FillTreeData(ByVal _Path As String)
        Me.Invoke(New Action(Of String)(AddressOf Write_Stutelb1), New String() {""})

        Dim _DirectoryInfo As DirectoryInfo = Nothing
        Try
            _DirectoryInfo = New DirectoryInfo(_Path)
            If (_DirectoryInfo.Exists = True) Then
                Dim _RootNode As New TreeNode(_DirectoryInfo.FullName)
                If (Me.IsDisposed = False AndAlso Me.FileTree.IsDisposed = False) Then
                    Dim _IAsyncResult As IAsyncResult = Me.FileTree.BeginInvoke(New Add_Delegate(AddressOf Me.FileTree.Nodes.Add), _RootNode)
                    Me.FileTree.EndInvoke(_IAsyncResult)
                End If

                Dim _Action As New Action(Of TreeNode)(AddressOf Me.Traversal)
                _Action.BeginInvoke(_RootNode, AddressOf Me.Traversal_Complete, String.Format("{0} 访问完成！", _Path))
            End If
        Catch ex As Exception
            MsgBox(ex.Message.ToString(), MsgBoxStyle.Exclamation)
        Finally
            If (_DirectoryInfo IsNot Nothing) Then _DirectoryInfo = Nothing
        End Try
    End Sub
#End Region

遍历目录子过程－－Traversal(_TreeNode)#Region "遍历目录子过程－－Traversal(_TreeNode)"
    /**/''' <summary>
    ''' 遍历目录子过程
    ''' </summary>
    ''' <param name="_TreeNode">树节点</param>
    Private Sub Traversal()Sub Traversal(ByVal _TreeNode As TreeNode)
        Try
            Me.Sum = 0 : Me.Visited = 0
            Me.Sum = System.IO.Directory.GetFiles(_TreeNode.FullPath, Me.txtSearch.Text.Trim(), SearchOption.AllDirectories).GetLength(0)
            Me.pb.Invoke(New Action(Of Integer)(AddressOf Me.Setpb_Value), New Object() {Me.Visited})
            Me.pb.Invoke(New Action(Of Integer)(AddressOf Me.Setpb_Maximum), New Object() {Me.Sum})

            Me.GetDirectories(_TreeNode)
        Catch ex As Exception
            MsgBox(String.Format("{0}发生严重错误！错误信息：{1}", "Traversal()", vbCrLf & ex.Message.ToString()), MsgBoxStyle.Exclamation)
        End Try
    End Sub
#End Region

获取目录#Region "获取目录"
    /**/''' <summary>
    ''' 获取目录
    ''' </summary>
    ''' <param name="_TreeNode">节点</param>
    Private Sub GetDirectories()Sub GetDirectories(ByVal _TreeNode As TreeNode)
        Dim _IAsyncResult As IAsyncResult = Nothing
        Try
            Me.GetFiles(_TreeNode)
            For Each _DirectoryInfo As DirectoryInfo In New DirectoryInfo(_TreeNode.FullPath).GetDirectories
                '***********************************************
                '填充树视图
                Dim _CurrentTreeNode As New TreeNode()
                With _CurrentTreeNode
                    .Text = _DirectoryInfo.Name.ToString()
                    .ImageKey = "folder"

                    .ToolTipText = String.Format("上次访问该文件夹的时间：{0}" & _
                    "上次写入该文件夹的时间：{1}" & _
                    "文件夹完整路径：{2}", _
                    _DirectoryInfo.LastAccessTime & vbCrLf, _
                    _DirectoryInfo.LastWriteTime & vbCrLf, _
                    _DirectoryInfo.FullName)
                End With

                If (Me.IsDisposed = False AndAlso Me.FileTree.IsDisposed = False) Then
                    _IAsyncResult = Me.FileTree.BeginInvoke(New Add_Delegate(AddressOf _TreeNode.Nodes.Add), _CurrentTreeNode)
                    Me.FileTree.EndInvoke(_IAsyncResult)
                End If
                '***********************************************

                Dim _Action As New Action(Of TreeNode)(AddressOf Me.GetDirectories)
                _Action.BeginInvoke(_CurrentTreeNode, AddressOf Me.Traversal_Complete, String.Format("{0} 访问完成！", _TreeNode.FullPath))
            Next
        Catch ex As Exception
            MsgBox(ex.Message.ToString)
        End Try
    End Sub
#End Region

    Private Sub Traversal_Complete()Sub Traversal_Complete(ByVal ar As IAsyncResult)
        Dim _Action As Action(Of TreeNode) = DirectCast(DirectCast(ar, Runtime.Remoting.Messaging.AsyncResult).AsyncDelegate, Action(Of TreeNode))
        Dim _msg As String = DirectCast(ar.AsyncState, String)

        Console.WriteLine(_msg)
        _Action.EndInvoke(ar)
    End Sub

    Private Sub Setpb_Maximum()Sub Setpb_Maximum(ByVal value As Integer)
        Me.pb.Maximum = value
    End Sub

    Private Sub Setpb_Value()Sub Setpb_Value(ByVal value As Integer)
        If (value > Me.pb.Maximum) Then Exit Sub
        Me.pb.Value = value
        Dim g As Graphics = Me.pb.CreateGraphics()
        g.DrawString(String.Format("{0}%", CStr(CInt((value / Me.Sum) * 100))), New Font("宋体", 12.0!, FontStyle.Bold), Brushes.Black, Me.pb.Width / 2 - 12, 3)
    End Sub

获取文件#Region "获取文件"
    /**/''' <summary>
    ''' 获取文件
    ''' </summary>
    ''' <param name="_TreeNode">节点</param>
    Private Sub GetFiles()Sub GetFiles(ByVal _TreeNode As TreeNode)
        Dim _IAsyncResult As IAsyncResult = Nothing
        Dim iconForFile As Icon = Nothing
        Try
            For Each _FileInfo As FileInfo In New DirectoryInfo(_TreeNode.FullPath).GetFiles(Me.txtSearch.Text.Trim, SearchOption.TopDirectoryOnly)
                Me.Visited += 1

                iconForFile = SystemIcons.WinLogo
                If Not (Me.oImageList.Images.ContainsKey(_FileInfo.Extension)) Then
                    iconForFile = System.Drawing.Icon.ExtractAssociatedIcon(_FileInfo.FullName)
                    Me.Invoke(New ImageList_Add_Delegate(AddressOf Me.oImageList.Images.Add), New Object() {_FileInfo.Extension, iconForFile})
                End If

                '***********************************************
                '填充树视图
                Dim _CurrentTreeNode As New TreeNode()
                With _CurrentTreeNode
                    .Text = _FileInfo.Name.ToString()
                    .ImageKey = _FileInfo.Extension  '绑定图片

                    .ToolTipText = String.Format("上次访问该文件的时间：{0}" & _
                    "上次写入该文件的时间：{1}" & _
                    "该文件是否只为可读：{2}" & _
                    "当前文件大小：{3}" & _
                    "文件完整路径：{4}", _
                    _FileInfo.LastAccessTime & vbCrLf, _
                    _FileInfo.LastWriteTime & vbCrLf, _
                    _FileInfo.IsReadOnly & vbCrLf, _
                    _FileInfo.Length & vbCrLf, _
                    _FileInfo.FullName)
                End With

                If (Me.IsDisposed = False AndAlso Me.FileTree.IsDisposed = False) Then
                    _IAsyncResult = Me.FileTree.BeginInvoke(New Add_Delegate(AddressOf _TreeNode.Nodes.Add), _CurrentTreeNode)
                    Me.FileTree.EndInvoke(_IAsyncResult)
                End If
                '***********************************************

                Me.Invoke(New Action(Of String)(AddressOf Write_Stutelb1), New String() {_FileInfo.FullName})
                Me.Invoke(New Action(Of String)(AddressOf Write_lb), New String() {String.Format("{0}/{1}", Me.Visited, Me.Sum)})

                Me.pb.Invoke(New Action(Of Integer)(AddressOf Me.Setpb_Value), New Object() {Me.Visited})
            Next
        Catch ex As Exception
            MsgBox(ex.Message.ToString)
        Finally
            _IAsyncResult = Nothing
            iconForFile = Nothing
        End Try
    End Sub
#End Region

关闭按钮#Region "关闭按钮"
    Private Sub btnExit_Click()Sub btnExit_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnExit.Click
        Application.Exit()
    End Sub
#End Region

向列表框中填充数据－－FillListData(Path)#Region "向列表框中填充数据－－FillListData(Path)"
    /**/''' <summary>
    ''' 向列表框中填充数据
    ''' </summary>
    ''' <param name="_TreeNode">选择的节点</param>
    ''' <remarks></remarks>
    Private Sub FillListData()Sub FillListData(ByVal _TreeNode As TreeNode)
        Me.FileList.Columns.Clear()
        Me.FileList.Items.Clear()
        Dim ColStr() As String = {"文件", "大小"}
        Dim ColHeader(ColStr.Length - 1) As ColumnHeader
        For i As Integer = 0 To UBound(ColStr)
            ColHeader(i) = New ColumnHeader
            ColHeader(i).Text = ColStr(i)
            ColHeader(i).Width = 200
            ColHeader(i).TextAlign = HorizontalAlignment.Center
        Next
        Me.FileList.Columns.AddRange(ColHeader)

        Dim _Item As ListViewItem = Nothing
        Dim _FileInfo As FileInfo = Nothing
        For Each _CurrentTreeNode As TreeNode In _TreeNode.Nodes
            If (_CurrentTreeNode.GetNodeCount(False) <= 0) Then
                _Item = New ListViewItem(New String() {"", ""})
                If (System.IO.File.Exists(_TreeNode.FullPath & "\" & _CurrentTreeNode.Text) = True) Then
                    _FileInfo = New FileInfo(_TreeNode.FullPath & "\" & _CurrentTreeNode.Text)
                    _Item.SubItems(0).Text = _FileInfo.FullName
                    _Item.SubItems(1).Text = String.Format("{0}KB ({1}字节)", CInt(_FileInfo.Length / 1024).ToString(), _FileInfo.Length.ToString())
                    Me.FileList.Items.Add(_Item)
                End If
            End If
        Next
    End Sub
#End Region

树形列表鼠标双击事件#Region "树形列表鼠标双击事件"
    Private Sub FileTree_DoubleClick()Sub FileTree_DoubleClick(ByVal sender As Object, ByVal e As System.EventArgs) Handles FileTree.DoubleClick
        If (TypeOf sender Is TreeView) Then
            If (TypeOf DirectCast(sender, TreeView).SelectedNode Is TreeNode) Then
                Me.FillListData(DirectCast(sender, TreeView).SelectedNode)

                Me.Invoke(New Action(Of String)(AddressOf Write_Stutelb1), New String() {String.Format("{0}目录下，文件数：{1}", DirectCast(sender, TreeView).SelectedNode.FullPath, Me.FileList.Items.Count.ToString())})
            End If
        End If
    End Sub
#End Region

删除菜单事件#Region "删除菜单事件"
    Private Sub MenuDelete_Click()Sub MenuDelete_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MenuDelete.Click
        Me.SuccessStr = Nothing
        Me.ErrStr = Nothing

        If Me.FileList.SelectedItems.Count > 0 Then
            For Each List_Item As ListViewItem In Me.FileList.SelectedItems
                If File.Exists(List_Item.Text) = True Then
                    Try
                        My.Computer.FileSystem.DeleteFile(List_Item.Text, _
                        FileIO.UIOption.AllDialogs, FileIO.RecycleOption.SendToRecycleBin)

                        If File.Exists(List_Item.Text) = False Then
                            Me.SuccessStr &= List_Item.Text & "删除成功!" & vbCrLf
                        Else
                            Me.ErrStr &= List_Item.Text & "删除失败!" & vbCrLf
                        End If
                    Catch ex As Exception
                        Me.ErrStr &= ex.Message.ToString() & vbCrLf
                    End Try
                End If
            Next

            If Me.ErrStr = Nothing Then
                MsgBox(Me.SuccessStr, MsgBoxStyle.Information, "提示")
            Else
                If Me.SuccessStr <> Nothing Then
                    MsgBox(Me.SuccessStr & _
                    vbCrLf & Me.ErrStr, MsgBoxStyle.Exclamation, "提示")
                Else
                    MsgBox(Me.ErrStr, MsgBoxStyle.Exclamation, "提示")
                End If
            End If

            If Me.DirPath.Length = Nothing Then Exit Sub
            Me.FillTreeData(Me.DirPath)

        Else
            MsgBox("请选择要删除的文件！", MsgBoxStyle.Information, "提示")
        End If
    End Sub
#End Region

TreeView鼠标拖拽事件#Region "TreeView鼠标拖拽事件"
    '用户开始拖动树节点，就会从源树视图控件引发此事件。出现此事件时，需调用 DoDragDrop 方法以启动拖放过程。
    Private Sub FileTree_ItemDrag()Sub FileTree_ItemDrag(ByVal sender As Object, ByVal e As System.Windows.Forms.ItemDragEventArgs) Handles FileTree.ItemDrag
        If e.Button = Windows.Forms.MouseButtons.Left Then
            ' Move the dragged node when the left mouse button is used.
            DoDragDrop(e.Item, DragDropEffects.Move)

        ElseIf e.Button = Windows.Forms.MouseButtons.Right Then
            ' Copy the dragged node when the right mouse button is used.
            DoDragDrop(e.Item, DragDropEffects.Copy)
        End If
    End Sub

    '启动拖放操作后，必须在目标树视图控件中处理 DragEnter 事件。
    '当用户将 TreeNode 对象从源树视图控件拖到目标树视图控件边界内的某一点时，会发生此事件。
    Private Sub FileTree_DragEnter()Sub FileTree_DragEnter(ByVal sender As Object, ByVal e As System.Windows.Forms.DragEventArgs) Handles FileTree.DragEnter
        e.Effect = e.AllowedEffect
    End Sub

    '要处理的最后一个事件是目标树视图控件的 DragDrop 事件。
    '将拖动的 TreeNode 对象放到目标树视图控件上后，会发生此事件。
    Private Sub FileTree_DragDrop()Sub FileTree_DragDrop(ByVal sender As Object, ByVal e As System.Windows.Forms.DragEventArgs) Handles FileTree.DragDrop
        Try
            ' Retrieve the client coordinates of the drop location.
            Dim TargetPoint As Point = Me.FileTree.PointToClient(New Point(e.X, e.Y))

            ' Retrieve the node at the drop location.
            Dim TargetNode As TreeNode = Me.FileTree.GetNodeAt(TargetPoint)

            ' Retrieve the node that was dragged.
            Dim DraggedNode As TreeNode = CType(e.Data.GetData(GetType(TreeNode)), TreeNode)

            ' Confirm that the node at the drop location is not 
            ' the dragged node or a descendant of the dragged node.


            If Not DraggedNode.Equals(TargetNode) = True Then

                ' If it is a move operation, remove the node from its current 
                ' location and add it to the node at the drop location.
                ' else If it is a copy operation, clone the dragged node
                ' and add it to the node at the drop location.
                If e.Effect = DragDropEffects.Move Then
                    '将文件移动到拖拽的目录下*********************
                    If File.Exists(DraggedNode.FullPath) = True Then
                        File.Move(DraggedNode.FullPath, TargetNode.FullPath & "\" & DraggedNode.Text)
                        If File.Exists(DraggedNode.FullPath) = False And File.Exists(TargetNode.FullPath & "\" & DraggedNode.Text) = True Then

                        Else
                            MsgBox("出现错误！")
                        End If
                    End If
                    '*********************************************
                    DraggedNode.Remove()
                    TargetNode.Nodes.Add(DraggedNode)
                ElseIf e.Effect = DragDropEffects.Copy Then
                    '将文件移动到拖拽的目录下*********************
                    If File.Exists(DraggedNode.FullPath) = True Then
                        File.Copy(DraggedNode.FullPath, TargetNode.FullPath & "\" & DraggedNode.Text)
                        If File.Exists(DraggedNode.FullPath) = True And File.Exists(TargetNode.FullPath & "\" & DraggedNode.Text) = True Then

                        Else
                            MsgBox("出现错误！")
                        End If
                    End If
                    '*********************************************
                    TargetNode.Nodes.Add(CType(DraggedNode.Clone(), TreeNode))
                End If

                ' Expand the node at the location 
                ' to show the dropped node.
                TargetNode.Expand()
            End If

        Catch ex As Exception
            MsgBox(ex.Message.ToString)
        End Try
    End Sub

#End Region

End Class