Makers Brasil
Bem Vindos a Maker´s Brasil (um forum para criação de servidores 2D e 3D)Nos desejamos boa sorte no seu projeto!

Criando um Autoupdater

Ver o tópico anterior Ver o tópico seguinte Ir em baixo

Criando um Autoupdater

Mensagem por thales12 em Dom Jul 03, 2011 4:38 pm

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:
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, [Você precisa estar registrado e conectado para ver 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

thales12
Moderador
Moderador

Mensagens : 184
Estrelas Makers : 406
Creditos : 55
Data de inscrição : 22/03/2011
Idade : 22
Localização : Rio de Janeiro

http://www.rdmgames.tk

Voltar ao Topo Ir em baixo

Re: Criando um Autoupdater

Mensagem por spectrus em Dom Jul 03, 2011 5:03 pm

lol dessa vez vc me surpreendeu Thales!
+ 1 CRED


Divulgue nosso Forum!
[Você precisa estar registrado e conectado para ver este link.]
Código:
[url=http://makersbrasil.forumeiros.com/]
src="http://img841.imageshack.us/img841/9522/92324935.png"
border="0">[/url]



E meu fan? entao use:

Código:
[img]http://www.baixa.la/arquivos/3908525_imagem.gif[/img]

Sign:
Spoiler:




spectrus
Administrador
Administrador

Mensagens : 299
Estrelas Makers : 1466
Creditos : 49
Data de inscrição : 01/01/2011
Idade : 23
Localização : V.da conquista bahia

Voltar ao Topo Ir em baixo

Re: Criando um Autoupdater

Mensagem por Uchiha em Ter Jul 05, 2011 7:46 pm

eu fui tentar adicionar o Microsoft Internet Transfer Control 6.0 (SP6)
Microsoft Windows Common Controls 6.0 (SP6) so que não achei...

Uchiha
Estagiário
Estagiário

Mensagens : 62
Estrelas Makers : 95
Creditos : 11
Data de inscrição : 03/07/2011
Localização : Vitoria Da Conquista - Ba

Voltar ao Topo Ir em baixo

Re: Criando um Autoupdater

Mensagem por Conteúdo patrocinado Hoje à(s) 4:43 pm


Conteúdo patrocinado


Voltar ao Topo Ir em baixo

Ver o tópico anterior Ver o tópico seguinte Voltar ao Topo

- Tópicos similares

 
Permissão deste fórum:
Você não pode responder aos tópicos neste fórum