vb.net 如何对文件夹实现复制,并显示进度条,每复制一个文件还在richtextbox1中显示出来!

 我来答
lipeiyi2006
2010-12-25 · TA获得超过1567个赞
知道小有建树答主
回答量:1065
采纳率:0%
帮助的人:1074万
展开全部

利用线程,和计时器,Function GetFolderSize从网上借鉴的,不知道为什么IO类不支持不同分区移动,所以移动目录只能在相同分区,设计界面如图,代码如下

Imports System.Threading

Imports System.IO

Imports System.Text

Public Class Form1

    Dim SourceDir, DestDir As String

    Dim SourceLen As Integer

    '返回文件夹大小

    Private Function GetFolderSize(ByVal DirPath As String, Optional ByVal IncludeSubFolders As Boolean = True) As Long

        Dim lngDirSize As Long

        Dim objFileInfo As FileInfo

        Dim objDir As DirectoryInfo = New DirectoryInfo(DirPath)

        Dim objSubFolder As DirectoryInfo

        Try

            For Each objFileInfo In objDir.GetFiles()

                lngDirSize += objFileInfo.Length

            Next

            If IncludeSubFolders Then

                For Each objSubFolder In objDir.GetDirectories()

                    lngDirSize += GetFolderSize(objSubFolder.FullName)

                Next

            End If

        Catch

        End Try

        Return lngDirSize

    End Function

    Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click

        Dim T As New Thread(AddressOf DirMove)

        CheckForIllegalCrossThreadCalls = False

        SourceDir = TextBox1.Text

        DestDir = TextBox2.Text

        SourceLen = GetFolderSize(SourceDir)

        ProgressBar1.Value = 0

        Timer1.Interval = 100

        Timer1.Start()

        T.Start()

    End Sub

    Private Sub Timer1_Tick(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Timer1.Tick

        If Directory.Exists(DestDir) = False Then Exit Sub

        ProgressBar1.Value = Math.Round(GetFolderSize(DestDir) / SourceLen, 2) * 100

    End Sub

    Private Sub DirMove()

        Me.Text = "正在移动..."

        Directory.Move(SourceDir, DestDir)

        Me.Text = "移动完成!"

        ProgressBar1.Value = 100

        RichTextBox1.Text += DestDir & Environment.NewLine

    End Sub

End Class

本回答被提问者和网友采纳
已赞过 已踩过<
你对这个回答的评价是?
评论 收起
推荐律师服务: 若未解决您的问题,请您详细描述您的问题,通过百度律临进行免费专业咨询

为你推荐:

下载百度知道APP,抢鲜体验
使用百度知道APP,立即抢鲜体验。你的手机镜头里或许有别人想知道的答案。
扫描二维码下载
×

类别

我们会通过消息、邮箱等方式尽快将举报结果通知您。

说明

0/200

提交
取消

辅 助

模 式