Легко.
В модуль.
- Option Explicit
-
- Public Const PROGRESS_CANCEL = 1
- Public Const PROGRESS_CONTINUE = 0
- Public Const PROGRESS_QUIET = 3
- Public Const PROGRESS_STOP = 2
- Public Const COPY_FILE_FAIL_IF_EXISTS = &H1
- Public Const COPY_FILE_RESTARTABLE = &H2
- Public Declare Function CopyFileEx Lib "kernel32.dll" Alias "CopyFileExA" (ByVal lpExistingFileName As String, ByVal lpNewFileName As String, ByVal lpProgressRoutine As Long, lpData As Any, ByRef pbCancel As Long, ByVal dwCopyFlags As Long) As Long
- Public bCancel As Long
- Public Function CopyProgress(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) As Long
- Dim intProgress As Integer
- intProgress = CInt((TotalBytesTransferred * 10000) / (TotalFileSize * 10000) * 100)
- frmCopyFile.ProgressBar1.Value = intProgress
- frmCopyFile.Label3 = CStr(intProgress) & " % завершено"
- DoEvents
- CopyProgress = PROGRESS_CONTINUE
- End Function
В форму.
- Option Explicit
-
- Dim t1 As Date
- Dim t2 As Date
- Private Sub Command1_Click()
- Dim Ret As Long
- t1 = Time
- Ret = CopyFileEx(Text1.Text, Text2.Text, AddressOf CopyProgress, ByVal 0&, bCancel, COPY_FILE_RESTARTABLE)
- frmCopyFile.Caption = "Копирование " + IIf(Ret = 0, " отменено", "завершено")
- t2 = Time
- Label3.Caption = "Время копирования: " & CDate(t2 - t1)
- End Sub
-
- Private Sub Command2_Click()
- bCancel = 1
- End Sub
На форме прогресбар, два текстбокса(откуда и куда) и две кнопки.
Ответить
|