VBA - [решено] Помогите исправить.

Ответить
 • Просмотры: 1
Аватара пользователя
by_gangster

Re: VBA - [решено] Помогите исправить.

Сообщение by_gangster »

Цитата by_gangster:



mrcnn, Если закомментирована строка all.AddRange(bts) то прогресс-бар не работает.
VBA - [решено] Помогите исправить.




Перепишите так, чтобы «прогресс-бар» использовал другой метод подсчёта, нежели опрос размера объекта «all».
Аватара пользователя
mrcnn

Re: VBA - [решено] Помогите исправить.

Сообщение mrcnn »

Код:

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

' Получить собственно файл
        If PathForDownl = "" Then
            FlName = IO.Path.GetTempPath & IO.Path.GetFileName(fl)
        Else
            PathForDownloads = GetMaxPath(PathForDownloads)
            If IO.Directory.Exists(PathForDownloads) = False Then
                IO.Directory.CreateDirectory(PathForDownloads)
            End If
            FlName = PathForDownloads & "\" & IO.Path.GetFileName(fl)
        End If
        If IO.Path.GetFileName(FlName).Split(IO.Path.GetInvalidFileNameChars).Length > 1 Then
            FlName = IO.Path.GetTempPath & GetUIN() & ".tmp"
        End If
'Открыть файл
' Поток в файл (объявление)
Dim  fstr As New System.IO.FileStream(FlName,  System.IO.FileMode.OpenOrCreate)
Dim dnl_size As Long = 0
'Открытие потока в файл
'fstr = System.IO.File.OpenWrite(FlName)
' Получить асинхронно
        If WaitForDownload = False Then
fstr.Close()
            thr = New Threading.Thread(AddressOf AsyncDownload)
            thr.Start(myHttpWebResponse.GetResponseStream)
            ' Получить синхронно
        Else
            FileDownloading = True
            Dim myStreamReader As New IO.BinaryReader(myHttpWebResponse.GetResponseStream)
            Dim all As New System.Collections.Generic.List(Of Byte)
            Do
                ' Собственно получения порции данных
                Dim bts() As Byte = myStreamReader.ReadBytes(BufferSize)
                If bts.Length = 0 Then Exit Do
fstr.Seek(0,   System.IO.SeekOrigin.End)
For Each bytevalue As Byte In bts
fstr.WriteByte(bytevalue)
fstr.Seek(0,   System.IO.SeekOrigin.End)
dnl_size = dnl_size + 1
Next
                'all.AddRange(bts)
                ' Вызов события Идет прием данных
                ReceiveProgressInvoke(dnl_size)
            Loop
            'DownloadSuccess(all)
        End If
' Функция реализующая поток, который скачивайт файл порциями BufferSize
    Sub AsyncDownload(ByVal stream As Object)
        FileDownloading = True
        Dim myStreamReader As New IO.BinaryReader(stream)
        Dim all As New System.Collections.Generic.List(Of Byte)
Dim  fstr As New System.IO.FileStream(FlName,  System.IO.FileMode.OpenOrCreate)
Dim dnl_size As Long = 0
        Do
            ' Всякие Прерывания и Паузы потока
            If FileDownloading = False Then DownloadCancelledInvoke() : myStreamReader.Close() : Exit Sub
            While DownloadPause
                System.Windows.Forms.Application.DoEvents()
                If FileDownloading = False Then DownloadCancelledInvoke() : myStreamReader.Close() : Exit Sub
            End While
            ' Собственно получения порции данных
            Dim bts() As Byte = myStreamReader.ReadBytes(BufferSize)
            If bts.Length = 0 Then Exit Do
fstr.Seek(0,   System.IO.SeekOrigin.End)
For Each bytevalue As Byte In bts
fstr.WriteByte(bytevalue)
fstr.Seek(0,   System.IO.SeekOrigin.End)
dnl_size = dnl_size + 1
Next
            'all.AddRange(bts)
            ' Вызов события Идет прием данных
            ReceiveProgressInvoke(dnl_size)
        Loop
        'DownloadSuccess(all)
    End Sub
Аватара пользователя
by_gangster

Re: VBA - [решено] Помогите исправить.

Сообщение by_gangster »

mrcnn, Спасибо тебе огромное, побольше бы таких людей.
Аватара пользователя
by_gangster

Re: VBA - [решено] Помогите исправить.

Сообщение by_gangster »

mrcnn,

Проблема в том что когда файл полностью скачался программа просто напросто показывает 100% и не завершает закачку. Выход только один - это закрыть программу. Пробовал раскоментить DownloadSuccess(all) тогда программа в конце просто напросто выдаёт ошибку и всё. Помогите пожалуйста.
Аватара пользователя
by_gangster

Re: VBA - [решено] Помогите исправить.

Сообщение by_gangster »

Там где вызывается DownloadSuccess попробуйте вызвать функцию DownloadSuccess2





Код:

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

    Sub DownloadSuccess2()
            ' Собственно завершение загрузки
            ResultQuery = FlName
            ' Снимаем синхблок
            FileDownloading = False
            ' Вызов события ПолученОтвет
            RaiseEvent ReceivedResponse(Me, New EventArgs)
    End Sub
Аватара пользователя
by_gangster

Re: VBA - [решено] Помогите исправить.

Сообщение by_gangster »

mrcnn, Спасибо, всё сработало. А ещё скажите как можно сделать что бы после завершения загрузки программа больше не использовала файл. Т.е просто после загрузки файл нельзя открыть (его использует программа), можно только после закрытия программы. Что можно добавить после downloadsuccess2() для закрытия файла программой ?
Аватара пользователя
by_gangster

Re: VBA - [решено] Помогите исправить.

Сообщение by_gangster »

Код:

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

fstr.Close()

после Loop перед закомментированным DownloadSuccess
Ответить

Вернуться в «Программирование и базы данных»