API函数CopyFileEx -- 复制大文件带进度显示的代码

Cavan2022 · 发表于 2023-6-15 12:15

本帖最后由 Cavan2022 于 2023-6-15 13:09 编辑

以下代码在VS上可以运行,哪位老师可以改成Excel上运行VBA代码,谢谢!

Imports System.Runtime.InteropServices
Public Class Form1
Private pbCancel As Int32
<DllImport("kernel32.dll", CharSet:=CharSet.Auto)> _
Private Shared Function CopyFileEx( _
ByVal lpExistingFileName As String, _
ByVal lpNewFileName As String, _
ByVal lpProgressRoutine As CopyProgressRoutine, _
ByVal lpData As IntPtr, _
ByRef pbCancel As Int32, _
ByVal dwCopyFlags As ECopyFileFlags) As Boolean
End Function
''' <summary>
''' 執行 CopyFileEx 方法的回呼函式定義。
''' </summary>
Delegate Function CopyProgressRoutine( _
ByVal TotalFileSize As Long, _
ByVal TotalBytesTransferred As Long, _
ByVal StreamSize As Long, _
ByVal StreamBytesTransferred As Long, _
ByVal dwStreamNumber As UInteger, _
ByVal dwCallbackReason As ECopyProgressCallbackReason, _
ByVal hSourceFile As IntPtr, _
ByVal hDestinationFile As IntPtr, _
ByVal lpData As IntPtr) As ECopyProgressResult
''' <summary>
''' 執行 CopyFileEx 的回呼函式的回傳列舉。
''' </summary>
Enum ECopyProgressResult As UInteger
PROGRESS_CONTINUE = 0
PROGRESS_CANCEL = 1
PROGRESS_STOP = 2
PROGRESS_QUIET = 3
End Enum
Enum ECopyProgressCallbackReason As UInteger
CALLBACK_CHUNK_FINISHED = 0
CALLBACK_STREAM_SWITCH = 1
End Enum
<Flags()> _
Enum ECopyFileFlags As UInteger
COPY_FILE_FAIL_IF_EXISTS = 1
COPY_FILE_RESTARTABLE = 2
COPY_FILE_OPEN_SOURCE_FOR_WRITE = 4
COPY_FILE_ALLOW_DECRYPTED_DESTINATION = 8
End Enum
Private Function XCopy(ByVal oldFile As String, ByVal newFile As String) As Boolean
Return CopyFileEx(oldFile, newFile, New CopyProgressRoutine(AddressOf Me.CopyProgressHandler), IntPtr.Zero, pbCancel, ECopyFileFlags.COPY_FILE_RESTARTABLE)
End Function
Private Function CopyProgressHandler(ByVal total As Long, ByVal transferred As Long, ByVal streamSize As Long, ByVal StreamByteTrans As Long, ByVal dwStreamNumber As UInteger, ByVal reason As ECopyProgressCallbackReason, _
ByVal hSourceFile As IntPtr, ByVal hDestinationFile As IntPtr, ByVal lpData As IntPtr) As ECopyProgressResult
Label1.Text = String.Format("进度: {0}%", CInt(transferred / total * 100))
Application.DoEvents()
Return ECopyProgressResult.PROGRESS_CONTINUE
End Function
Private Sub btnCopy_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnCopy.Click
If XCopy("C:\Source.avi", "D:\New.avi") Then
MsgBox("复制成功")
Else
MsgBox("复制失败")
End If
End Sub
Private Sub btnCancel_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnCancel.Click
pbCancel = 1
Application.DoEvents()
End Sub
End Class

复制代码

		自动登录	找回密码
密码			免费注册