Criando um Autoupdater
3 participantes
Página 1 de 1
Criando um Autoupdater
1° Abra um novo projeto no VB, renomeie o form que ira aparecer para: AutoUpdate.
2° Abra o Form (AutoUpdate) como desing e adicione os seguintes controles:
Modifique as seguintes propriedades dos controles:
4° Aperte CRLT T e selecione os seguintes controles:
Clique em Aplicar.
Agora adicione os seguintes controles dentro do Form:
[Tutorial Codigo]
1° Vá no Menu View clique em Code. Ira aparecer uma janela de codigo, va na primeira linha e digite o seguinte:
[Configurando]
Bom.. Esta parte e um pouco complicada então leia com atenção para não ter nenhum problema.
1° Você precisa ter um Host, este sera ultilizado para guardar as
informações do update e os arquivos que seram baixados pelo mesmo.
2° No host crie um pasta chamada "update". Dentro dessa pasta crie os seguintes arquivos:
[/font]
3° O modelo do "Informacoes.ini" e este:
[Informacoes]
4° O modelo do "Atualizacoes.txt" e este:
Se você quiser colocar mais um arquivo e so colocar ele na proxima linha.
5° O modelo do "Noticias.txt" e um texto normal, para mostrar as informações das ultimas atualizações.
6° Depois de ja ter os arquivos de update configurados, você vai precisar mudar a URL no programa.
Procure no Form AutoUpdate:
7° No Form AutoUpdate se encontram duas Const, essas consts dependedo do valor ativa ou não certas opções.
8° A nova função da Source, a função que muda as cores das progressbars
são muito faceis de se ultilizar, primeiro e preciso procurar no
Form_Load as seguintes linhas:
Tabela de cores: Clique Aqui
2° Abra o Form (AutoUpdate) como desing e adicione os seguintes controles:
- Código:
1 Label
2 CommandButton
1 TextBox
Modifique as seguintes propriedades dos controles:
TextBox: name = txtPrincipal | multiline = True | scrollbars = 2 - Vertical.
Label: name = lblAtualização | appearance = 0 - Flat | backcolor = branco | borderstyle = 1 - Fixed Single.
CommandButton1: name = cmdPronto | caption = &Jogar
CommandButton2: name = cmdCancelar | caption = C&ancelar
4° Aperte CRLT T e selecione os seguintes controles:
Microsoft Internet Transfer Control 6.0 (SP6)
Microsoft Windows Common Controls 6.0 (SP6)
Clique em Aplicar.
Agora adicione os seguintes controles dentro do Form:
- Código:
Inet
2 ProgressBars
[Tutorial Codigo]
1° Vá no Menu View clique em Code. Ira aparecer uma janela de codigo, va na primeira linha e digite o seguinte:
- 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
[Configurando]
Bom.. Esta parte e um pouco complicada então leia com atenção para não ter nenhum problema.
1° Você precisa ter um Host, este sera ultilizado para guardar as
informações do update e os arquivos que seram baixados pelo mesmo.
2° No host crie um pasta chamada "update". Dentro dessa pasta crie os seguintes arquivos:
[/font]
Informacoes.ini
Atualizacoes.txt
Noticias.txt
3° O modelo do "Informacoes.ini" e este:
[Informacoes]
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
4° O modelo do "Atualizacoes.txt" e este:
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.
Se você quiser colocar mais um arquivo e so colocar ele na proxima linha.
5° O modelo do "Noticias.txt" e um texto normal, para mostrar as informações das ultimas atualizações.
6° Depois de ja ter os arquivos de update configurados, você vai precisar mudar a URL no programa.
Procure no Form AutoUpdate:
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.
7° No Form AutoUpdate se encontram duas Const, essas consts dependedo do valor ativa ou não certas opções.
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.
8° A nova função da Source, a função que muda as cores das progressbars
são muito faceis de se ultilizar, primeiro e preciso procurar no
Form_Load as seguintes linhas:
'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.
Tabela de cores: Clique Aqui
Re: Criando um Autoupdater
lol dessa vez vc me surpreendeu Thales!
+ 1 CRED
+ 1 CRED
spectrus- Administrador
- Mensagens : 299
Estrelas Makers : 1466
Creditos : 49
Data de inscrição : 01/01/2011
Idade : 30
Localização : V.da conquista bahia
Re: Criando um Autoupdater
eu fui tentar adicionar o Microsoft Internet Transfer Control 6.0 (SP6)
Microsoft Windows Common Controls 6.0 (SP6) so que não achei...
Microsoft Windows Common Controls 6.0 (SP6) so que não achei...
Uchiha- Estagiário
- Mensagens : 62
Estrelas Makers : 95
Creditos : 11
Data de inscrição : 03/07/2011
Localização : Vitoria Da Conquista - Ba
Tópicos semelhantes
» Autoupdater
» Eclipse Multiusos Autoupdater
» Eclipse Multi-purpose Autoupdater
» Criando seu jogo no EO
» Criando Animações GIF
» Eclipse Multiusos Autoupdater
» Eclipse Multi-purpose Autoupdater
» Criando seu jogo no EO
» Criando Animações GIF
Página 1 de 1
Permissões neste sub-fórum
Não podes responder a tópicos
|
|
Sex Dez 05, 2014 10:00 am por Fabio-3dgames
» Lost In Dreams chapter 01
Seg Nov 24, 2014 7:22 pm por slipknot
» A Makers Brasil ressuscitara em breve!!
Sáb Nov 01, 2014 2:26 pm por Francisco Souza
» Elysium Diamond 3.3.2
Sáb Nov 01, 2014 2:17 pm por Francisco Souza
» personagens e objetos 3d game builder
Seg Jul 28, 2014 2:33 pm por Reginaldo Aparecido Zanus
» fala galera \o obs auhsaush digita galera asygasyga
Dom Jul 06, 2014 1:40 am por anastiel
» tutorial headshot fps creator
Seg Jun 09, 2014 6:08 pm por EspinhosoGamer
» SnakeMod fps creator
Seg Jun 09, 2014 5:55 pm por EspinhosoGamer
» serial fps creator
Seg maio 26, 2014 7:35 pm por slipknot