拷贝文件带进度条

[mylele]

先祝大家情人节快乐。
找CSDN找了好久了， 老是输入 msdn.net 怎么都进不来这里，
最后问人家才问到是csdn
已经解决了2年的东西都没解决好，从去年6月份，
找了N多资料都不行，没办法，不得不到这里来请教CSDN的高手了，人家说这里高手N多

小弟不废话了。再解决不了老板要抄我鱿鱼了
关于拷贝文件带进度的问题

现在目前这个是拷贝大型文件就很慢，局域网拷贝 平均速度也只有4MB左右，看到人家的有5-11MB，很是羡慕。
说明一下不是系统自代的拷贝

请求大家帮忙，给个代码谢谢

[rainstormmaster]

无非就是打开文件,分段读写文件,同时设置滚动条的value,速度慢的话,应该是缓冲区分配得过小的原因,搜一下以前的帖子吧

[mylele]

我搜索了好多，大家帮忙解决一下吧。。拜托了~~

[mylele]

这个是我现在的代码，大家看看
速度很慢，特别是拷贝大型文件的时候
Option Base 1 'VERY IMPORTANT
Public Event CopyProgress(lngPercentDone As Long)
Public Event CopyError(strDescription As String)
Public Event CopyComplete()
Public Event CopyCancelled()
Private bCancelAction As Boolean
Public Sub Cancel()
bCancelAction = True
End Sub
Public Function CopyFile(strSource As String, strDestination As String, Optional bOverwrite As Boolean = False, Optional intBufferSize As Integer = 2048, Optional bSuppressErrors As Boolean = True) As Boolean
Dim strError As String
Dim BUFFER() As Byte
Dim intSourceFile As Integer
Dim intDestinationFile As Integer
If strSource = "" Then
strError = "No Source File Specified"
ElseIf strDestination = "" Then
strError = "No Destination File Specified"
ElseIf Dir(strSource) = "" Then
strError = "Source File Does Not Exist"
End If
If strError <> "" Then
GoTo copy_error
End If
On Error Resume Next
If Dir(strDestination) <> "" Then
If bOverwrite Then
Err.Clear
If (GetAttr(strDestination) And vbReadOnly) = vbReadOnly Then
SetAttr strDestination, vbNormal
End If
Kill strDestination
If Err.Number <> 0 Then
RaiseEvent CopyError(Err.Description)
Exit Function
End If
Else
RaiseEvent CopyError("Destination file exists")

Exit Function
End If
End If


intSourceFile = FreeFile
Open strSource For Binary Access Read Lock Write As #intSourceFile
intDestinationFile = FreeFile
Open strDestination For Binary Access Write Lock Write As #intDestinationFile
If LOF(intSourceFile) < intBufferSize Then
ReDim BUFFER(LOF(intSourceFile))
Else
ReDim BUFFER(intBufferSize)
End If
While Not EOF(intSourceFile) And Loc(intSourceFile) <> LOF(intSourceFile)
If Loc(intSourceFile) <> LOF(intSourceFile) Then
If LOF(intSourceFile) - Loc(intSourceFile) < intBufferSize Then
ReDim BUFFER(LOF(intSourceFile) - Loc(intSourceFile))
End If
Else
Erase BUFFER
End If
Get #intSourceFile, , BUFFER
Put #intDestinationFile, , BUFFER
BB& = BB& + intBufferSize '累计字节大小
If timeGetTime - sysTime > 1000 Then
FrmMain.Label4.Caption = BB& \ 1024 \ 1024 '显示拷贝速度
sysTime = timeGetTime '读取系统时间
BB& = 0 '清零拷贝字节数
End If
'用户暂停
While FrmMain.暂停.Caption = "继续"
If FrmMain.停止.Enabled = False Then FrmMain.暂停.Caption = "暂停"
DoEvents
Wend
RaiseEvent CopyProgress(Loc(intSourceFile) / LOF(intSourceFile) * 100)
DoEvents
If bCancelAction Then
Close intSourceFile
Close intDestinationFile
Kill strDestination
bCancelAction = False
RaiseEvent CopyCancelled
Exit Function
End If
Wend
Close intSourceFile
Close intDestinationFile
RaiseEvent CopyComplete
CopyFile = True
Exit Function
copy_error:
RaiseEvent CopyError(strError)
Exit Function
End Function

[chenhui530]

你使用的是Winsock吧

[chenhui530]

能看下你的代码吗

[rainstormmaster]

intBufferSize可以大一些，你现在一次才分配2k的缓冲区，肯定是慢

[mylele]

但是调用的时候设置缓存呀
CopyFile(strSource As String, strDestination As String, Optional bOverwrite As Boolean = False, Optional intBufferSize As Integer = 2048, Optional bSuppressErrors As Boolean = True) As Boolean

调用的时候是这样
CopyFile "d:\abc.exe","d:\abcdddd.exe",true,8129,true

[goodname008]

一句话就是回调。
如果是下载文件，那恭喜楼主了，我刚写了个HTTP的：http://blog.csdn.net/goodname008/archive/2006/01/02/568668.aspx

文件复制的话就用 CopyFileEx 函数，都有回调接口的。

[NewViewStudio]

方法1：增大缓冲
机器=P4 2.4M 512M DDR
文件长度=701M

缓冲长度=8K
用时=88.063s

缓冲长度=64K
用时=85.797s

方法2：
如果是针对网络的拷贝，那么你应该利用WINSOCK多端口分段拷贝法，那样可以利用你机器的最大资源来进行拷贝，一般如果是远程拷贝至少开128个端口分段拷贝，如果是局域网的话一般16个端口就OK了。

[NewViewStudio]

对楼上资料的更改

我的机器是P4 2.4G

不好意思

[ZOU_SEAFARER]

是不是可以利用命名管道来copy文件！！？

[mylele]

急啊

[mylele]

NewViewStudio(傻鱼)
请问您能加我QQ吗？ 701365
我的是局域网拷贝~
WINSOCK多端口分段拷贝法 这个我还不明白啊

[NewViewStudio]

前几天我工作比较忙，所以没有功夫来这，今天刚看到，我已经向你的QQ发送邀请了