Download de arquivo usando proxy

[asimoes]

Pessoal,

Existe algum exemplo de download de arquivo usando proxy?

[asimoes]

A pergunta é como baixar este zip usando o objeto WinHttpRequest ?
A função me retorna o número de bytes do arquivo, mas como salvar ?

Código: Selecionar todos

FUNCTION MAIN
LOCAL cURL := "http://harbour.github.io/art/harbour-ico.zip"
 IF ( oHTTP := win_oleCreateObject( "WinHttp.WinHttpRequest.5.1" ) ) != NIL
      oHTTP:Open( "GET", cURL, .F. )
      //oHTTP:SetProxy(2, "proxy:8080") 
      oHTTP:Send()
      IF oHTTP:Status() == 200
         ? "Downloaded", hb_ntos( hb_BLen( oHTTP:responseBody ) ), "byte(s)"
      ENDIF
   ELSE
      ? "Error: WinHttp 5.1 not available. [" + win_oleErrorText() + "]"
   ENDIF
inkey(0)

[JoséQuintas]

Não sei se alterou isto apenas pra debug

Código: Selecionar todos

? "Downloaded", hb_ntos( hb_BLen( oHTTP:responseBody ) ), "byte(s)"

Está mostrando o tamanho do que foi recebido.
O conteúdo está em oHttp:ResponseBody

[asimoes]

E como salvar o arquivo lembrando que o zip é tipo binário

[JoséQuintas]

Depende do formato disso, pode ser:
Uma única String
Byte Array: é um array com código Ascii (números)

Código: Selecionar todos

IF ValType( oHttp:ResponseBody ) == "C"
   hb_MemoWrit( "arquivo.zip", oHttp:ResponseBody )
ELSE
   nHandle := fCreate( "arquivo.zip" )
   FOR EACH nAscii IN oHttp:Responsebody // FOR nCont = 1 TO Len( oHttp:ResponseBody )
      fWrite( nHandle, Chr( nAscii ) )
   NEXT
   FClose( nHandle )
ENDIF

Só como dica, pode precisar descobrir sozinho outras coisas:
Testando o tipo de variável ValType( oHttp:ResponseBody )
Só decidir o que fazer.

[asimoes]

Quintas,

O seu exemplo funcionou.

Eu tinha achado esse outro exemplo no google mas não deus certo:

Código: Selecionar todos

adTypeBinary := 1
adSaveCreateOverWrite := 2
BinaryStream := win_oleCreateObject("ADODB.Stream")
BinaryStream:Type := adTypeBinary
IF ( oHTTP := win_oleCreateObject( "WinHttp.WinHttpRequest.5.1" ) ) != NIL
   oHTTP:Open( "GET", cURL, .F. )
   //oHTTP:SetProxy(2, "proxy:8080") 
   oHTTP:Send()
   IF oHTTP:Status() == 200
      ? "Downloaded", hb_ntos( hb_BLen( oHTTP:responseBody ) ), "byte(s)"
      cTeste:=oHTTP:responsebody
      BinaryStream:Open()
      BinaryStream:Write(cTeste)
      BinaryStream:SaveToFile("teste.zip", adSaveCreateOverWrite)
   ENDIF
ENDIF   

Tentei adaptar deste exemplo mas dá erro no método write

Código: Selecionar todos

Sample 2:

;***************************************************************************
;**
;**  Code to download a binary file using  WinHttp.WinHttpRequest.5.1 and ADODB.Stream
;**
;***************************************************************************

#DefineFunction SaveBinaryData(FileName, ByteArray)
  adTypeBinary = 1
  adSaveCreateOverWrite = 2
  ;Create Stream object
  BinaryStream = ObjectCreate("ADODB.Stream")
  ;Specify stream type - binary data.
  BinaryStream.Type = adTypeBinary
  ;Open the stream And write binary data To the object
  BinaryStream.Open
  BinaryStream.Write(ByteArray)
  ;Save binary data To disk
  BinaryStream.SaveToFile(FileName, adSaveCreateOverWrite)
  BinaryStream = 0
  Return
#EndFunction

; Instantiate a WinHttpRequest object.
WinHttpReq = ObjectCreate("WinHttp.WinHttpRequest.5.1")
; Initialize an HTTP request.
WinHttpReq.Open("GET", "http://files.winbatch.com/wwwftp/wb01/wwctl44i.zip", @FALSE)
; Send the HTTP request.
WinHttpReq.Send()
; Display the response text.
ByteArray =  WinHttpReq.ResponseBody
SaveBinaryData("d:\temp\wwctl44i.zip", ByteArray)
; Clean up
WinHttpReq  = 0
Exit

[JoséQuintas]

Nessa parte mais prático usar o recurso do Harbour do que ADO.

Não sei se a rotina com ADO está certa, mas por acaso o motivo foi porque não achou o arquivo salvo?
Quando se está usando API do Windows, tem que lembrar que a API não conhece a pasta atual.
Teria que passar o PATH completo.

Mas tem diversas formas de baixar o arquivo, essa é só uma delas.

Aqui uso outro controle ao invés desse, mas o jeito de usar é o mesmo

Código: Selecionar todos

      oSoap := Win_OleCreateObject( "MSXML2.ServerXMLHTTP" )

Não lembro mais porque optei por este.
Mas é o mesmo que uso no webservice da Sefaz.
Aqui uso pra atualizar meu aplicativo on-line, em qualquer versão de Windows.
Deixe como anotação no seu fonte, vai que a Microsoft bloqueia um deles, já tem o outro anotado.

[asimoes]

Quintas,

Dava erro no método write do adodb.stream. Ai a sua solução resolveu, o principal também é que o setproxy, funcionou onde vai rodar a rotina.

[asimoes]

Quintas,

Olha o que eu achei na pasta package do harbour:
Atualização de hoje.

Veja o arquivo:
getmingw.hb

O que eu achei interessante foi esta função dentro deste .hb com detalhe para o adodb.stream

Código: Selecionar todos

STATIC FUNCTION dl_file( cURL, cFileName )

   LOCAL lSuccess
#if defined( __PLATFORM__WINDOWS )
   LOCAL tmp
   LOCAL cScript
   LOCAL cJS
#endif

   IF hb_processRun( ;
         "curl " + ;
         "-fsS " + ;
         "-o " + FNameEscape( cFileName ) + " " + ;
         "-L --proto-redir =https " + ;
         Chr( 34 ) + StrTran( cURL, " ", "%20" ) + Chr( 34 ) ) >= 0

      RETURN .T.
   ENDIF

   lSuccess := .F.

#if defined( __PLATFORM__WINDOWS )

#pragma __cstream | cJS := %s
var http = new ActiveXObject("WinHttp.WinHttpRequest.5.1");
http.Open("GET", "%1$s", false);
http.Send();
if(http.Status() == 200) {
   var f = new ActiveXObject("ADODB.Stream");
   f.type = 1; f.open(); f.write(http.responseBody);
   f.savetofile("%2$s", 2);
}
#pragma __endtext

   hb_vfClose( hb_vfTempFile( @cScript,,, ".tmp" ) )

   IF hb_MemoWrit( cScript, ;
         hb_StrFormat( cJS, ;
            cURL, ;
            StrTran( cFileName, "\", "\\" ) ) )

      IF hb_processRun( "cscript" + ;
            " //nologo" + ;
            " /e:jscript" + ;
            " " + FNameEscape( cScript ),, @tmp, @tmp ) == 0
         lSuccess := .T.
      ENDIF
   ENDIF

   hb_vfErase( cScript )
#endif

   RETURN lSuccess

[asimoes]

Um bom exemplo com Java script

[JoséQuintas]

rotina ADO dela

Código: Selecionar todos

var f = new ActiveXObject("ADODB.Stream");
f.type = 1; f.open(); f.write(http.responseBody);
f.savetofile("%2$s", 2);

em Harbour

Código: Selecionar todos

f := win_OleDbCreateObject( "ADODB.Stream" )
f:Type := 1
f:Open()
f:Write( oHttp:ResponseBody )
f:SaveToFile( "nomearquivo", 2 )

Aliás, tem a rotina completa usando winhttp.
Estamos usando uma "classe" instalada no Windows.
Estamos usando as "funções" dentro da classe, por isso os nomes são iguais, não importa a linguagem de programação.

[asimoes]

Quintas,

Com harbour dá o erro no f:write()

[asimoes]

Com o script java funciona.

[asimoes]

Aproveitando, fiz esta função que funcionou.

Código: Selecionar todos

#include "hbcompat.ch"
FUNCTION Download()
LOCAL cURL := "http://harbour.github.io/art/harbour-ico.zip"
LOCAL cArq := "harbour-ico.zip"

   IF dl_file( cURL, cArq )
      RETURN .T.
   ENDIF
   
RETURN Nil

FUNCTION dl_file( cURL, cFileName )

LOCAL lSuccess
#if defined( __PLATFORM__WINDOWS )
   LOCAL tmp
   LOCAL cScript
   LOCAL cJS
#endif

#pragma __cstream | cJS := %s
var http = new ActiveXObject("WinHttp.WinHttpRequest.5.1");
http.Open("GET", "%1$s", false);
http.Send();
if(http.Status() == 200) {
   var f = new ActiveXObject("ADODB.Stream");
   f.type = 1; f.open(); f.write(http.responseBody);
   f.savetofile("%2$s", 2);
}
#pragma __endtext

Try
   hb_vfClose( hb_vfTempFile( @cScript,,, ".tmp" ) )

   IF hb_MemoWrit( cScript, ;
         hb_StrFormat( cJS, ;
            cURL, ;
            StrTran( cFileName, "\", "\\" ) ) )

      cProgram:="cscript" + ;
            " //nologo" + ;
            " /e:jscript" + ;
            " " + FNameEscape( cScript )

      Execute(cProgram)
   ENDIF
   hb_vfErase( cScript )
   lSuccess := .T.
Catch
   lSuccess := .F.
End

RETURN lSuccess

STATIC FUNCTION FNameEscape( cFileName )
   RETURN '"' + cFileName + '"'

FUNCTION Execute(cProgram, lEspera)
LOCAL oShell, lOk := .T., nStyle
   hb_Default(@lEspera,.T.)
   TRY
      oShell:=WIN_OleCreateObject( "WScript.Shell" )
   CATCH
      TRY
         oShell:=WIN_OleCreateObject( "WScript.Shell" )
      CATCH
         lOk := .F.
      END
   END
   IF lOk
      TRY
         /*
         intWindowStyle
         Description
         0  Hides the window and activates another window.
         1  Activates and displays a window. If the window is minimized or maximized, the system restores it to its original size and position. An application should specify this flag when displaying the window for the first time.
         2  Activates the window and displays it as a minimized window.
         3  Activates the window and displays it as a maximized window.
         4  Displays a window in its most recent size and position. The active window remains active.
         5  Activates the window and displays it in its current size and position.
         6  Minimizes the specified window and activates the next top-level window in the Z order.
         7  Displays the window as a minimized window. The active window remains active.
         8  Displays the window in its current state. The active window remains active.
         9  Activates and displays the window. If the window is minimized or maximized, the system restores it to its original size and position. An application should specify this flag when restoring a minimized window.
         10 Sets the show-state based on the state of the program that started the application. 
         */
         nStyle:=0
         //oShell:Run("sumatrapdf.exe -print-to-default -reuse-instance -lang pt "+cSource, nStyle, lEspera) 
         //oShell:Run("sumatrapdf.exe -print-to "+'"'+cPrinter+'"'+" -reuse-instance -lang pt "+cSource, nStyle, lEspera) 
         oShell:Run(cProgram, nStyle, lEspera) 
      CATCH
         MsgStop("Erro executando "+cProgram, "Erro")
         lOk := .F.
      END
      oShell:=Nil
   ENDIF
RETURN lOk

[asimoes]

Quintas,

Agora temos 2 opções a sua dica original com:

Código: Selecionar todos

        cTeste:=oHTTP:responsebody
         IF ValType( cTeste ) == "C"
            hb_MemoWrit( cArq, cTeste )
         ELSE
            nHandle := fCreate( cArq )
            FOR EACH nAscii IN cTeste // FOR nCont = 1 TO Len( oHttp:ResponseBody )
               fWrite( nHandle,  Chr(nAscii)  )
            NEXT
            FClose( nHandle )
         ENDIF

e a com java script.