Consulta Tarifa pelo Site do Correio

[frazato]

Tava dando uma olhada em alguns foruns de programação e vi esta rotina de consulta de tarifa no correio em outra linguagem e resolvi porta para xHarbour.

Compile usando o xharbour 99.70, sem libs graficas.


Frazato

Código: Selecionar todos

#DEFINE CRLF chr(13)+chr(10)
#INCLUDE "FILEIO.CH"


Function Main()
Local nDll , pApi
Local cCepOrigem := Space(9)
Local cCepDestino:= Space(9)
Local nPeso      := 0


      Clear
      Set Color to 'ww/BB+'
      Clear
      @ 00,00 say padc('Consulta de Tarifa Via correio ',80) Color('R+/NN+')
      @ 01,00 say padc('xHarbour 99.70',80) Color('GB+/NN+')

      @ 24,00 say padc('Joao Frazato ( sistema_jaf@hotmail.com)',80) Color('N/NN+')

      @ 10,10 say 'Nr. Cep Remetente :' Get cCepOrigem  Pict "@R 99.999-999"
      @ 12,10 say 'Nr. Cep Destino   :' Get cCepDestino Pict "@R 99.999-999"
      @ 14,10 say 'Peso              :' get nPeso Pict "@EZ 999.999"
      Read
      If LastKey()==27
         Return nil
      endif

      cUrl   := 'http://www.correios.com.br/encomendas/precos/calculo.cfm?cepOrigem='+;
                 Alltrim(cCepOrigem)+;
                 '&cepDestino='+;
                 Alltrim(cCepDestino)+;
                 '&peso='+StrZero(nPeso,11,3)

      cComando:= cUrl

       If VereficaNet( 'www.correios.com.br'  )==.f.
          Alert('Problema com o Site .....http://www.correios.com.br')
          Return Nil
       Endif

       Try
          oHttp := CreateObject("winhttp.winhttprequest.5.1")
          oHttp:Open("GET",cUrl,.f.)
          oHttp:Send()
          cResp1 := oHttp:ResponseText()
        Catch
          Return cResp
       End Try
       nPos := At('&Tarifa=',cResp1)
       nPos1 := At('&erro=',cResp1)

       cValor := Substr(cResp1,nPos+8,nPos1-1)
       Alert('Valor Encomenda :'+Transf(val(cValor),"@EZ 999,999.99") )
       *memoedit(cResp1)
       Centra(24,'')
Return ( Nil )


Function Centra(cLin,cMsg)
@ cLin,00 say Padc(cMsg,24)
Return nil

//----------------------------------------------
Function VereficaNet( cAddress )
LOCAL aHosts 
LOCAL cName
InetInit() 
IF cAddress == NIL 
   cAddress := "www.google.com.br" 
ENDIF 
aHosts := InetGetHosts( cAddress ) 
IF aHosts == NIL .or. len(aHosts)=0 
   InetCleanup() 
   RETURN .f. 
endif 
InetCleanup() 
RETURN (.T.)