PC Toledo

Código: Selecionar todos

Function HttpGetFile( cUrl, cFile, pProgress )
    Local socket
    Local host
    Local port := 80
    Local query
    Local cbuffer := space(BUFFER)
    Local cString := ""
    Local cReply
    Local nCount
    Local nHandle
    Local result := .f.
    Local nLength

    host  := substr( cUrl, 8 )
    query := substr( host, at("/", host) )
    host  := Left( host, at("/", host) - 1)

    cReply := "GET " + query + " HTTP/1.1 " + CRLF +;
              "Connection: Keep-Alive" + CRLF + ;
              "User-Agent: Mozilla/3.0 (compatible Harbour)" + CRLF +;
              "Host: " + host + CRLF +;
              "Accept: */* " + CRLF + CRLF

    InetInit()
    socket := InetConnect( host, port )
    InetSetTimeout( socket, 1000 )

    if InetErrorCode( socket ) == 0
        InetSendAll( socket, cReply )

        do while InetDataReady( socket, 100 ) == 0
        enddo

        nCount := InetRecvAll( socket, @cBuffer, BUFFER )
        cString := left(cBuffer, nCount)

        if "200 OK" $ cString
            nHandle := FCreate(cFile)

            if nHandle != -1
                nLength := substr( cString, at( "Content-Length:", cString ) + 16 )
                nLength := left( nLength, at( CRLF, nLength) -1 )
                nLength := val(nLength)

                cString := substr( cString, at( "Content-Type:", cString ) )
                cString := substr( cString, at( CRLF, cString) + 4 )
                FWrite( nHandle, cString )

                nCount := Len(cString)
                nLength -= nCount

                do while nLength > 0
                    cBuffer := Space(BUFFER)

                    if ! ISNIL(pProgress)
			gtk_progress_bar_pulse(pProgress)
                    endif

                    nCount := InetRecvAll( socket, @cBuffer, BUFFER )

                    if nCount == 0
                        nCount := nLength
                    endif

                    cString := left(cBuffer, nCount)
                    FWrite( nHandle, cString )

                    nLength -= nCount
                enddo

                InetClose( socket )
                FClose( nHandle )
                result := .t.
            endif
        else
            InetClose(socket)
        endif
    endif

Return result

Código: Selecionar todos

#include "hwgui.ch"
#include "common.ch"
#include "Directry.ch"

FUNCTION MAIN

   Donwload_File("/caminho/bin/sistema,"sistema.zip","update\SISTEMA.ZIP")       // Aqui é do EXECUTAVEL compactado

RETURN

************************************************
PROCEDURE Donwload_File(ftpdir,ftpfile,fdestino)
************************************************
Local cURL, cSaveAs, nFileSize
Local vBaixa :="N"
Private oBar,oDlg,oFont,nSize, oConn

cURL := "http://www.sygecom.com.br"+ftpdir+"/"+ftpfile

Private oDlgHabla:=nil
MsgRun("Aguarde Procurando Atualizações...")

cFILE_VERSAO:=GERAFILE()+".txt" // nome temporario
cURL_VERSAO:="http://www.sygecom.com.br"+ftpdir+"/versao.txt"
nFileSize := Get_File_Size(cURL_VERSAO)
TRY
  oConn := TipClientHttp():New(TURL():New(cURL_VERSAO))
  oConn:nConnTimeout := 20000
  oConn:nDefaultPort := 80
  IF oConn:Open(cURL_VERSAO)
     oConn:ReadToFile(cFILE_VERSAO,,nFileSize)
     oConn:Close()
  ENDIF
CATCH
  Fim_Run()
  MsgStop("Erro ao Tentar baixar a atualização, Favor tente mais tarde","Aviso do Sistema")
  Return
END

HAND=FOPEN(cFILE_VERSAO)
VERSAODISP=FREADSTR(HAND,4) // Le os 4 primeiros bytes do aquivo baixado para fazer a comparação de versão
FCLOSE(HAND)

IF VAL(VERSAODISP) > VAL(right(GETFILEVERSIONINFO(),4))
   vBaixa="S"
ENDIF

IF vBaixa="S"
   Fim_Run()
   IF MsgYesNo("Há uma Nova Atualização Disponivel, deseja Atualizar Agora ?","Atualização do Sistema")

      vAguarda := 20
      Private oDlgHabla:=nil
      MsgRun("O Sistema vai Fechar as Outras estações em: " +str(vAguarda)+ " Segundos...")
      // fecha_estacao()  // aqui roda uma rotina para fechar as outras estações aberta
      for nI:=1 to vAguarda // quantidade de segundos a aguardar
         MilliSec( 1000 )
         HW_Atualiza_Dialogo2("O Sistema esta fechando as outras estação em: "+ alltrim(STR(vAguarda-nI)) +" Segundos...")
      next
      Fim_Run()

      Aguarde("Baixando Atualizações do sistema:","Aguarde Baixando arquivos...")
      cTamanho := Get_File_Size(cURL)

      TRY
        oConn := TipClientHttp():New(TURL():New(cURL))
        oConn:nConnTimeout := 20000
        oConn:nDefaultPort := 80
        oConn:exGauge := { | done, size| ShowGauge(done, size, cTamanho, ftpfile ) }

        IF oConn:Open(cURL)
           oConn:ReadToFile(fdestino,,nFileSize)
           oConn:Close()
        ENDIF
      CATCH
        MsgStop("Erro ao Tentar baixar a atualização, Favor tente mais tarde","Aviso do Sistema")
      END

      vEXT_ARQ  := Subs(ftpfile,RAT(".",ftpfile)+1)

      IF Lower(vEXT_ARQ)="zip"
         Millisec(1000)  // espera um pouco antes de começar a descompactar
         aDir1 := curdrive()+":\"+rtrim(curdir()) + "\update\"   // salva aonde
         aDir2 := curdrive()+":\"+rtrim(curdir()) + "\update\" + ftpfile
         MyRun("deszip.exe " + aDir2 + " " + aDir1 +" senha" )
         //FOCALIZA_APP()  //volto o foco para a aplicação
         Ferase(aDir2)
      endif

      oDlg:Close()
   Endif
ENDIF
Fim_Run()
RETURN

****************************************************
Procedure ShowGauge( nSent, nSize, wTotal, ftpfile )
****************************************************
IF nSent > 0
   hwg_processmessage()
   eval( {||oBar:Set(,(nSent/wTotal)*100),.t.} )
   @ 50,120 say "Arquivo...: " +ftpfile+" "+ STR(nSent)+" Byts de: " + str(wTotal)+ " Byts "+str((nSent/wTotal)*100,4) +" %" SIZE 500,22;
   COLOR x_BLUE
ENDIF
RETURN

*****************************
Procedure Aguarde(vTIT,vMENS)
*****************************
PREPARE FONT oFont NAME "MS Sans Serif" WIDTH 0 HEIGHT -20
INIT DIALOG oDlg TITLE vTIT AT 45,30 SIZE 600,210 NOEXIT STYLE DS_CENTER + WS_VISIBLE
@ 50,20 say vMENS  size 300,40 Font oFont
@ 50,60 PROGRESSBAR oBar OF oDlg SIZE 510,50 BARWIDTH 10000
oDlg:Activate(.t.)

***************************
Function Get_File_Size(cURL)
***************************
LOCAL cBuffer, cRequest, cResponse, nBytes, pSocket, aRequest
LOCAL crlf := CHR(13)+CHR(10), Result := 0, oUrl
// initialize sockets system and connect to server
DEFAULT cURL:=""
oUrl := tURL():New( cUrl )
IF Empty( oUrl )
   Return 0
ENDIF
IF Lower( oUrl:cProto ) <> "http"
   Return 0
ENDIF

INetInit()
pSocket := INetConnect( oUrl:cServer, 8080 )

IF INetErrorCode( pSocket ) <> 0
   ? "Socket error:", INetErrorDesc( pSocket )
   INetCleanUp()
   RETURN 0
ENDIF

crlf := INETCRLF()

// send HTTP request to server
cRequest := "HEAD "+oUrl:BuildAddress() + " HTTP/1.1" + CRLF + ;
            "Host: "+oUrl:cServer+ CRLF + ;
            "User-Agent: HTTP-Get-File-Size" + CRLF + ;
            "Connection:close" + CRLF + ;
             CRLF
nBytes   := INetSend( pSocket, cRequest )
cBuffer  := Space(4096)
cResponse:= ""

// get HTTP response from server
DO WHILE ( nBytes > 0 )
   nBytes    := INetRecv( pSocket, @cBuffer )
   cResponse += Left( cBuffer, nBytes )
   cBuffer   := Space(4096)
ENDDO

// disconnect and cleanup memory
INetClose( pSocket )
INetCleanUp()

aRequest := HB_ATokens(cResponse, CRLF)
clear
nAt := Ascan(aRequest,{|x|LEFT(LTRIM(X),15)="Content-Length:"})
IF nAt>0
   Result := VAL(SUBSTR(aRequest[nAt],17))
ENDIF
RETURN RESULT