复制文件(使用CopyFileEx)

酷心 2014-04-28 01:03:47

加精

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

窗体中：2个Command，1个Label

Option Explicit

Dim WithEvents iFile As IClsFile

Dim CancelCopy As Boolean



Private Sub Command1_Click()

  Dim Path1 As String

  Dim Path2 As String

  Path1 = "E:\Test.avi" '源文件

  Path2 = "D:\Av.avi" '目标文件

  CancelCopy = False

  MsgBox iFile.FileCopyEx(Path1, Path2, True)

End Sub



Private Sub Command2_Click()

  CancelCopy = True

End Sub



Private Sub Form_Load()

  Set iFile = New IClsFile

End Sub



Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)

  Set iFile = Nothing

End Sub



Private Sub iFile_FileCopyExBegin()

  MsgBox "iFile_FileCopyExBegin"

End Sub



Private Sub iFile_FileCopyExCancel()

  MsgBox "iFile_FileCopyExCancel"

End Sub



Private Sub iFile_FileCopyExProgress(ByVal Progress As Long, Cancel As Boolean)

  Label1.Caption = "已复制:" & Progress & "%"

  Cancel = CancelCopy

End Sub

具体如何使用就看你的了，写类模块最主要的是可以定义事件，不过相对于模块速度慢点

...全文

4372 31 打赏收藏转发到动态举报

写回复

用AI写文章

31 条回复

切换为时间正序

请发表友善的回复…

发表回复

wenzhang912418283 2015-11-19

打赏
举报

不错不错

vansoft 2014-05-11

打赏
举报

顶。向高手学习。

lewit 2014-05-09

打赏
举报

呵呵，学习了，谢谢楼主

腹黑的大象 2014-05-08

打赏
举报

public static void main(String[] args) { copyFolder(oldPath, newPath) } /** * 复制整个文件夹内容 * @param oldPath String 原文件路径如：c:/fqf * @param newPath String 复制后路径如：f:/fqf/ff * @return boolean */ public static void copyFolder(String oldPath, String newPath) { try { (new File(newPath)).mkdirs(); //如果文件夹不存在则建立新文件夹 File a=new File(oldPath); String[] file=a.list(); File temp=null; for (int i = 0; i < file.length; i++) { if(oldPath.endsWith(File.separator)){ temp=new File(oldPath+file[i]); } else{ temp=new File(oldPath+File.separator+file[i]); } if(temp.isFile()){ FileInputStream input = new FileInputStream(temp); FileOutputStream output = new FileOutputStream(newPath + "/" + (temp.getName()).toString()); byte[] b = new byte[1024 * 5]; int len; while ( (len = input.read(b)) != -1) { output.write(b, 0, len); } output.flush(); output.close(); input.close(); } if(temp.isDirectory()){//如果是子文件夹 copyFolder(oldPath+"/"+file[i],newPath+"/"+file[i]); System.out.println(temp.getName()+"拷贝成功"); } } } catch (Exception e) { System.out.println("复制整个文件夹内容操作出错"); e.printStackTrace(); } } 这不是更简单

chtan7882 2014-05-08

打赏
举报

收藏了，谢谢。

gzhcdz 2014-05-06

打赏
举报

PctGL 2014-05-04

打赏
举报

dt168 2014-05-03

打赏
举报

支持，vb值得顶

hong125aa 2014-05-02

打赏
举报

学习.....

云满笔记 2014-05-01

打赏
举报

居然是VB C++的路过。。。

125096 2014-04-29

打赏
举报

我很赞同。。。。

xwj 2014-04-29

打赏
举报

谢谢，学习研究一下

shwan521 2014-04-29

打赏
举报

鸥翔鱼游1 2014-04-29

打赏
举报

谢谢，学习研究一下

zoye2008 2014-04-28

打赏
举报

舉杯邀明月 2014-04-28

打赏
举报

留下脚印……

鸥翔鱼游1 2014-04-28

打赏
举报

不错~不错~学习一下~

酷心 2014-04-28

打赏
举报

太长了，需要的话大家还到我的资源下载吧，等于一下搞的全部都是代码，不好……

酷心 2014-04-28

打赏
举报

首先感谢【bcrun】版主的推荐和加分，谢谢！同时感谢大家的支持！在这里我再提供一份【VB 调用函数指针的方法实现，支持任意类型，任意个数参数（除Any类型）以及任意类型返回值】，对于Any，Optional，ParamArray，看你想传入什么类型就声明什么类型即可。以供大家学习参考：具体更多的参数类型你可以自己试试，也可以到我的资源下载，参数类型可以是任意的，包括数组，用户自定义类型…… 代码下接，太长了无法提交，只能分割了…… 类模块：

Option Explicit: Option Base 0

Private Declare Function CallAsmCode Lib "user32" Alias "CallWindowProcA" (ByRef lpCode As Long, ByVal lpFunc As Long, ByRef lpParam As Long, ByVal nParam As Long, ByRef Result As Long) As Long

Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
Private Declare Function IsBadReadPtr Lib "kernel32" (lp As Any, ByVal ucb As Long) As Long
Private Declare Function IsBadWritePtr Lib "kernel32" (lp As Any, ByVal ucb As Long) As Long

Private Const VT_BYREF = &H4000

Private Type ParmData
  ByOf As String
  Type As String
  Data() As Byte
End Type
Private Type ParmsData
  Count As Long
  Param() As ParmData
  Ready As Boolean
End Type

Private Type FuncData
  FPtr As Long
  Type As String
  RPtr As Long
End Type
Private Type FuncsData
  Funcn As FuncData
  Ready As Boolean
End Type

Private Type CallsData
  ACode() As Long
  Count As Long
  Param() As Long
End Type

Private Type FunCallType
  Functn As FuncsData
  Params As ParmsData
  CallEx As CallsData
End Type

Private FunCall As FunCallType

Private Sub Class_Initialize()
  ReDim FunCall.CallEx.ACode(36):        FunCall.CallEx.ACode(0) = &H53EC8B55
  FunCall.CallEx.ACode(1) = &HE8:        FunCall.CallEx.ACode(2) = &HEB815B00
  FunCall.CallEx.ACode(3) = &H1000112C:  FunCall.CallEx.ACode(4) = &H114A938D
  FunCall.CallEx.ACode(5) = &H64521000:  FunCall.CallEx.ACode(6) = &H35FF
  FunCall.CallEx.ACode(7) = &H89640000:  FunCall.CallEx.ACode(8) = &H25
  FunCall.CallEx.ACode(9) = &H8B1FEB00:  FunCall.CallEx.ACode(10) = &HE80C2444
  FunCall.CallEx.ACode(11) = &H0:        FunCall.CallEx.ACode(12) = &H53E98159
  FunCall.CallEx.ACode(13) = &H8D100011: FunCall.CallEx.ACode(14) = &H119791
  FunCall.CallEx.ACode(15) = &HB8908910: FunCall.CallEx.ACode(16) = &H33000000
  FunCall.CallEx.ACode(17) = &H558BC3C0: FunCall.CallEx.ACode(18) = &H104D8B0C
  FunCall.CallEx.ACode(19) = &HEB8A148D: FunCall.CallEx.ACode(20) = &HFC528D06
  FunCall.CallEx.ACode(21) = &HB4932FF:  FunCall.CallEx.ACode(22) = &H8BF675C9
  FunCall.CallEx.ACode(23) = &HD0FF0845: FunCall.CallEx.ACode(24) = &H58F64
  FunCall.CallEx.ACode(25) = &H83000000: FunCall.CallEx.ACode(26) = &H4D8B04C4
  FunCall.CallEx.ACode(27) = &H89018914: FunCall.CallEx.ACode(28) = &H51D90451
  FunCall.CallEx.ACode(29) = &HC51DD08:  FunCall.CallEx.ACode(30) = &H10C2C95B
  FunCall.CallEx.ACode(31) = &H58F6400:  FunCall.CallEx.ACode(32) = &H0
  FunCall.CallEx.ACode(33) = &H3304C483: FunCall.CallEx.ACode(34) = &H144D8BC0
  FunCall.CallEx.ACode(35) = &HC95B0189: FunCall.CallEx.ACode(36) = &H900010C2
End Sub

Private Function GetTypeName(ByVal DataType As String) As String
  Select Case UCase(DataType)
    Case "", "NO", "SUB", "NONE":       GetTypeName = "NONE"
    Case "BT", "BYT", "BYTE":           GetTypeName = "BYTE"
    Case "BL", "BOL", "BOOLEAN":        GetTypeName = "BOOLEAN"
    Case "IT", "INT", "INTEGER":        GetTypeName = "INTEGER"
    Case "LG", "LNG", "LONG":           GetTypeName = "LONG"
    Case "SI", "SNG", "SINGLE":         GetTypeName = "SINGLE"
    Case "ST", "STR", "STRING":         GetTypeName = "STRING"
    Case "OJ", "OBJ", "OBJECT":         GetTypeName = "OBJECT"
    Case "EM", "ENM", "USERENUM":       GetTypeName = "USERENUM"
    Case "TP", "TYP", "USERTYPE":       GetTypeName = "USERTYPE"
    Case "DB", "DBL", "DOUBLE":         GetTypeName = "DOUBLE"
    Case "DT", "DAT", "DATE":           GetTypeName = "DATE"
    Case "CY", "CUR", "CURRENCY":       GetTypeName = "CURRENCY"
    Case "VR", "VAR", "VARIANT":        GetTypeName = "VARIANT"
    Case "BT()", "BYT()", "BYTE()":     GetTypeName = "BYTE()"
    Case "BL()", "BOL()", "BOOLEAN()":  GetTypeName = "BOOLEAN()"
    Case "IT()", "INT()", "INTEGER()":  GetTypeName = "INTEGER()"
    Case "LG()", "LNG()", "LONG()":     GetTypeName = "LONG()"
    Case "SI()", "SNG()", "SINGLE()":   GetTypeName = "SINGLE()"
    Case "ST()", "STR()", "STRING()":   GetTypeName = "STRING()"
    Case "OJ()", "OBJ()", "OBJECT()":   GetTypeName = "OBJECT()"
    Case "EM()", "ENM()", "USERENUM()": GetTypeName = "USERENUM()"
    Case "TP()", "TYP()", "USERTYPE()": GetTypeName = "USERTYPE()"
    Case "DB()", "DBL()", "DOUBLE()":   GetTypeName = "DOUBLE()"
    Case "DT()", "DAT()", "DATE()":     GetTypeName = "DATE()"
    Case "CY()", "CUR()", "CURRENCY()": GetTypeName = "CURRENCY()"
    Case "VR()", "VAR()", "VARIANT()":  GetTypeName = "VARIANT()"
    Case Else:                          GetTypeName = "ERROR"
  End Select
End Function

Private Function PointerIsNull(ByVal Pointer As Long) As Boolean
  Select Case FunCall.Functn.Funcn.Type
    Case "NONE":     PointerIsNull = (Pointer <> 0)
    Case "BYTE":     PointerIsNull = IsBadWritePtr(ByVal Pointer, 1)
    Case "BOOLEAN":  PointerIsNull = IsBadWritePtr(ByVal Pointer, 2)
    Case "INTEGER":  PointerIsNull = IsBadWritePtr(ByVal Pointer, 2)
    Case "LONG":     PointerIsNull = IsBadWritePtr(ByVal Pointer, 4)
    Case "SINGLE":   PointerIsNull = IsBadWritePtr(ByVal Pointer, 4)
    Case "STRING":   PointerIsNull = IsBadWritePtr(ByVal Pointer, 4)
    Case "OBJECT":   PointerIsNull = IsBadWritePtr(ByVal Pointer, 4)
    Case "USERENUM": PointerIsNull = IsBadWritePtr(ByVal Pointer, 4)
    Case "USERTYPE": PointerIsNull = IsBadWritePtr(ByVal Pointer, 1)
    Case "DOUBLE":   PointerIsNull = IsBadWritePtr(ByVal Pointer, 8)
    Case "DATE":     PointerIsNull = IsBadWritePtr(ByVal Pointer, 8)
    Case "CURRENCY": PointerIsNull = IsBadWritePtr(ByVal Pointer, 8)
    Case "VARIANT":  PointerIsNull = IsBadWritePtr(ByVal Pointer, 16)
    Case Else:       PointerIsNull = IsBadWritePtr(ByVal Pointer, 4)
  End Select
End Function

Public Function CreateAnyFun(ByVal FunAddress As Long, Optional ByVal ReturnType As String, Optional ByVal ReturnAddress As Long) As Boolean
  FunCall.Functn.Funcn.FPtr = 0:  FunCall.Functn.Funcn.RPtr = 0
  FunCall.Functn.Funcn.Type = "": FunCall.Functn.Ready = False
  If CBool(IsBadReadPtr(ByVal FunAddress, 4)) Then Exit Function
  FunCall.Functn.Funcn.FPtr = FunAddress
  FunCall.Functn.Funcn.Type = GetTypeName(ReturnType)
  If FunCall.Functn.Funcn.Type = "ERROR" Then Exit Function
  If FunCall.Functn.Funcn.Type = "NONE" Then
    If ReturnAddress <> 0 Then Exit Function
    FunCall.Functn.Ready = True: CreateAnyFun = True: Exit Function
  End If
  If FunCall.Functn.Funcn.Type = "USERTYPE" Then
    If PointerIsNull(ReturnAddress) Then Exit Function
    FunCall.Functn.Funcn.RPtr = ReturnAddress
    FunCall.Functn.Ready = True: CreateAnyFun = True: Exit Function
  End If
  If ReturnAddress <> 0 Then
    If PointerIsNull(ReturnAddress) Then Exit Function
    FunCall.Functn.Funcn.RPtr = ReturnAddress
  End If
  FunCall.Functn.Ready = True: CreateAnyFun = True
End Function

Private Function VarIsString(ByRef VarData As Variant) As Boolean
  On Error GoTo ErrVarIsString
  VarData = CStr(VarData)
  VarIsString = True
  Exit Function
ErrVarIsString:
End Function

Private Function GetByOfName(ByVal DataBy As String) As String
  Select Case UCase(DataBy)
    Case "R", "BR", "REF", "BYREF": GetByOfName = "BYREF"
    Case "V", "BV", "VAL", "BYVAL": GetByOfName = "BYVAL"
    Case Else:                      GetByOfName = "ERROR"
  End Select
End Function

Private Function TypeIsNull(ByRef DataList() As String) As Boolean
  If DataList(0) = "NONE" Then TypeIsNull = True: Exit Function
  If DataList(0) = "ERROR" Then TypeIsNull = True: Exit Function
  If DataList(1) = "ERROR" Then TypeIsNull = True: Exit Function
  If DataList(0) = "BYVAL" Then
    If DataList(1) = "USERTYPE" Then TypeIsNull = True: Exit Function
    If (InStr(DataList(1), "()") > 0) Then TypeIsNull = True: Exit Function
  End If
End Function

Private Function SetParamList(ByRef DataList() As String) As Boolean
  If UBound(DataList) <> 1 Then Exit Function
  DataList(0) = GetByOfName(DataList(0))
  DataList(1) = GetTypeName(DataList(1))
  SetParamList = Not TypeIsNull(DataList)
  If Not SetParamList Then Exit Function
  With FunCall.Params
    ReDim Preserve .Param(.Count)
    .Param(.Count).ByOf = DataList(0)
    .Param(.Count).Type = DataList(1)
    .Count = .Count + 1
  End With
End Function

Public Function CreateParams(ParamArray ParamDeclareList() As Variant) As Boolean
  Erase FunCall.Params.Param: FunCall.Params.Count = 0
  If IsMissing(ParamDeclareList) Then
    FunCall.Params.Ready = True: CreateParams = True: Exit Function
  End If
  Dim iNx As Long, ParamList As String, Param() As String
  For iNx = 0 To UBound(ParamDeclareList)
    If VarIsString(ParamDeclareList(iNx)) Then
      ParamList = ParamDeclareList(iNx)
      Do While InStr(ParamList, Space(2)) > 0
        ParamList = Replace(ParamList, Space(2), Space(1))
      Loop
      Param = Split(Trim(ParamList), Space(1))
      If SetParamList(Param) Then CreateParams = True
    End If
  Next
  FunCall.Params.Ready = CreateParams
End Function