vb 请问哪种方式拷贝共享文件最快最稳定并且要能够显示进度条?

Question

vb 请问哪种方式拷贝共享文件最快最稳定并且要能够显示进度条?请问怎样现实?   谢了

Answer 1

Dim result As Long, fileop As SHFILEOPSTRUCT
  With fileop
          .hwnd = Me.hwnd
          .wFunc = FO_COPY
          .pFrom = TxtN(0).Text '原文件
          .pTo = TxtN(2).Text & vbNullChar & vbNullChar'复制后文件
          .fFlags = FOF_SIMPLEPROGRESS Or FOF_FILESONLY
  End With
  result = SHFileOperation(fileop) ''¿ªÊ¼¸´ÖÆ
  If result <> 0 Then
          MsgBox Err.LastDllError
  Else
          If fileop.fAnyOperationsAborted <> 0 Then
                        MsgBox "Operation Failed"
          End If
  End If模块Public Const FO_MOVE As Long = &H1
Public Const FO_COPY As Long = &H2
Public Const FO_DELETE As Long = &H3
Public Const FO_RENAME As Long = &H4
Public Const FOF_MULTIDESTFILES As Long = &H1
Public Const FOF_CONFIRMMOUSE As Long = &H2
Public Const FOF_SILENT As Long = &H4
Public Const FOF_RENAMEONCOLLISION As Long = &H8
Public Const FOF_NOCONFIRMATION As Long = &H10
Public Const FOF_WANTMAPPINGHANDLE As Long = &H20
Public Const FOF_CREATEPROGRESSDLG As Long = &H0
Public Const FOF_ALLOWUNDO As Long = &H40
Public Const FOF_FILESONLY As Long = &H80
Public Const FOF_SIMPLEPROGRESS As Long = &H100
Public Const FOF_NOCONFIRMMKDIR As Long = &H200
Type SHFILEOPSTRUCT
     hwnd As Long
     wFunc As Long
     pFrom As String
     pTo As String
     fFlags As Long
     fAnyOperationsAborted As Long
     hNameMappings As Long
     lpszProgressTitle As String
End Type
Declare Function SHFileOperation Lib "Shell32.dll" Alias "SHFileOperationA" (lpFileOp As SHFILEOPSTRUCT) As Long

Answer 2

用API CopyFileEx
他回显示一个系统的进度对话框

Answer 3

用API调用系统的拷贝文件进程，我的网站上有源码，你可以下载看看。VB资料->查询“拷贝文件”；╭═══════════════════╮
║　免费的源码、工具网站，欢迎大家访问！║
║　http://www.j2soft.cn/　　　　　　　　║
╰═══════════════════╯

Answer 4

Label1显示进度百分比 
Label2显示总计耗时 
Label3显示总字节数 
Label4显示已完成字节数 Option Explicit 
Private exitcopy As Boolean 
Private Sub Command1_Click() 
Dim a() As Byte, s0 As Long, s1 As Long, buflen As Long, i As Long 
Command1.Enabled = False 
Command2.Enabled = True 
i = Timer 
buflen = 262143 
Open "c:\2.mpg" For Binary As #1     '拷贝的目标文件
Open "c:\1.mpg" For Binary As #2     '拷贝的源文件
s0 = LOF(1) 
s1 = s0 
Label3 = s0 
If s1 > buflen Then ReDim a(buflen) 
Do While s1 > buflen 
Get #1, , a 
Put #2, , a 
s1 = Seek(1) 
Label4 = s1 
Label1 = "完成：" & FORMatPercent$(s1 / s0, 0, -1) 
Label2 = Timer - i 
DoEvents 
If exitcopy Then GoTo last 
s1 = s0 - s1 
Loop 
ReDim a(s1) 
Get #1, , a 
Put #2, , a 
last: 
s1 = s0 
Label4 = s1 
Label1 = "完成：" & FORMatPercent$(s1 / s0, 0) 
Label2 = Timer - i 
Close #1 
Close #2 
Command1.Enabled = True 
Command2.Enabled = False 
End Sub Private Sub Command2_Click() 
exitcopy = True 
End Sub 

Answer 5

我很久以前写的一个类，也是用二进制读写
有进度事件和取消方法Option ExplicitPublic Event FileProgress(ByVal sngPercentage As Single)
Private mbCancel As BooleanPublic Sub DoCopy(ByVal strSourFile As String, ByVal strDestFile As String, Optional ByVal lngBufferSize As Long = 32768)
    On Error GoTo errHande
    ReDim abytBuffer(lngBufferSize - 1) As Byte    Dim lngFileSize As Long, lngRemain As Long '文件长度字节数，剩余的字节数
    Open strSourFile For Binary Access Read As #1
    Open strDestFile For Binary Access Write As #2
    lngFileSize = LOF(1)
    lngRemain = lngFileSize    While lngRemain > 0
        If lngRemain < lngBufferSize Then
            lngBufferSize = lngRemain
            ReDim abytBuffer(lngBufferSize - 1)
        End If
        Get #1, , abytBuffer
        Put #2, , abytBuffer
        lngRemain = lngRemain - lngBufferSize
        RaiseEvent FileProgress((lngFileSize - lngRemain) / lngFileSize)
        DoEvents
        If mbCancel Then
            Err.Raise vbObjectError + 513, "CopyFile", "用户取消操作"
        End If
    Wend
    Close #1
    Close #2
    Erase abytBuffer
    RaiseEvent FileProgress(1)
    Exit Sub
errHande:
    MsgBox Err.Description & "，文件复制没有完成"
    Close #1
    Close #2
    Erase abytBuffer
    If Len(Dir(strDestFile)) > 0 And Len(strDestFile) > 0 Then Kill strDestFile
End SubPublic Sub cancel()
    mbCancel = True
End Sub

Answer 6

谢谢 
上面两位朋友的方法可以实现，但速度没得zyfhongyang(张韵) 的快得
zyfhongyang(张韵) 的方法可以达到7MB/S,而用get()和put()方法却在4MB/S左右
二楼的方法能不能获取进度条的信息呢？就是说要获得当前拷贝文件的进度信息并在我的进度条中显示而不是系统自带的，谢谢各位了

Answer 7

用文件拷贝对话框就很（不）准确，哈哈，，，，不过比较方便。。
用API拷贝就可以。。
以上两点网上代码超级多

Answer 8

zcsor() ( )能给出代码吗？
我想要最快又能在我的进度条中显示进度的方法，我找了很久了没找到最好的，谢了

Answer 9

非常不好意思。好久没看这个帖子，以为大家都知道这个方法了，只提了一下就没接着看把代码给你贴出来。。只用了一个API函数而已。'以下在模块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 TypePublic Declare Function SHFileOperation Lib "shell32.dll" Alias "SHFileOperationA" (lpFileOp As SHFILEOPSTRUCT) As LongPublic Const FO_COPY = &H2
Public Const FOF_ALLOWUNDO = &H40
'参数1:原PATHNAME,参数2:目的PATHNAME
Public Sub ShellCopyFile(Source As String, Dest As String)
Dim result As Long
Dim fileop As SHFILEOPSTRUCT
With fileop
    .hWnd = 0
    .wFunc = FO_COPY
    '参数处理,这两个参数需要结尾处有两个NULL
    .pFrom = Source & vbNullChar & vbNullChar
    .pTo = Dest & vbNullChar & vbNullChar
    .fFlags = FOF_ALLOWUNDO
End With
result = SHFileOperation(fileop)
'错误处理
If result <> 0 Then '
    If result = 6 Then
        MsgBox "用户取消复制", vbOKOnly
    Else
        MsgBox Err.LastDllError, vbCritical Or vbOKOnly
    End If
Else
    If fileop.fAnyOperationsAborted <> 0 Then
        MsgBox "Operation Failed", vbCritical Or vbOKOnly
    End If
End If
End Sub'以下为调用过程Private Sub command1_Click()
'第一个参数为原位置,第2个为目的位置
ShellCopyFile "H:\ut\[BTPIG][naruto][192][Jp_Cn][Xvid_BF].rmvb", "c:\1.rmvb"
End Sub

Answer 10

以上方法会弹出WINDOWS的复制文件对话框,似乎不是很符合你的要求,你可以把这个对话框抓到自己的程序里面,并且适当设置位置,把他的标题和取消按钮覆盖起来:)呵呵,真是垃圾办法.还得注意的是,当复制时,一旦输入焦点到你的控件外,需要马上把它移动回来,因为这个对话框接收键盘控制,呵呵,例如按ESC它就取消复制了,郁闷啊..

Answer 11

在窗口中添加一个按钮,一个进度条'以下是模块代码
Public Const PROGRESS_CANCEL = 1
Public Const PROGRESS_CONTINUE = 0
Public Const PROGRESS_QUIET = 3
Public Const PROGRESS_STOP = 2
Public Const COPY_FILE_FAIL_IF_EXISTS = &H1
Public Const COPY_FILE_RESTARTABLE = &H2
Public Declare Function CopyFileEx Lib "kernel32.dll" Alias "CopyFileExA" (ByVal lpExistingFileName As String, ByVal lpNewFileName As String, ByVal lpProgressRoutine As Long, lpData As Any, ByRef pbCancel As Long, ByVal dwCopyFlags As Long) As Long
Public bCancel As Long
Public Function CopyProgressRoutine(ByVal TotalFileSize As Currency, ByVal TotalBytesTransferred As Currency, ByVal StreamSize As Currency, ByVal StreamBytesTransferred As Currency, ByVal dwStreamNumber As Long, ByVal dwCallbackReason As Long, ByVal hSourceFile As Long, ByVal hDestinationFile As Long, ByVal lpData As Long) As Long
    Form1.ProgressBar1.Value = Int((TotalBytesTransferred * 10000) / (TotalFileSize * 10000) * 100) '+ "% complete..."
    DoEvents
    CopyProgressRoutine = PROGRESS_CONTINUE
End Function'以下是调用
Private Sub Command1_Click()
    ret = CopyFileEx("D:\Downloads\Vs6sp6(1).exe", "c:\VB6.0.exe", AddressOf CopyProgressRoutine, ByVal 0&, bCancel, COPY_FILE_RESTARTABLE)
End Sub