Atualizador FTP VB6

Option Explicit
 
'-------------------- Descrição das Variáveis do Sistema ----------------------
'
' NumArq%     Numero arquivo aberto
' AllData$    Usada de forma genérica (ler os parâmetros iniciais do sistema)
' DadosRec$   Receber os dados do servidor Ftp
' Porta%      Número da porta de comunicação de dados do servidor Ftp
' Lpos%       Qtde de bytes recebidos na porta de comunicação
' RespSv$     String de Resposta do Servidor (importante para tomada de decisão)
' Temp$       Variável de uso genérico temporário
' X&,K&       Variáveis inteiras usadas nos contadores e loops de forma genérica
' TipoDow%    Armazena o tippo do download a ser realizado para tomada de decisão
' DadosOk     Variável que armazena o estado da porta de dados do servidor
' NS% -       Contador para saber o número do servidor
' Linhas()    Usado para le linhas de texto de arquivos de textos externos. 
' Servidor()  Armazena o endereço dos servidores
' InetPort()  Armazena a porta usada no servidor (normalmente 21)
' User()      Armazena os Usuários
' Pass()      Armazena as passwords dos usuários
'
' ------------------------------------------------------------------------------
' Obs: Outras variáveis são utilizadas durante os diversos processos que
'      serão explicadas durante estes procedimentos. Determinei apenas 3 nós
'      para os arrays que guardam os dados dos servidores pois não juguei
'      necessidade para mais.
' ------------------------------------------------------------------------------
' São usados dois componentes Winsock (DataR e Inet) um para comunicação básica
' e o outro para fazer download de dados.
' --------------------------------------------------------------------------------------
' É importante frisar que parte destes códigos foram retirados de outras rotinas 
' encontradas na internet e adaptadas as minhas necessidades. 
' --------------------------------------------------------------------------------------
 
Dim AllData$, DadosRec$, Porta%, QtdV&, Lpos&, RespSv, Temp$, X&, K&
Dim Tipodow%, DadosOk As Boolean, NS%, NumArq%
Dim Linhas$(3), Servidor$(3), InetPort%(3), User$(3), Pass$(3)
 
Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
' Evento Keydown do formulário
'     Caso digite a tecla <esc> (codigo 27) sai do sistema
'     caso digite a tecla <f8> troca o servidor (dados armazenados nos Arrays)
 
    If KeyCode = 27 Then Unload Me
    If KeyCode = 119 Then MudaServidor
End Sub
 
Private Sub Form_Unload(Cancel As Integer)
' Saida do Form fecho os dois controles Winsocks caso estejam abertos
    Inet.Close
    DataR.Close
End Sub
 
Private Sub Form_Load()
 
 ' A Funções Pc(), OpenArq(), LeLinhas(), GravaLinha, Vlm() são de minha autoria.
 ' Pc() - Separa os dados contidos em uma linha através de um delimitador 
 '   [ Pc (Linha, Delimitador, Posição na linha) ].
 ' Vlm() - Parecido com o Val() só que analiza uma string e retorna o seu valor.
 ' OpeArq() - Abre um arquivo para leitura, gravação ou update 
 '   [ OpenArq (Arquivo, Tipo) ].
 ' LeLinhas - Le o arquivo até o seu final armazenando suas linhas na matriz 
 '   [ LeLinhas (NumArq, Matriz) ].
 ' GravaLinha - Grava no muero do arquivo o texto [ GravaLinha (NumArq, Texto) ].
 ' Outras funções estão contidas no modulo Funcoes mas seu estudo não se adequa ao
 ' momento.
 ' Eu as utilizo muito e é um resquicio da época em que fui programador em MUMPS
 ' Coloca o formulário principal no canto superior direito da tela e seta NS=1
 ' em seguida torna os botões VerfAtual e Atualiza desabilitados
 
 
    Me.Top = 0: Me.Left = 0: NS = 1
    VerfAtual.Enabled = False
    Atualiza.Enabled = False
 
' ------------------------------------------------------------------------------------
' Como uso o atualizador para um sistema com 6 subsistemas utilizo o comando TaskKill
' para destruir as janelas dos programas caso elas estejam ligadas. Tentei fazer isso
' com API´s mas não obtive sucesso.
' ------------------------------------------------------------------------------------
 
    Shell "taskkill /im contab.exe", vbMinimizedNoFocus
    Shell "taskkill /im receber.exe", vbMinimizedNoFocus
    Shell "taskkill /im pagar.exe", vbMinimizedNoFocus
    Shell "taskkill /im estoque.exe", vbMinimizedNoFocus
    Shell "taskkill /im vendas.exe", vbMinimizedNoFocus
    Shell "taskkill /im compras.exe", vbMinimizedNoFocus
    Shell "taskkill /im liberaepn.exe", vbMinimizedNoFocus
    Shell "taskkill /im hp-siac.exe", vbMinimizedNoFocus
 
    On Error Resume Next ' Caso ocorra algum erro durante este vai para o prox 
     
' Seto X=1 e abro o arquivo Servidores.Txt contido no dir da aplicação para leitura.
' Leio os dados contidos no arquivo e armazeno nos arrays.
' A Funções Pc(), OpenArq(), LeLinhas(), GravaLinha, Vlm() são de minha autoria.
 ' Pc() - Separa os dados contidos em uma linha através de um delimitador 
 '   [ Pc (Linha, Delimitador, Posição na linha) ].
 ' Vlm() - Parecido com o Val() só que analiza uma string e retorna o seu valor.
 ' OpeArq() - Abre um arquivo para leitura, gravação ou update 
 '   [ OpenArq (Arquivo, Tipo) ].
 ' LeLinhas - Le o arquivo até o seu final armazenando suas linhas na matriz 
 '   [ LeLinhas (NumArq, Matriz) ].
 ' GravaLinha - Grava no muero do arquivo o texto [ GravaLinha (NumArq, Texto) ].
 ' Outras funções estão contidas no modulo Funcoes mas seu estudo não se adequa ao
 ' momento.
 ' Eu as utilizo muito e é um resquicio da época em que fui programador em MUMPS
 
 ' Abre arquivo para leitura armazena em NumArq o numero
 ' Le todas as linhas do arquivo texto e armazena o numero de linhas em X
 
    NumArq = OpenArq(App.Path & "\Servidores.txt", 1)
    X = LeLinhas(NumArq, Linhas) 
         
' Le os dados contidos na matriz Linhas e as passa para os arrays individuais de 
' Servidor, porta, usuario e senha
 
    For K = 1 To X
        Servidor(K) = Pc(Linhas(K), "|", 1)
        InetPort(K) = Pc(Linhas(K), "|", 2)
        User(K) = Trim(Crip(Pc(Linhas(K), "|", 3)))
        Pass(K) = Trim(Crip(Pc(Linhas(K), "|", 4)))
    Next K
 
' Meu arquivo de servidores contem apenas 2 servidores. Existem Servidores de Ftp
 '  Grátis. No meu caso utilizo um servidor de Ftp que está em meu escritório
 ' (um notebook antigo). Meu outro servidor é da RedeHost e que é onde se encontra
 ' o meu site www.hp-sistemas.com.br (servidor de hospedagem paga com Ftp)
 '
 '                Servidores.Txt
 '                ftp16.redehost.com.br|21|·®ð©²§¥³ªµ¢|îåêëëèéã
 '                hp-sistemas.dyndns-ip.com|100|¹ª­|
 '
 ' O usuário e senha encontram criptografados. A criptografia e descriptografia é feita 
 ' pela função Crip()
 ' Uso a porta 100 em meu servidor, porque como de costume as operadoras bloqueiam a se 
 ' porta 21 para que os
 ' usuários não criem servidores em suas conexões ADSLs caseiras (o meu caso).
 ' Criei uma regra NAT em meu
 ' roteador para que desviasse todas as comunicções que chegam pela porta 100 para o Ip 
de meu servidor na
 ' porta 21 (porta usada para servidores FTP.
 
    Kill App.Path & "\hp-siac-exe.exe"
    NomeServ = Servidor(NS) & ":" & InetPort(NS)
 ' -------------------------------------------------------------------------------------
 ' Por ultimo elimino o arquivo Hp-Siac-Exe.Exe (Setup da atualização de meus sistemas 
feito no Inno Setup
 ' e coloco o nome do servidor que será utilizado na tela no Label NomeServ
 ' -------------------------------------------------------------------------------------
End Sub
 
 
Private Sub Form_Activate()
 
' No evento Form Activate Verifico o estado da conexão caso esteja fechada executo 
o procedimento de conexão
 
    If Inet.State = 0 Then CmdConecta_Click
End Sub
 
 
Private Sub CmdConecta_Click()
 
' Verifico o estado da conexão e estabeleço o protocolo, endereço servidor e porta.
' Em seguida conecto o servidor e coloco a variável DadosRec=""
' A verificação do processo de conexão se dará pelo evento Inet Connect.
 
    If Inet.State = 7 Then Exit Sub ' Caso o estado 7 (conectado) sai do procedimento
    Inet.Protocol = sckTCPProtocol
    Inet.RemoteHost = Servidor(NS)
    Inet.RemotePort = InetPort(NS)
    Inet.Connect
    DadosRec = ""
End Sub
 
Private Sub Inet_Connect()
 
' É importante que o programador que esteja lendo estas observações tenha uma noção 
dos comandos  de um servidor
' FTP. Aconselho tambem que instale um servidor FTP em uma máquina de sua rede para 
fazer os testes 
' (eu uso o  FileZilla Server que é uma excelente opção), procure na internet que 
irá encontrar bons tutoriais de
' como instalar e configurar o FTP Server.
' O comando DoEvents no início faz com que o usuário possa interagir com o Form 
mesmo que ele esteja
' processando uma conexão. Isto permite por exemplo que o usuário tente mudar a 
conexão para tentar
' outro servidor.
' O Evento Connect só ocorre se houver uma resposta do servidor diferente de 0 
(zero). o que significa
' que houve conexão ou que a mesma está em progresso. Caso esteja conectado (7), 
habilito os botões
' CmdConecta, VerfAtual, Atualiza e coloco a cor verde no label Status com a 
mensagem Conectado.
' Em seguida executo os procedimento EnvCmd Que enviam:
' O nome do usuário; "USER"
' A senha do usuário; "PASS"
' e a troca do diretório para "atual" (é neste diretório dos Ftps que se 
encontram mesus arquivos); "CWD"
' Caso não ocorra a conexão mostra no status o estado da mesma em cor 
vermelha que é a cor default
' do componente.
' Caso ocorra um erro durante a conexão será disparado o evento Inet 
Error e será dado uma mensagem
 
    Status = "Conectando..."
    DoEvents
    If Inet.State = 7 Then
        CmdConecta.Enabled = False
        VerfAtual.Enabled = True
        Atualiza.Enabled = False
        VisuTxt.Enabled = False
        Status.ForeColor = &HFFFFC0 ' cor verde
        Status = "Conectado"
        EnvCmd "USER", Trim(User(NS))
        EnvCmd "PASS", Trim(Pass(NS))
        EnvCmd "CWD", "atual"
    Else
        Status = "Estado da conexao: " & Inet.State
    End If
End Sub
 
 
 
Private Sub VerfAtual_Click()
 
' Dimensiono as varáveis Num e Linha que guardarão o numero do arquivo e a 
linha lida usando a função OpenArq.
' Em seguida atribuo ao label Mens (label usado no corpo do Form para passar 
mensagem ao usuário), o valor em
' branco e as variáveis DadosOk=false e TipoDown=1 (uso duas formas de 
download do Ftp 1 - dados de texto e
' 2 - dados binários. Neste caso irei fazer o download de 2 arquivos de texto.
' Em sequencia Apago do diretório da aplicação o arquivo UpdtHp.New que é 
um arquivo de texto de controle e
' atribuo Temp="" (esta variável é usada no evento DataR DataArrival para 
armazenar os dados retornados no
' de dados de texto.
 
    Dim Num%, Linha$
    Mens = ""
    DadosOk = False
    Tipodow = 1
 
' O procedimento ExecCmd substitui o comando Shell. A sua utilização se explica 
pois o Shell é um comando
' assincrono, ou seja, não possuo um controle de quando terminou a execução do 
comando enquanto o procedimento
' ExecCmd é sincrono e o sistema aguarda a execução completa do comando externo.
' Não é de minha autoria e infelizmente não sei o Autor para colocar os devidos 
créditos.
 
    ExecCmd "del c:\hp-siac\updthp.new /f"
    Temp = ""
     
' Usando o Procedimento EnvCmd, envio os comandos "PASV" entrar no modo passivo 
(ideal para download) e "RETR"
' para ler o arquivo no servidor. O retorno virá na variável Temp com o texto 
arquivo que irei gravar no dire-
' tório da aplicação e mostrar no label Mens as atualizações disponíveis do 
sistema.
' Em seguida usando a mesma sequencia de comando leio o arquivo 
Alteracoes.txt onde tenho um texto com o histó-
' rico das alterações do sistema.
 
    EnvCmd "PASV"
    EnvCmd "RETR", "updthp.new"
    Num = OpenArq("c:\hp-siac\updthp.new", 2)
    GravaLinha Num, Temp
    Mens = Temp
    Temp = ""
    EnvCmd "PASV"
    EnvCmd "RETR", "Alteracoes.txt"
    Num = OpenArq("c:\hp-siac\alteracoes.txt", 2)
    GravaLinha Num, Temp
 
' Envio o comando "size" para pegar o tamanho do arquivo que irei fazer o 
download (hp-siac-exe.exe) e em segui-
' desabilito o botão VerfAtual e Habilito o Atualiza e VisuTxt
 
    EnvCmd "size", "hp-siac-exe.exe"
    VerfAtual.Enabled = False
    Atualiza.Enabled = True
    VisuTxt.Enabled = True
End Sub
 
Private Sub Atualiza_Click()
' Dimensiono uma variável para data do sistema alimento com a data 
do computador.
' Primeiro verifico a existência do arquivo Update.Txt no 
diretório c:\hp-siac (diretório de minha aplicação).
' Caso não exista efetuo os procedimentos de atualização.
' Caso leio a primeira linha dos arquivos UpdtHp.new e Update.txt 
(que após a atualização ficam iguais), para
' verificar a data do arquivo e se o sistema já está atualizado. 
Caso esteja saio da atulização dando a
' mensagem "O seu sistema já esta atualizado !".
 
    Dim Data1 As Date, Data2 As Date, Num%, Ql%, Plin1$, Plin2$
    If Dir("c:\hp-siac\Update.txt", vbArchive) <> "" Then
        Num = OpenArq("c:\hp-siac\UpdtHp.new", 1)
        Ql = LeLinhas(Num, Plin1, 1)
        Num = OpenArq("c:\hp-siac\Update.Txt", 1)
        Ql = LeLinhas(Num, Plin2, 1)
        If DateValue(Pc(Plin1, "#", 2)) <= DateValue(Pc(Plin2, "#", 2)) Then
            MsgBox "O seu sistema já esta atualizado !", 48
            Exit Sub
        End If
'   do contrário significa que o sistema está desatualizado. Grava o 
ceonteudo de Mens em Update.txt
    Else
        Num = OpenArq("c:\hp-siac\Update.Txt", 2)
        GravaLinha Num, Mens
    End If
 
' Desabilita o botão Atualiza torna vísivel a barra de progresso do 
download e seu valor zero exibe a mensagem
' "Fazendo download do arquivo...", abre o arquivo no modo binário, 
posiciona o contador de bytes (Lpos=1),
' Estabelece o Tipo de download (tipodown=2) e envia os comandos de 
download do arquivo. A partir daqui o con-
' trole passa para o evento DataArrival (chegada de dados).
 
    Atualiza.Enabled = False
    DadosOk = False
    Pbar.Visible = True
    Pbar.Value = 0
    Mens = "Fazendo download do arquivo..."
    Close #1
    Open "hp-siac-exe.exe" For Binary As #1
    Lpos = 1
    Tipodow = 2
    EnvCmd "PASV"
    EnvCmd "RETR", "hp-siac-exe.exe"
End Sub
 
Function EnvCmd(Comando$, Optional Arg1$, Optional Arg2$)
' Função de envio de comandos. O Servidor de Ftp processa os comandos 
na medida em que rece-
' o final da linha (VbCrLf) [Chr(13)+Chr(10)].
' Alguns destes comandos podem ter até mais de dois argumentos 
(no meu caso só preciso de 2)
' estes comandos devem ser inseridos em uma string finalizada 
por (vbCrLf) e enviados com SendData.
' Em seguida fico esperando a resposta do servidor que deve 
vir na variável RespSv tratada no evento
' DataArrival.
 
    Dim Linha$
    If Arg1 <> "" Then Arg1 = " " & Arg1
    If Arg2 <> "" Then Arg2 = " " & Arg2
    Linha = UCase(Comando) & Arg1 & Arg2 & vbCrLf
    RespSv = ""
    Inet.SendData Linha
    Do
        DoEvents
    Loop Until RespSv <> ""
End Function
 
Private Sub Inet_DataArrival(ByVal bytesTotal As Long)
 
' Este evento ocorre quando há uma chegada de dados pela porta 
do servidor (normalmente 21). Aqui é feita uma
' série de tomada de decisões conforme a resposta do servidor. 
Enviado ao corpo do programa através da variável
' RespSv.
' Dimensiono a Variável Parte que irá guardar a string de 
retorno do servidor. Nesta string as vezes contêm mais
' dados do que necessito, então preciso tratar a mesma para 
extrair o conteúdo necessário a tomada de decisões.
' Normalmente a resposta é um numero, o ifem e um texto 
(ex: "226 - Data Tranfer Ok").
' o Label TxtLog é mostrado na parte inferior do form e 
traz as respostas do servidor, toda vez que alcança o
' tamanho de 1024 caracteres ele é zerado (seu conteúdo 
é apenas informativo).
 
 
    Dim Parte$
    If Len(TxtLog) > 1024 Then TxtLog = ""
 
' Uso o procedimento GetData para armazenar a resposta do 
servidor e a função Instr() para analize do conteúdo
 
    Inet.GetData RespSv, vbString
     
'  Quando é dado o comando "RETR" para fazer download de 
um arquivo o servidor retorna uma mensagem com 
‘  o código 227 e com um texto com um número 2 bytes 
contendo a portas de comunicação de dados que serão usados
‘  pelo controle DataR (winsock) para fazer o download do arquivo. 
‘  Neste momento o servidor Ftp abriu uma porta e está
'  esperando uma conexão na mesma. Em seguida uso o 
procedimento Connect para conectar a esta porta. Caso a 
'  conexão seja feita começará o download do arquivo e o 
controle passará para o evento DataArrival do DataR.
 
    If InStr(RespSv, "227 ") <> 0 Then
        Parte = RespSv
        Porta = (Val(Pc(Parte, ",", 5)) * 256) + 
Val(Pc(Parte, ",", 6)) ' 5a e 6a parte da resposta Usando "," delim.
        DataR.Close                        ' Fecha a conexão caso aberta
        DataR.Connect Servidor(NS), Porta  ' Conecta na porta informada
    End If
 
' Resposta "227" Download concluido
 
    If InStr(RespSv, "226 ") <> 0 Then
        If Tipodow = 2 Then Mens = "Download Concluido !"
    End If
 
' Resposta "213" Tamanho do arquivo (resposta do comando "Size")
 
    If InStr(RespSv, "213 ") <> 0 Then
        TamFile = Format(Val(Pc(Mid(RespSv, InStr(RespSv, "213") + 3, 
50), vbLf, 1)), "#,###,###,###")
        Pbar.Max = Vlm(TamFile)
        Pbar.Min = 0
    End If
 
' Resposta "220" textos de comentários do servidor (sem valor lógico 
apaenas informativo)
 
    If InStr(RespSv, "220 ") <> 0 Then Exit Sub
    TxtLog = TxtLog & RespSv
End Sub
 
Private Sub Inet_Error(ByVal Number As Integer, Description As String, 
ByVal Scode As Long, ByVal Source As String, ByVal HelpFile As String, 
ByVal HelpContext As Long, 
CancelDisplay As Boolean)
 
' Este evento ocorre se houver um erro na conexão com o servidor. 
Caso ocorra mostra a mensagem com o erro e
' volta o controle para o estado inicial do programa onde o usuário 
pode tentar trocar de servidor ou tentar
' uma nova conexão.
 
    MsgBox "Erro: " & Number & ". Descricao: " & Description, 48
    Status = "Erro Conexão": Status.ForeColor = vbRed
    TxtLog = ""
    CmdConecta.Enabled = True
    Inet.Close
    DataR.Close
End Sub
 
Private Sub DataR_Connect()
' Mostra o estado da conexão de dados
    If DataR.State = 7 Then Status = "Dados Conectados"
End Sub
 
Private Sub DataR_DataArrival(ByVal bytesTotal As Long)
' Este evento é disparado toda vez que inicia o download de arquivo comando "RETR".
    Dim buffer$
    Select Case Tipodow ' case para o tipo de download
    Case 1
        DataR.GetData buffer, vbString 
' Leitura dos dados na porta no formato string
        Temp = Temp + buffer           
' Armazenamento cumulativo desta respota em Temp
    Case 2
        If DataR.State <> 8 Then
            Dim bData() As Byte
            DataR.GetData bData        
' Leitura dos dados no formato binário (byte a byte)
            Put #1, Lpos, bData        
' gravação no arquivo #1 (hp-siac-exe.exe)
            Lpos = Lpos + UBound(bData) + 1 
' Controle do numero de bytes recebidos
            Pbar.Value = (Lpos - 1)         
' Incremento da barra de progesso
            BytesRec = Format((Lpos - 1), "#,###,###,###")
                                 ' Display dos bytes recebidos
        End If
    End Select
    If Tipodow = 2 And BytesRec = TamFile Then
 ' Caso o numero de bytes seja do tamanho do arquivo o download foi concluido
        Close #1
        DadosOk = True
    End If
End Sub
 
Private Sub Timer_Timer()
 
' Como a leitura de dados acontece de forma assincrona é necessário 
ter a exata noção do momento em que
' o download foi concluido, em se tratando do arquivo binário 
(hp-siac-exe.exe), pois é um arquivo a ser
' executado para fazer a atualização do sistema.
' O evento Timer testa a variável DadosOk que só é colocada como 
True no momento em que o download é concluido.
' Então é feita a execução  dos diversos comandos necessários à atualização.
 
    If Not DadosOk Then Exit Sub
    ExecCmd App.Path & "\hp-siac-exe.exe /verysilent" 
    ExecCmd "del c:\hp-siac\Update.Txt"
    ExecCmd "Xcopy c:\hp-siac\updthp.new c:\hp-siac\Update.Txt /y"
    DoEvents
    Mens = "ATUALIZAÇÂO EXECUTADA COM SUCESSO !!"
    Timer.Enabled = False
    Timer.Interval = 0
End Sub
 
Sub MudaServidor()
' Procedimento de mudança do servidor onde cada vez que é executado 
incrementa a variável NS
' e tenta conectar com o servidor
 
    If Inet.State = 7 Then
        EnvCmd "quit"                            ' Comando de saida do servidor FTP
    End If
    Mens = ""                                    ' Zera as variáveis e labels
    Status = ""
    TxtLog = ""
    Inet.Close
    DataR.Close
    CmdConecta.Enabled = True                    ' Habilita Controles
    VerfAtual.Enabled = True
    Atualiza.Enabled = True
    NS = NS + 1: If NS = 4 Then NS = 1           ' Incrementa NS
    NomeServ = Servidor(NS) & ":" & InetPort(NS) ' Mostra o nome do servidor
    CmdConecta_Click                             ' Executa procedimento de conexão
End Sub
 
Private Sub VisuTxt_Click()
' --------------------------------------------------------------------------
' Chama o Form Altera onde mostra o conteúdo do arquivo Alteracoes.txt
' --------------------------------------------------------------------------
    Altera.Show
End Sub