Не быстрый метод копирования файлов...

[kibernetics]

Заметил серьёзную проблему в копировании файлов посредствов АПИ-функции. По сравнение со встроенной виндовой, или даже FSO копируется намного быстрее, нежели:

Код: Выделить всё

Private Sub CopyAllFiles(strDPath As String, bSplash As Boolean)
   
    Dim ret As Long
    Dim lCount As Long
    Dim strNewPath As String
    Dim strOldPath As String
    For lCount = 1 To colPaths.Count
       
        strOldPath = colPaths(lCount)
       
        If bSplash Then
            ret = InStrRev(strOldPath, "\")
            strNewPath = Mid(strOldPath, ret)
            ret = CopyFileEx(strOldPath, strDPath & strNewPath, AddressOf CopyProgressRoutine, ByVal 0&, bCancel, COPY_FILE_RESTARTABLE)
        Else
            strNewPath = Right(strOldPath, Len(strOldPath) - iPath)
            ret = CopyFileEx(strOldPath, strDPath & strNewPath, AddressOf CopyProgressRoutine, ByVal 0&, bCancel, COPY_FILE_RESTARTABLE)
        End If
       
        If ret = 0 Then MsgBox "Ошибка копирования: " & strOldPath
       
        frmMain.ProgressBar1.Value = (lCount / colPaths.Count) * 100
        frmMain.lblCurrFile = strNewPath & ". Файл " & lCount & " из " & colPaths.Count & "     "
    Next
End Sub

Кто знает в чём трамблз?

[alibek]

Видимо в колбэке тормоза.

[kibernetics]

alibek
это лечится?

[Viper]

Естественно, путем лечения коллбэка

[kibernetics]

Viper
покажи пример.
я чтото недогоняю как его можно вылечить

[Viper]

Так покажи код коллбэка, посмотрим как лечить

[kibernetics]

Viper
ты имеешь виду это:

Код: Выделить всё

Public Function CopyProgressRoutine(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
    'adjust the caption
    frmMain.ProgressBar2.Value = Int((TotalBytesTransferred * 10000) / (TotalFileSize * 10000) * 100)
    'allow user input
    DoEvents
    'continue filecopy
    CopyProgressRoutine = PROGRESS_CONTINUE
End Function

?

[Хакер]

Ну вот

Установка свойства - раз. DoEvents -два. Думай над этими местами.

+ Можно сократить на 10000

[kibernetics]

Хакер
но в виндовой функции есть DoEvents, Cancel же работает...

ты хочешь отключить мой прогрессбар?

[Хакер]

В виндовой функции нет DoEvents. DoEvents это сугубо VB-шная штука, которая сильно абстрагирует тебя от того, как всё работает в Windows.

К тому же, я вовсе не заставляю тебя убирать DoEvents. Ты ведь можешь вызывать её, но в сто раз реже, а?

[kibernetics]

без толку

отключил всё вообще, оставил только

Код: Выделить всё

CopyProgressRoutine = PROGRESS_CONTINUE

медленнее раза в 3, чем в ТоталКомандере, явно там юзается SHLFileOp

[keks-n]

Попробуй вообще убрать калбак. А перед вызовом DoEvents надо бы проверять заполненность очереди сообщений через PeekMessage.