| Вопрос: Как можно нормально отобразить процесс копирова... | Добавлено: 29.03.04 01:34 |
Автор вопроса:  KorDen | ICQ: 329465302 |
| Ответы | Всего ответов: 18 |
|
Номер ответа: 16 Автор ответа:  KorDen ICQ: 329465302 Вопросов: 4 Ответов: 11 |
Профиль | | #16 | Добавлено: 02.04.04 16:31 |
|
Сорри, сглюкануло... Повтор: ------------------------------------ М-да... Через АПИ лучше, не дествовать, так как кусочками, как оказалось действительно можно добиться отличной скорости. Скорости Винды. Так что, вот функция, пользутесь, кому надо: Public Function Copy(ByVal InitFile As String, FinalFile As String) Dim Source As Long Dim Dest As Long Dim TmpStr As String Dim FileSize As Long Dim i As Long Dim BlockSize As Long BlockSize = 65536 Source = FreeFile Open InitFile For Binary As #Source Dest = FreeFile Open FinalFile For Binary As #Dest TmpStr = Space$(BlockSize) FileSize = FileLen(InitFile) i = 0 DoEvents Do While Not EOF(Dource) i = i + 1 Get #Source, , TmpStr Put #Dest, , TmpStr If Not EOF(source) Then <Сюда прикручиваем прогресс бар: ProgressBar.value=(i*BlockSize)/FileSize*ProgressBar.Max > Else <Сюда тоже ProgressBar.value=ProgressBar.Max > End If Me.Refresh Loop Close #Source Close #Dest End Function ------------------------------------------ |
||
|
Номер ответа: 17 Автор ответа: LamerOnLine ICQ: 334781088 Вопросов: 108 Ответов: 2822 |
Профиль | | #17 | Добавлено: 02.04.04 16:42 |
|
Прикольно, но сыровато. Вообще бы еще ввернуть пару Event'ов, впиндюрить Cancel и разобраться с исключительными ситуациями... |
||
|
Номер ответа: 18 Автор ответа: 2SanВопросов: 11 Ответов: 68 |
Профиль | | #18 | Добавлено: 02.04.04 21:56 |
|
Заездили уже тему! Есть же встроеный в винду механизм копирования группы файлов (папок) с отображением прогресса сделаного. Привожу код (от сердца отрываю - сам долго искал). Private Const FO_MOVE As Byte = &H1 Private Const FO_COPY As Byte = &H2 Private Const FO_DELETE As Byte = &H3 Private Const FO_RENAME As Byte = &H4 Private Const FOF_WANTMAPPINGHANDLE As Long = &H20 Private Const FOF_SILENT As Long = &H4 Private Const FOF_SIMPLEPROGRESS As Long = &H100 Private Const FOF_ALLOWUNDO As Byte = &H40 Private Const FOF_NOCONFIRMATION As Byte = &H10 Private Const FOF_NOERRORUI As Long = &H400 Private Const FOF_MULTIDESTFILES As Long = &H1 Private Const FOF_RENAMEONCOLLISION As Long = &H8 Private Const FOF_NOCONFIRMMKDIR As Long = &H200 Private Type SHFILEOPSTRUCT hwnd As Long wFunc As Long pFrom As String pTo As String fFlags As Integer fAborted As Boolean hNameMaps As Long sProgress As String End Type Private Declare Function SHFileOperationW Lib "shell32.dll" (lpFileOp As Any) As Long Private Declare Function SHFileOperationA Lib "shell32.dll" (lpFileOp As Any) As Long Private Declare Sub SHFreeNameMappings Lib "shell32.dll" (ByVal hNameMappings As Long) Private Declare Function GetFileTitle Lib "comdlg32.dll" Alias "GetFileTitleA" (ByVal lpszFile As String, ByVal lpszTitle As String, ByVal cbBuf As Integer) As Integer Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long) Private Sub SHFileOeration(HwndOwner As Long, Files() As String, ByVal fTo As String, ByVal Func As Long, ByVal flags As Long) Dim FO As SHFILEOPSTRUCT Dim h As Long, TMP As String On Error Resume Next With FO .hwnd = Owner .wFunc = Func .fFlags = flags Or FOF_WANTMAPPINGHANDLE Or FOF_SIMPLEPROGRESS If UBound(Files) > 0 Then .fFlags = .fFlags Or FOF_MULTIDESTFILES If Func <> FO_DELETE Then .pTo = fTo & vbNullChar & vbNullChar Else TMP = Space(Len(Files(0))) GetFileTitle Files(0), TMP, Len(TMP) .pTo = fTo & TMP & vbNullChar & vbNullChar End If For h = 0 To UBound(Files) .pFrom = .pFrom & Files(h) & vbNullChar DoEvents Next .sProgress = "Action with files" .pFrom = .pFrom & vbNullChar .wFunc = Func Dim shfo As SHFILEOPSTRUCT Dim ByteArray() As Byte Dim buff1() As Byte, buff2() As Byte, buff3() As Byte ReDim ByteArray(LenB(FO)) CopyMemory ByteArray(0), .hwnd, Len(.hwnd) CopyMemory ByteArray(4), .wFunc, Len(.wFunc) 'Variable-length strings require extra work buff1 = StrConv(.pFrom, vbFromUnicode) h = VarPtr(buff1(0)) CopyMemory ByteArray(8), h, LenB(h) buff2 = StrConv(.pTo, vbFromUnicode) h = VarPtr(buff2(0)) CopyMemory ByteArray(12), h, LenB(h) CopyMemory ByteArray(16), .fFlags, Len(.fFlags) CopyMemory ByteArray(18), .fAborted, Len(.fAborted) CopyMemory ByteArray(22), .hNameMaps, Len(.hNameMaps) buff3 = StrConv(.sProgress & vbNullChar & vbNullChar, vbFromUnicode) h = VarPtr(buff3(0)) CopyMemory ByteArray(26), h, LenB(h) End With UnHookForm frmClipView.hwnd DoEvents Call SHFileOperationA(ByteArray(0)) 'Retrieve fAnyOperationsAborted flag ' CopyMemory .fAborted, ByteArray(18), Len(.fAborted) End Sub Privte Sub Command1_Click() Dim cFlag As Long Dim cAction As Long Dim Files() As String cFlag = FOF_RENAMEONCOLLISION Or FOF_ALLOWUNDO Or FOF_NOCONFIRMATION Or FOF_NOCONFIRMMKDIR cAction = FO_COPY ReDim Files(2) As String Files(0) = "C:\autoexec.bat" Files(1) = "C:\config.sys" Files(2) = "C:\msdos.sys" SHFileOeration hwnd, Files, "C:\Copyed files", cAction, cFlag End Sub |
||