关于FSO操作大文件的问题。

Question

用过FSO对象的人大概都知道它是一个很好用的对象，最近程序里再一次需要用到FSO对文件进行操作，不过遇到一个问题，就是它在复制时，程序会处于“假死”的状态，特别是复制大文件(100M以上的)时这样的情况特别严重，程序会一动不动，不知道各位有没有什么好的解决方法？

Answer 1

你可以使用API函数shfileoperation来实现文件的复制：Private Sub Command1_Click()
Dim result As Long, fileop As SHFILEOPSTRUCT
With fileop
.hwnd = Me.hwnd
.wFunc = FO_COPY
.pFrom = "C:\PROGRAM FILES\MICROSOFT VISUAL BASIC\VB.HLP" & vbNullChar & "C:\PROGRAM FILES\MICROSOFT VISUAL BASIC\README.HLP" & vbNullChar & vbNullChar
.pFrom = "C:\*.*" & vbNullChar & vbNullChar
.pTo = "C:\testfolder" & vbNullChar & vbNullChar
.fFlags = FOF_SIMPLEPROGRESS Or FOF_FILESONLY
End With
result = SHFileOperation(fileop)
If result <> 0 Then
' Operation failed
MsgBox Err.LastDllError
Else
If fileop.fAnyOperationsAborted <> 0 Then
MsgBox "Operation Failed"
End If
End If
End Sub
====以下是模块====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 = &H200Type 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 TypeDeclare Function SHFileOperation Lib "Shell32.dll" Alias "SHFileOperationA" (lpFileOp As SHFILEOPSTRUCT) As Long

Answer 2

谢谢，不过我要的不是这个效果，对象还是用FSO来做，有没有办法可以让它不死的，还可以得到当前复制的进度？

Answer 3

我现在手头没有大文件来测试,不过我觉得ShFileOpeartion是一个不错的选择，有很多同资源管理起立面一样的选项，并且支持显示进度，为什么不使用呢？

Answer 4

现在问题是它会弹出一个系统的复制进度，如果我做的程序在后台运行的话，在复制文件时跳出一个这样的窗口，会把用户搞晕的，所以这个方法暂时不可行；大文件好说啊，可以用COPY命令来合并多个文件，还有就是如果你用WIN2000的话，在系统盘的根目录有一个pagefile.sys已经够大了。不知道你有什么方法可以解决呢？

Answer 5

Public Function BeginCopy(Source As String, Dest As String) As Boolean
Dim Buffer() As Byte
Dim MaxLen As Integer
Dim Begin As Long
Dim Finish As Long
Dim F1 As Integer
Dim F2 As Integer
Dim Ln As Long
Dim j As Integer
    j = 0
On Error GoTo 123:
    BeginCopy = False
    MaxLen = 4096
    If Dir(Dest) <> "" Then
        Begin = FileLen(Dest)
    Else
        Begin = 0
    End If
    Ln = Begin
    If Dir(Source) <> "" Then
        Finish = FileLen(Source)
    Else
        Exit Function
    End If
    F1 = FreeFile
    Open Source For Binary Access Read As #F1
    F2 = FreeFile
    Open Dest For Binary Access Write As #F2
    If Begin <> 0 Then
        Seek #F1, Begin
        Seek #F2, Begin
    End If
    ReDim Buffer(MaxLen)
    Do
        If (Ln + MaxLen + 1) < Finish Then
            Get #F1, , Buffer
            Put #F2, , Buffer
            Ln = Ln + MaxLen + 1
        Else
            If Begin > 0 Then
                Ln = Finish - Ln
            Else
                Ln = Finish - Ln - 1
            End If
            ReDim Buffer(Ln)
            Get #F1, , Buffer
            Put #F2, , Buffer
            Exit Do
        End If
        DoEvents
    Loop While j = 0
    Close #F2
    Close #F1
    BeginCopy = True
    Exit Function
123:
End Function
自定义拷贝，自己想做什么都行，还可以断点

Answer 6

我也是在用fso出现假死才这样做的

Answer 7

嗬嗬，我怎么把pagefile忘记了呢。
ShFileOpeartion 有一个选项，可以在拷贝文件的时候不出现窗口的。这里是一个完整的实例，你可以看一下：http://vbnet.mvps.org/index.html?code/shell/shfileopadv.htm

Answer 8

To: dreamtou(大头)
这样不是会影响速度？

Answer 9

TO：冰儿马甲
偶先LOOK，LOOK先谢两位。

Answer 10

//ShFileOpeartion 有一个选项，可以在拷贝文件的时候不出现窗口的指明SHFILEOPSTRUCT结构体变量fileop的fFlags为FOF_SILENT就可以了 

Answer 11

MaxLen = 4096，这个值不同，拷贝速度也有可能会变化

Answer 12

Private Sub Command1_Click()
Set sl = CreateObject("Shell.Application")
Set fd = sl.NameSpace("C:\目标文件夹\")
fd.CopyHere "E:\目标文件", 4
End Sub如想异步执行，可以用脚本文件，可以给你代码