如何对正在复制的文件实现进度条??

解决方案 »

  1.   

    Public sub CopyFile(Src As String, Dst As String) As Single 
         Dim BTest!, FSize! 
         Dim F1%, F2% 
         Dim sArray() As Byte 
         Dim buff As Integer 
         
         Const BUFSIZE = 1024 
         
         buff = 1024 
         
         F1 = FreeFile 
         Open Src For Binary As F1 
         F2 = FreeFile 
         Open Dst For Binary As F2 
         
         FSize = LOF(F1) 
         BTest = FSize - LOF(F2) 
         ReDim sArray(BUFSIZE) As Byte 
         
         Do 
         If BTest < BUFSIZE Then 
         buff = BTest 
         ReDim sArray(buff) As Byte 
         End If 
         
         Get F1, , sArray 
         Put F2, , sArray 
         
         BTest = FSize - LOF(F2) 
         If BTest < 0 Then 
         ProgressBar.Value = 100 
         Else 
         ProgressBar.Value = (100 - Int(100 * BTest / FSize)) 
         End If 
         Loop Until BTest <= 0 
         
         Close F1 
         Close F2 
         CopyFile = FSize 
         
        End sub
      

  2.   

    最好是调用Win32API里的复制文件函数,这样在复制时会自动显示那个复制动画。
      

  3.   

    leayh(云卷云舒) 能不能说一怎样调用Win32API的复制文件函数
      

  4.   

    Visual Basic 提供了过时的FileCopy语句.问题是使用该函数时并不显示文件复制对话框,也就是说,当拷贝一个大文件时,用户看不到Windows的标准 
    文件复制对话框,无法从进度条上判断当前复制的进度.那么,如何做到这一点呢?请看下面: Public Type SHFILEOPSTRUCT 
    hWnd As Long 
    wFunc As Long 
    pFrom As String 
    pTo As String 
    fFlags As Integer 
    fAnyOperationsAborted As Boolean 
    hNameMappings As Long 
    lpszProgressTitle As String 
    End Type Public Declare Function SHFileOperation Lib "shell32.dll" Alias 

    "SHFileOperationA" (lpFileOp As SHFILEOPSTRUCT) As Long 
    Public Const FO_COPY = &H2 
    Public Const FOF_ALLOWUNDO = &H40 Public Sub ShellCopyFile(Source As String, Dest As String) 
    Dim result As Long 
    Dim fileop As SHFILEOPSTRUCT 
    With fileop 
    .hwnd = 0 
    .wFunc = FO_COPY 
    'The files to copy separated by Nulls and terminated by 2 nulls 
    .pFrom = Source & vbNullChar & vbNullChar 
    'or to copy all files use this line 
    '.pFrom = "C:\*.*" & vbNullChar & vbNullChar 
    'The directory or filename(s) to copy into terminated in 2 nulls 
    .pTo = Dest & vbNullChar & vbNullChar 
    .fFlags = FOF_ALLOWUNDO 
    End With 
    result = SHFileOperation(fileop) 
    If result <> 0 Then 'Operation failed 
    'Msgbox the error that occurred in the API. 
    MsgBox Err.LastDllError, vbCritical Or vbOKOnly 
    Else 
    If fileop.fAnyOperationsAborted <> 0 Then 
    MsgBox "Operation Failed", vbCritical Or vbOKOnly 
    End If 
    End If 
    End Sub 只需调用ShellCopyFile FileA, FileACopy 
     
      

  5.   

    用系统的文件复制过程。就象手工复制一样显示文件复制进度
    Private Sub Command1_Click()
    Set shl = CreateObject("Shell.application")
    Set fd = shl.NameSpace("d:\")
    fd.CopyHere "c:\xxxxxx\要复制的文件"
    End Sub