Caros colegas.
Existe alguma funcao do xHarbour para baixar e subir arquivos? Algo que seja silencioso. Não serve via FTP. Já usei e nao gostei do resultado.
Algo que me possibilite, por exemplo, baixar uma versao mais nova do meu sistema diretamente do meu site, e que possa trabalhar em segundo plano, para que nao atrapalhe o usuario no seu trabalho diário.
Se não existir nada assim no xharbour, tambem me interesso em outras possibilidades, tipo alguma lib que tenha o recurso, ou mesmo outra linguagem, ou talvez um software externo.
Aguardo ancioso por uma luz no fim do nutel. Obrigado.
Download e Upload
Moderador: Moderadores
-
TerraSoftware
- Usuário Nível 3

- Mensagens: 353
- Registrado em: 28 Jul 2004 13:14
- Localização: Cianorte-PR
- Contato:
Re: Download e Upload
O XHarbour, que eu saiba, tem a série de (várias) funções INet pra manipulação de sockets. Quanto a software externo, existe a biblioteca WAPI, que usa HTTP (API WinINet) pra download.
[]'s
Maligno
---
Não respondo questões técnicas através de MP ou eMail. Não insista.
As dúvidas devem ser postadas no fórum. Desta forma, todos poderão
se beneficiar das respostas.
---
Se um dia precisar de uma transfusão de sangue você perceberá como
é importante a figura do doador. Procure o hemocentro de sua cidade e
se informe sobre a doação de sangue, plaquetas e medula óssea. Doe!
Maligno
---
Não respondo questões técnicas através de MP ou eMail. Não insista.
As dúvidas devem ser postadas no fórum. Desta forma, todos poderão
se beneficiar das respostas.
---
Se um dia precisar de uma transfusão de sangue você perceberá como
é importante a figura do doador. Procure o hemocentro de sua cidade e
se informe sobre a doação de sangue, plaquetas e medula óssea. Doe!
Re: Download e Upload
Olá,
Veja se a rotina baixo te ajuda. É o que eu uso para baixar atualizações do meu sistema:
[]'s
Rodrigo
Veja se a rotina baixo te ajuda. É o que eu uso para baixar atualizações do meu sistema:
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
Rodrigo
Re: Download e Upload
Olá a todos,
Temos um sistema de envio e recepção de arquivo, usando funçoes do harbour: tIPClienteHTTP, metodo :post
Com o uso de proxy na empresa o mesmo deixou de funcionar.
Como fazer o harbour fazer uso de proxy ?
Existe outras funcoes para isso?
Abraços,
Heveraldo
Temos um sistema de envio e recepção de arquivo, usando funçoes do harbour: tIPClienteHTTP, metodo :post
Com o uso de proxy na empresa o mesmo deixou de funcionar.
Como fazer o harbour fazer uso de proxy ?
Existe outras funcoes para isso?
Abraços,
Heveraldo
- sygecom
- Administrador

- Mensagens: 7131
- Registrado em: 21 Jul 2006 10:12
- Localização: Alvorada-RS
- Contato:
Re: Download e Upload
Para enviar as atualizações para o meu servidor ainda uso o FTP do xHarbour mesmo e até hoje tem atendido muito bem
Eu uso essa abaixo para atualizar meus sistemas:
Exexemplo de uso:
Eu uso essa abaixo para atualizar meus sistemas:
Exexemplo de uso:
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 RESULTLeonardo Machado
xHarbour.org + Hwgui + PostgreSql
xHarbour.org + Hwgui + PostgreSql
- 09466261000176
- Usuário Nível 1

- Mensagens: 39
- Registrado em: 19 Mar 2014 15:50
- Localização: lorena sp

