毕业论文开发语言企业开发JAVA技术.NET技术WEB开发Linux/Unix数据库技术Windows平台移动平台嵌入式论文范文英语论文
您现在的位置: 毕业论文 >> 开发语言 >> 正文

vb复制文件代码(带进度条)

更新时间:2015-11-22:  来源:毕业论文

复制文件的方法有很多种,在这里我提供一种给大家使用,有需要的可以拿去试,但结果我就不做保证,需不需要看你!
在复制大型文件比较有用,可以显示进度,我用了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

[1] [2] 下一页

设为首页 | 联系站长 | 友情链接 | 网站地图 |

copyright©youerw.com 优尔论文网 严禁转载
如果本毕业论文网损害了您的利益或者侵犯了您的权利,请及时联系,我们一定会及时改正。