复制文件的方法有很多种,在这里我提供一种给大家使用,有需要的可以拿去试,但结果我就不做保证,需不需要看你!
在复制大型文件比较有用,可以显示进度,我用了API的CopyFileEx,如果你用CopyFile就只能等,CopyFileEx提供了一个回调函数功能,可以使用AddressOf到模块回调函数,这个就不说了,我在这里提供的类模块回调,不需要模块。具体代码如下:
类模块中:
Option Base 0
Option Explicit
'***********************************************************************
'自定义事件
Public Event FileCopyExBegin()
Public Event FileCopyExProgress(ByVal Progress As Long, ByRef Cancel As Boolean)
Public Event FileCopyExCancel()
'***********************************************************************
'分配内存API
Private Const HEAP_ZERO_MEMORY = &H8
Private Const PAGE_EXECUTE_READWRITE = &H40
Private Declare Sub CopyMemory Lib "Kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
Private Declare Function IsBadReadPtr Lib "Kernel32" (Destination As Any, ByVal Length As Long) As Long
Private Declare Function GetProcessHeap Lib "Kernel32" () As Long
Private Declare Function HeapAlloc Lib "Kernel32" (ByVal hHeap As Long, ByVal dwFlags As Long, ByVal dwBytes As Long) As Long
Private Declare Function HeapFree Lib "Kernel32" (ByVal hHeap As Long, ByVal dwFlags As Long, lpMem As Any) As Long
Private Declare Function VirtualProtect Lib "Kernel32" (lpAddress As Any, ByVal dwSize As Long, ByVal flNewProtect As Long, lpflOldProtect As Long) As Long
'************************************************************************
'复制文件API
Private Const COPY_FILE_FAIL_IF_EXISTS = &H1
Private Const COPY_FILE_RESTARTABLE = &H2
Private Const CALLBACK_STREAM_SWITCH = 1
Private Const PROGRESS_CONTINUE = 0
Private Const PROGRESS_CANCEL = 1
Private Const PROGRESS_STOP = 2
Private Const PROGRESS_QUIET = 3
Private Declare Function CopyFileExA Lib "Kernel32" (ByVal lpExistingFileName As String, ByVal lpNewFileName As String, ByVal lpProgressRoutine As Long, lpData As Any, ByVal pbCancel As Long, ByVal dwCopyFlags As Long) As Long
'*************************************************************************
'自定义类型
Private Type CopyFileExInfo
CallBackPtr As Long
CopyCancel As Boolean
CopyFlags As Long
CopyProgress As Long
End Type
Private Const CallBack_FileCopyEx = 3
Private FileCopyExInfo As CopyFileExInfo
'***************************************************************************
'IsOverWrite:如果文件存在是否覆盖源文件
Public Function FileCopyEx(ByVal SourPath As String, ByVal DestPath As String, Optional ByVal IsOverWrite As Boolean = False) As Boolean
With FileCopyExInfo
.CopyProgress = 0
.CopyCancel = False
.CallBackPtr = GetFileCopyExCallBackPtr(CallBack_FileCopyEx) '回调函数指针
.CopyFlags = COPY_FILE_RESTARTABLE
If Not IsOverWrite Then .CopyFlags = .CopyFlags Or COPY_FILE_FAIL_IF_EXISTS
FileCopyEx = CBool(CopyFileExA(SourPath, DestPath, .CallBackPtr, ByVal 0&, VarPtr(.CopyCancel), .CopyFlags))
If .CallBackPtr <> 0 Then
Call HeapFree(GetProcessHeap, 0, ByVal .CallBackPtr)
.CallBackPtr = 0
End If
End With
End Function
'***************************************************************************
'获取回调函数指针
Private Function GetFileCopyExCallBackPtr(ByVal FunctionCount As Long) As Long
Dim FunctionPtr As Long
Call CopyMemory(FunctionPtr, ByVal ObjPtr(Me), 4)
FunctionPtr = FunctionPtr + (FunctionCount - 1) * 4 + &H1C
If CBool(IsBadReadPtr(ByVal FunctionPtr, 4)) Then Exit Function
Call CopyMemory(FunctionPtr, ByVal FunctionPtr, 4)
If FunctionPtr = 0 Then Exit Function
Dim AsmCode(18) As Long
AsmCode(0) = &H83EC8B55: AsmCode(1) = &H75FF08EC
AsmCode(2) = &H3475FF38: AsmCode(3) = &HFF3075FF
AsmCode(4) = &H75FF2C75: AsmCode(5) = &H2475FF28
AsmCode(6) = &HFF2075FF: AsmCode(7) = &H75FF1C75
AsmCode(8) = &H1475FF18: AsmCode(9) = &HFF1075FF
AsmCode(10) = &H75FF0C75: AsmCode(11) = &HFC75FF08
AsmCode(12) = &H50F8458D: AsmCode(13) = &H100068
AsmCode(14) = &H2000B800: AsmCode(15) = &HC08B0000
AsmCode(16) = &H458BD0FF: AsmCode(17) = &H34C2C9F8
Call CopyMemory(ByVal VarPtr(AsmCode(13)) + 1, ObjPtr(Me), 4)
Call CopyMemory(ByVal VarPtr(AsmCode(14)) + 2, FunctionPtr, 4)
Dim Length As Long
Length = (UBound(AsmCode) + 1) * 4
GetFileCopyExCallBackPtr = HeapAlloc(GetProcessHeap, HEAP_ZERO_MEMORY, Length)
If GetFileCopyExCallBackPtr = 0 Then Exit Function
Call VirtualProtect(ByVal GetFileCopyExCallBackPtr, Length, PAGE_EXECUTE_READWRITE, 0&)
Call CopyMemory(ByVal GetFileCopyExCallBackPtr, AsmCode(0), Length)
End Function
'***************************************************************************
'回调函数:CopyProgressRoutine
'原本的回调函数没有Result和EachBytesCopied参数,而且有返回值(Function),具体可看MSDN
'改成Sub(Result为返回值,EachBytesCopy为每次复制的字节数,CopyFileEx触发回调函数的条件)
Private Sub CopyProgressRoutine(ByRef Result As Long, ByVal EachBytesCopied As Long, 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)
On Error Resume Next
If dwCallbackReason = CALLBACK_STREAM_SWITCH Then
RaiseEvent FileCopyExBegin
End If
DoEvents
Dim CopyProgress As Long
CopyProgress = (TotalBytesTransferred / TotalFileSize) * 100
If FileCopyExInfo.CopyProgress < CopyProgress Then
RaiseEvent FileCopyExProgress(CopyProgress, FileCopyExInfo.CopyCancel)
If FileCopyExInfo.CopyCancel Then
RaiseEvent FileCopyExCancel
End If
End If
FileCopyExInfo.CopyProgress = CopyProgress
Result = PROGRESS_CONTINUE '也可以使用PROGRESS_CANCEL来取消
End Sub