PROGRESSBAR NÃO ATUALIZA

ADILSOO 17/09/2016 11:15:24
#467060
Bom dia pessoal!
Tenho um sistema de atualização que estou desenvolvendo, quando executo o timer pra funcionar, ele para, e só aparece quando finaliza, eu só quero que o progress fique indo e voltando conforme está, mas ele não fica.
Command1.Enabled = False
Me.Height = 4065
Timer1.Enabled = True

Dim LINK As String
Dim CAMINHO As String

[ô]Apaga Atualização antiga
Kill [Ô]C:\Mega\Arquivos\Programas\Backup\Programacao\Sistemas\Fazendas\Update\Fazendas.exe[Ô]

[ô]Efetua Download do Arquivo novo
LINK = [Ô]http://download1489.mediafire.com/9c520fqwr0fg/hdwcg43ej2hb9ps/Fazendas.exe[Ô]
[ô]Salva arquivo na pasta Update
CAMINHO = [Ô]C:\Mega\Arquivos\Programas\Backup\Programacao\Sistemas\Fazendas\Update\Fazendas.exe[Ô]
URLDownloadToFile 0, LINK, CAMINHO, 0, 0

[ô]Verifica se o arquivo de atualização existe
If Not Dir([Ô]C:\Mega\Arquivos\Programas\Backup\Programacao\Sistemas\Fazendas\Update\Fazendas.exe[Ô]) = [Ô]Fazendas.exe[Ô] Then
MsgBox [Ô]O arquivo de atualização não foi encontrado![Ô], vbCritical + vbOKOnly, [Ô]Erro na atualização[Ô]
Exit Sub
End If

[ô]Apaga Arquivo antigo
Kill [Ô]C:\Mega\Arquivos\Programas\Backup\Programacao\Sistemas\Fazendas\Fazendas.exe[Ô]

[ô]Copia o novo arquivo
FileCopy [Ô]C:\Mega\Arquivos\Programas\Backup\Programacao\Sistemas\Fazendas\Update\Fazendas.exe[Ô], [Ô]C:\Mega\Arquivos\Programas\Backup\Programacao\Sistemas\Fazendas\Fazendas.exe[Ô]

If MsgBox([Ô]Atualização concluída com sucesso![Ô] & vbNewLine & [Ô]Deseja retornar ao sistema?[Ô], vbQuestion + vbYesNo, [Ô]Sistema diz[Ô]) = vbYes Then
Shell [Ô]C:\Mega\Arquivos\Programas\Backup\Programacao\Sistemas\Fazendas\Fazendas.exe[Ô]
End If

Command1.Enabled = True
Timer1.Enabled = False
Me.Height = 3405


If Destino = [Ô]proximo[Ô] Then
    If barra.Value = 100 Then
        Destino = [Ô]voltar[Ô]
    Else
        barra.Value = barra.Value + 2
        DoEvents
    End If
Else
    If barra.Value = 0 Then
        Destino = [Ô]proximo[Ô]
    Else
        barra.Value = barra.Value - 2
        DoEvents
    End If
End If


Tentei o DoEvents, mas parece que não adianta, alguma solução?
ALVAROVB2009 19/09/2016 09:19:50
#467096
Coloca o Doevents antes de carregar o progress
DoEvents
barra.Value = barra.Value - 2

O doevents faz uma pausa para poder exibir a visualização desejada


Toda vez que vc quiser fazer a pausa tem que usar o doevents
Esse aqui é o que um exemplo do que eu faço
DoEvents
barra.Value = barra.Value + 1
DoEvents
LblTratamento.Caption = [Ô]Tratando registro [Ô] & barra.Value & [Ô] de [Ô] & ContaLinhasArquivo - 2
Aux = Aux + 1
MARCELO.TREZE 19/09/2016 11:00:31
#467099
bom no seu código não vejo onde você faz o download do arquivo, vejo apenas uma string LINK que não sei onde você utiliza?

mas é assim você deve arrumar outra forma de fazer o download, pois o objeto timer pode travar dependendo dos processos do windows, segue uma dica:

inclua um controle INET no seu projeto, e use a seguinte função.
:
Private Function DownloadFileWithProgress(ByVal SourceURL As String, _
                             ByVal DestinationPath As String, _
                             ProgressControl As Object, _
                             InetControl As Object) As Boolean
 
    Const CHUNK_SIZE As Long = 1024
 
    Dim lBytesReceived As Long
    Dim lFileLength As Long
    Dim sHeader As String
    Dim b() As Byte
    Dim i As Integer
 
    DoEvents
 
    ProgressControl.Value = 0
    ProgressControl.Min = 0
    ProgressControl.Max = 100
 
    DoEvents
 
    With InetControl
        .url = SourceURL
        .Execute , [Ô]GET[Ô], , [Ô]Range: bytes=[Ô] & CStr(lBytesReceived) & [Ô]-[Ô] & vbCrLf
 
        While .StillExecuting
            DoEvents
        Wend
 
        sHeader = .GetHeader
    End With
 
    sHeader = InetControl.GetHeader([Ô]Content-Length[Ô])
    lFileLength = Val(sHeader)
 
    DoEvents
 
    lBytesReceived = 0
 
    Open DestinationPath For Binary Access Write As #1
        Do
            b = InetControl.GetChunk(CHUNK_SIZE, icByteArray)
            Put #1, , b
            lBytesReceived = lBytesReceived + UBound(b, 1) + 1
 
            ProgressControl.Value = (Round((lBytesReceived / lFileLength) * 100))
            DoEvents
        Loop While UBound(b, 1) > 0
    Close #1
End Function


agora fica mais simples

Command1.Enabled = False
Me.Height = 4065

Dim LINK As String
Dim CAMINHO As String

[ô]Apaga Atualização antiga
Kill [Ô]C:\Mega\Arquivos\Programas\Backup\Programacao\Sistemas\Fazendas\Update\Fazendas.exe[Ô]

[ô]Efetua Download do Arquivo novo
LINK = [Ô]http://download1489.mediafire.com/9c520fqwr0fg/hdwcg43ej2hb9ps/Fazendas.exe[Ô]
[ô]Salva arquivo na pasta Update
CAMINHO = [Ô]C:\Mega\Arquivos\Programas\Backup\Programacao\Sistemas\Fazendas\Update\Fazendas.exe[Ô]

[ô]URLDownloadToFile 0, LINK, CAMINHO, 0, 0--> use a função que lhe passei

DownloadFileWithProgress LINK, CAMINHO, Me.ProgressBar1, Me.Inet1

[ô]Verifica se o arquivo de atualização existe
If Not Dir([Ô]C:\Mega\Arquivos\Programas\Backup\Programacao\Sistemas\Fazendas\Update\Fazendas.exe[Ô]) = [Ô]Fazendas.exe[Ô] Then
MsgBox [Ô]O arquivo de atualização não foi encontrado![Ô], vbCritical + vbOKOnly, [Ô]Erro na atualização[Ô]
Exit Sub
End If

[ô]Apaga Arquivo antigo
Kill [Ô]C:\Mega\Arquivos\Programas\Backup\Programacao\Sistemas\Fazendas\Fazendas.exe[Ô]

[ô]Copia o novo arquivo
FileCopy [Ô]C:\Mega\Arquivos\Programas\Backup\Programacao\Sistemas\Fazendas\Update\Fazendas.exe[Ô], [Ô]C:\Mega\Arquivos\Programas\Backup\Programacao\Sistemas\Fazendas\Fazendas.exe[Ô]

If MsgBox([Ô]Atualização concluída com sucesso![Ô] & vbNewLine & [Ô]Deseja retornar ao sistema?[Ô], vbQuestion + vbYesNo, [Ô]Sistema diz[Ô]) = vbYes Then
Shell [Ô]C:\Mega\Arquivos\Programas\Backup\Programacao\Sistemas\Fazendas\Fazendas.exe[Ô]
End If

Command1.Enabled = True
Me.Height = 3405


com a função que postei conseguira fazer o dowload com barra de progresso

não esqueça de incluir um objeto INET e uma PROGRESSBAR
Tópico encerrado , respostas não são mais permitidas
Voltar