Criando um Autoupdater

Microsoft Internet Transfer Control 6.0 (SP6)
Microsoft Windows Common Controls 6.0 (SP6)

Código:

Inet
2 ProgressBars

Código:

Option Explicit
[font=Verdana]
'Declarações
Private Declare Sub InitCommonControls Lib "comctl32.dll" ()
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

'IMPORTANTE !!! ENDEREÇO DO ARQUIVO DE INFORMAÇÃO DO UPDATE
Private Const sEndereço As String = "http://127.0.0.1/update/"
'IMPORTANTE !!! ENDEREÇO DO ARQUIVO DE INFORMAÇÃO DO UPDATE

'Verificação de Noticias ou Extração de Arquivos .RAR
Private Const Noticias As Boolean = True
Private Const ArquivosRAR As Boolean = True
Private Const DeletarRAR As Boolean = True

Private Type tAtualização
sArquivo As String
sData_Arquivo As String
sData_Atualização As String
sEndereço As String
End Type

Private sTamanho_do_Arquivo As String
Private uInformaçao() As tAtualização

Private Sub cmdCancelar_Click()
End
End Sub

Private Sub cmdPronto_Click()
Unload Me
End Sub

Private Sub Form_Initialize()
InitCommonControls
End Sub

Private Sub Form_Load()

If Noticias = False Then
txtPrincipal.Visible = False
lblAtualização.Top = 100
ProgressBar1.Top = 590
ProgressBar2.Top = 350
cmdPronto.Top = 1000
cmdCancelar.Top = 1000
Me.Height = 2000
End If

'Mudando a Cor da ProgreessBar1
Call ProgressBar_ForeColor(ProgressBar1.hwnd, "0000FF")
'Mudando a Cor da ProgreessBar2
Call ProgressBar_ForeColor(ProgressBar2.hwnd, "8B7500")

'Desativa o Botão cmdPronto
cmdPronto.Enabled = False
'Verifica de a Pasta update existe
Me.Show
'Inicia o Update
ComeçarAtualização
End Sub

Private Sub Form_Unload(Cancel As Integer)
'Ao fechar o Programa, o download sendo feito pelo Inet e cancelado assim previnindo de erros ou problemas.
iNet.Cancel
End Sub

Private Sub txtPrincipal_GotFocus()
cmdCancelar.SetFocus
End Sub
Public Sub ComeçarAtualização()
On Error Resume Next
'Declarações do Codigo
Dim iCnt As Integer
Dim sAtualização As String
Dim sNoticias As String
Dim sSplit_a() As String, sSplit_b() As String
Dim bByte_Atualização() As Byte
Dim iInt As Integer
Dim iArquivo As Integer
Dim iBinary As Integer
Dim sTemp As String
Dim lTamanho As Long, lRestante As Long, lTamanhoAgora As Long
Dim bChunk() As Byte
Dim iProgresso As Integer
Dim sPastas() As String
Dim iMax As Integer
Dim sAtualizacaoINI As String
Dim sNoticiasINI As String
Dim sPastasINI As String
Dim lRar As Long
Dim iMaxUP As Integer
Dim iUpdates As Long
'Fim das declarações


sAtualização = iNet.OpenURL(sEndereço & "Informacoes.ini", icString) 'Baixando arquivo das informações do update
'Escrevendo o arquivo de verificação dos arquivos de update
Open App.Path & "\Informacoes.ini" For Append As #1
Print #1, sAtualização
Close #1

lblAtualização.Caption = "Checando Atualizaçoes..."

'Inserindo dados nas strings
sAtualizacaoINI = ReadINI(App.Path & "\Informacoes.ini", "Informacoes", "Atualizacao")
If Noticias Then
sNoticiasINI = ReadINI(App.Path & "\Informacoes.ini", "Informacoes", "Noticias")
End If
sPastasINI = ReadINI(App.Path & "\Informacoes.ini", "Informacoes", "Pastas")
Kill App.Path & "\Informacoes.ini"

'Baixando arquivo de atualização e Noticias

sAtualização = iNet.OpenURL(sEndereço & sAtualizacaoINI, icString)

'Verificação de Status (OBS: Pode não funcionar..)
If Len(sAtualização) <= 0 Then
MsgBox "Ocorreu um erro na atualização, o servidor pode estar offline, contate o administrador.", vbCritical, "Error !"
End
End If

If Noticias Then
sNoticias = iNet.OpenURL(sEndereço & sNoticiasINI, icString)
txtPrincipal.Text = sNoticias
End If

sSplit_a = Split(sAtualização, vbCrLf)

ReDim uInformaçao(UBound(sSplit_a)) 'Re-declarando uInformação

'Selecionando Informações dos arquivos a serem baixados
For iCnt = LBound(sSplit_a) To UBound(sSplit_a)
sSplit_b = Split(sSplit_a(iCnt), ", ")
With uInformaçao(iCnt)
.sArquivo = Trim$(sSplit_b(0))
.sData_Atualização = Trim$(sSplit_b(1))
.sEndereço = Trim$(sSplit_b(2))
End With
Next iCnt
'Fim da seleção

For iMaxUP = LBound(sSplit_a) To UBound(sSplit_a)
If VerificarAtualizaçao(uInformaçao(iMaxUP).sArquivo, uInformaçao(iMaxUP).sData_Atualização) = False Then
iUpdates = iUpdates  1
End If
Next iMaxUP

If Not iUpdates <= 0 Then
ProgressBar2.Max = iUpdates
End If

'Essa parte vai verificar as pastas, baixar o arquivo, muda a porcetagem do arquivo ja baixado.
For iCnt = 0 To UBound(uInformaçao)
'Verifica se o arquivo ja foi baixado
If Not VerificarAtualizaçao(uInformaçao(iCnt).sArquivo, uInformaçao(iCnt).sData_Atualização) Then
'Coloca informações na Label
lblAtualização.Caption = "Baixando " & uInformaçao(iCnt).sArquivo & ", Aguarde..."
'Verifica as pastas a serem criadas
sPastas() = Split(sPastasINI, "|")
For iMax = LBound(sPastas) To UBound(sPastas)
VerificarPasta (sPastas(iMax))
Next
DoEvents
'Seleciona o arquivo a ser baixado pelo Inet
bByte_Atualização() = iNet.OpenURL(uInformaçao(iCnt).sEndereço, icByteArray)
'Verifica se o Inet esta Executando
Do While iNet.StillExecuting = True
DoEvents
Loop
'Muda o maximo da progressbar para 100
ProgressBar1.Max = 100
'Pega o Tamanho do Arquivo e muda os porcentos da progress bar e do Caption do Form
lTamanho = CLng(iNet.GetHeader("Content-Length"))
lRestante = lTamanho
lTamanhoAgora = 0
Do Until lRestante = 0
If lRestante > 1024 Then
bChunk = iNet.GetChunk(1024, icByteArray)
lRestante = lRestante - 1024
Else
bChunk = iNet.GetChunk(lRestante, icByteArray)
lRestante = 0
End If
lTamanhoAgora = lTamanho - lRestante
iProgresso = CInt((100 / lTamanho) * lTamanhoAgora)
ProgressBar1.Value = iProgresso
AutoUpdate.Caption = iProgresso & "%" & " Baixado" & " - Auto Update - Para RagezoneBR"
Loop
'Escreve o arquivo baixado
iBinary = FreeFile
If VerificarArquivo(App.Path & "" & uInformaçao(iCnt).sArquivo) Then
Kill App.Path & "" & uInformaçao(iCnt).sArquivo
End If
Open App.Path & "" & uInformaçao(iCnt).sArquivo For Binary Access Write As #iBinary
Put #iBinary, , bByte_Atualização()
Close #iBinary
'Escreve no arquivo de update
iArquivo = FreeFile
Open App.Path & sArquivoUPD For Append As iArquivo
If Not uInformaçao(iCnt).sArquivo = "" Then
Print #iArquivo, uInformaçao(iCnt).sArquivo & "|" & uInformaçao(iCnt).sData_Atualização
End If
Close #iArquivo
End If

If ProgressBar2.Value < ProgressBar2.Max Then
ProgressBar2.Value = ProgressBar2.Value  1
End If

'Verificando se a extração dos arquivos rar esta ativado.
If ArquivosRAR And VerificarRAR(uInformaçao(iCnt).sArquivo) Then
'Abrindo arquivo RAR
Call Rar.Open(App.Path & "" & uInformaçao(iCnt).sArquivo)
'Extraindo arquivo RAR
lRar = Rar.Unrar(App.Path & "")
lblAtualização = "Extraindo Arquivo " & uInformaçao(iCnt).sArquivo
'Se ocorrer tudo bem na extração do rar mostra uma mensagem.
If lRar <> 0 Then
lblAtualização = "Arquivo extraido com sucesso."
'Se o DeletarRAR estiver TRUE, o rar instalado será deletado.
If DeletarRAR Then
Kill App.Path & "" & uInformaçao(iCnt).sArquivo
End If

End If
End If
Next iCnt

'Informação ao Completar a Atualização
If iNet.StillExecuting = False Then
lblAtualização.Caption = "Finalizado..."
ProgressBar1.Value = ProgressBar1.Max
ProgressBar2.Value = ProgressBar2.Max
End If
AutoUpdate.Caption = "Auto Update"
'Ativa o Botão cmdPronto
cmdPronto.Enabled = True
End Sub
2° Vá no menu Project depois clique em Add Module. Depois Adicione o seguinte codigo nele:
Código:
Option Explicit
Public Const sArquivoUPD As String = "\Updates.upd"

Private Declare Function GetPrivateProfileString Lib "kernel32" Alias "GetPrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As Any, ByVal lpDefault As String, ByVal lpReturnedString As String, ByVal nSize As Long, ByVal lpFileName As String) As Long
Private Declare Function WritePrivateProfileString Lib "kernel32" Alias "WritePrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As Any, ByVal lpString As Any, ByVal lpFileName As String) As Long
Public Ret As String

Public Function VerificarArquivo(Arquivo As String) As Boolean
If Len(Dir$(Arquivo, vbNormal)) > 0 Then
VerificarArquivo = True
Exit Function
Else
VerificarArquivo = False
Exit Function
End If
End Function

Public Function VerificarPasta(Pasta As String)
If Len(Dir$(Pasta, vbDirectory)) > 0 Then
Else
MkDir App.Path & "" & Pasta
End If
End Function

'Função modificada para verificar arquivos rar com a extenção diferente como: Rar, RAr, rAr...
Public Function VerificarRAR(sArquivo As String)
If Right(sArquivo, 3) Like "[r-rR-R][a-aA-A][r-rR-R]" Then
VerificarRAR = True
Else
VerificarRAR = False
End If
End Function

'Função modificada, agora funcionando 100%
Public Function VerificarAtualizaçao(sNome As String, sData As String) As Boolean
Dim sLinhas() As String
Dim sResultado() As String
Dim sArquivo As String
Dim i As Integer

VerificarAtualizaçao = False

Open App.Path & sArquivoUPD For Input As #1
sArquivo = Input(LOF(1), #1)
Close #1

sLinhas() = Split(sArquivo, vbCrLf)
For i = LBound(sLinhas) To UBound(sLinhas)
sResultado() = Split(sLinhas(i), "|")
If sNome = sResultado(0) And sData = sResultado(1) Then
VerificarAtualizaçao = True
Exit Function
End If
Next
End Function

Public Sub WriteINI(filename As String, Section As String, Key As String, Text As String)
WritePrivateProfileString Section, Key, Text, filename
End Sub
Public Function ReadINI(filename As String, Section As String, Key As String)
Dim RetLen As String
Ret = Space$(255)
RetLen = GetPrivateProfileString(Section, Key, "", Ret, Len(Ret), filename)
Ret = Left$(Ret, RetLen)
ReadINI = Ret
End Function
3° Crie mais um module e coloque o seguinte codigo:
Código:
Public Declare Function SendMessage Lib "user32" Alias "SendMessageA" _
(ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long

Public Function ProgressBar_ForeColor(ByVal hwnd As Long, ByVal sCor As String)
SendMessage hwnd, PBM_SETBARCOLOR, 0, ByVal VBColor(sCor)
End Function

Public Function ProgressBar_Color(ByVal hwnd As Long, ByVal sCor As String)
SendMessage hwnd, PBM_SETBKCOLOR, 0, ByVal VBColor(sCor)
End Function

Private Function VBColor(sCor As String) As Long
If Len(sCor) < 6 Then
sCor = sCor & String(6 - Len(sCor), "0")
End If
VBColor = "&H" & Mid(sCor, 5, 2) & Mid(sCor, 3, 2) & Mid(sCor, 1, 2)
End Function


Informacoes.ini
Atualizacoes.txt
Noticias.txt

Atualizacao = Atualizacoes.txt
Noticias = Noticias.txt
Pastas =
Atualizacao = neste local coloque o nome do arquivos de atualizações onde ficaram os arquivos a serem atualizados.
Noticias = neste local coloque o nome do arquivo de Noticias, onde ficaram as noticias que serão mostradas no programa.
Pastas = neste local você deve colocar as pastas que precisam ser criadas, neste formato: Pasta1|Pasta2|Pasta3

Arquivoparaserbaixado.rar, 210708, [Tens de ter uma conta e sessão iniciada para poderes visualizar este link]
As informações são separadas por "," (virgulas).

QuoteVerde: Nome do arquivo que aparecerá no Client do player.
Vermelho: Data do Arquivo,
necessario para verificar se o update ja existente no cliente e o mesmo
do novo, esse campo e colocado como uma data normal mais sem os '/'.
Marrom: Endereço do Arquivo, neste local coloque a URL do arquivo que vai ser baixado pelo programa.

Private Const sEndereço As String = "http://127.0.0.1:8090/update/"
Troque "http://127.0.0.1:8090/update/" pelo Endereço do seu host.

Private Const Noticias As Boolean = True
True: Ativa as noticias, False: Desativa as noticias.

Private Const ArquivosRAR As Boolean = True
True: Ativa a extração de arquivos .rar, False: Desativa a extração de arquivos .rar.

Private Const DeletarRAR As Boolean = False
True: Deleta o arquivo.rar apos extração., False: Não deleta.

'Mudando a Cor da ProgreessBar1
Call ProgressBar_ForeColor(ProgressBar1.hwnd, "0000FF")
'Mudando a Cor da ProgreessBar2
Call ProgressBar_ForeColor(ProgressBar2.hwnd, "8B7500")
No codigo: Call ProgressBar_ForeColor(ProgressBar1.hwnd, "0000FF")
O "0000FF" Representa uma cor em HTML, essa representação de cor pode
ser encontrada em varios editores de imagem inclusive o Photoshop.
Lembrando: O Primeiro codigo representa a ProgressBar de baixo, e o segundo Representa a ProgressBar de Cima.