Consultar e Importar Cep da Internet para o Sistema.

[gilbertosilverio]

Ola amigos,

Consegui fazer funcionar, estava errando no campo logradouro, não consegui entender como funciona esta pesquisa preenchendo este campo logradouro.

Mesmo pelo exemplo do Daniel, preenchendo este campo, não consigo retorno.

Desse jeito, bem meia boca, ta funcionando com HB34+MINGW + HWGUI 2.20, e so colocar o CEP ou endereco+cidade que lista tudo o que há...

/*
COMPILAR:
HBMK2 C:\HWGUI\HWGUI.HBC C:\HB34\CONTRIB\HBTIP\HBTIP.HBC HBWIN.HBC CEP.PRG

Baseado no exemplo de:
//=========================================================================
//
// Arquivo.....: Cep.prg
// Criado em...: 02-01-2017 as 07:56 PM
//
// Projeto.....: Consulta Simples
//
// Programador.: Daniel Denobie - denobie@hotmail.com
//
//=========================================================================
*/

#include "hwgui.ch"
#include "directry.ch"
#include "Fileio.ch"
#include "tip.ch"

MemVar cUrl, cUrl1, cQuery, oServer, cCookie, cRet, cFile, cRet1, cRet2, nIni, nFim
Memvar cArq, cArq1, cArq2, cArq3

Function Main()
  private cCep:=SPAC(50), cLogradouro:=[], cUf:=[], xCEP:=SPAC(50)

  private MATA:={}

  XCEP := MsgGet_Correio([Pesquisar por rua],[cep ou rua ], xCEP)

  Consulta_Cep(xCEP, cLogradouro, cUF)

  if len(mata) > 0
     TELA()
  endif

Return Nil

* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *>

Function MsgGet_Correio( cTitle, cText, xCEP)
   Local oModDlg, oFont := HFont():Add( "MS Sans Serif",0,-13 )
   LOCAL oGET101

   INIT DIALOG oModDlg TITLE cTitle SIZE 300,140 ;
        FONT oFont CLIPPER STYLE DS_MODALFRAME + WS_POPUP + WS_VISIBLE + WS_CAPTION + WS_SYSMENU + DS_CENTER

        @ 20,10 SAY cText SIZE 260,22
        @ 20,35 GET oGET101 VAR xCEP SIZE 150,24 PICTURE "@X" STYLE WS_TABSTOP

        @ 200,95  BUTTON "Ok"  ID IDOK  SIZE 80,24

   ACTIVATE DIALOG oModDlg

   oFont:Release()

Return xCEP

* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *

Function Consulta_Cep(cCep, cLogradouro, cUf) // consulta do cep esta funcionando ate bem

   If !Empty(AllTrim(cLogradouro))
      cUrl  := 'http://www.buscacep.correios.com.br/sistemas/buscacep/BuscaCep.cfm'
      cUrl1 := 'http://www.buscacep.correios.com.br/sistemas/buscacep/resultadoBuscaCep.cfm'
      cQuery:= 'UF=' + cUf                           +;
               '&Localidade=' + cCep                 +;
               '&Tipo='                              +;
               '&Logradouro=' + AllTrim(cLogradouro) +;
               '&Numero='
   Else
      cUrl  := "http://www.buscacep.correios.com.br/sistemas/buscacep/BuscaCepEndereco.cfm"
      cUrl1 := 'http://www.buscacep.correios.com.br/sistemas/buscacep/resultadoBuscaCepEndereco.cfm'
      cQuery:= "relaxation=" + AllTrim(cCep) +;
               "&tipoCEP=ALL" +;
               "&semelhante=N"
   EndIf

   BEGIN SEQUENCE WITH __BreakBlock()
      oServer:= win_OleCreateObject( "MSXML2.ServerXMLHTTP.5.0")
   End

   BEGIN SEQUENCE WITH __BreakBlock()
      oServer:Open( "GET", cUrl, .f. )
      oServer:SetRequestHeader( "Content-Type", "application/x-www-form-urlencoded" )
      oServer:SetRequestHeader( "Connection", "keep-alive" )
      oServer:Send()
      oServer:WaitForResponse( 5000 )
   End
   cCookie:= oServer:getResponseHeader("Set-Cookie")
   cRet   := oServer:ResponseBody
   //MemoWrit("site.txt", cRet)

   BEGIN SEQUENCE WITH __BreakBlock()
      oServer:= win_OleCreateObject( "MSXML2.ServerXMLHTTP.5.0")
   End

   BEGIN SEQUENCE WITH __BreakBlock()
      oServer:Open( "POST", cUrl1, .f. )
      oServer:SetRequestHeader("Content-Type", "application/x-www-form-urlencoded")
      oServer:SetRequestHeader("Connection", "keep-alive" )
      oServer:SetRequestHeader("Accept", "text/html,application/xhtml+xml,application/xml;q=0.9,*/*;q=0.8")
      oServer:SetRequestHeader("Accept-Language", "pt-BR,pt;q=0.8,en-US;q=0.5,en;q=0.3")
      oServer:SetRequestHeader("Upgrade-Insecure-Requests", '1')
      oServer:SetRequestHeader("Cookie", cCookie)
      oServer:Send(cQuery)
      oServer:WaitForResponse( 5000 )
   end

   cFile:= oServer:ResponseBody
   cRet1:= StrTran(cFile,Chr(13)+Chr(10),"")
   cRet2:= StrTran(cRet1,Chr(160),"")
   cRet := StrTran(cRet1,Chr(13),"")
   //MemoWrit("Result.txt", cRet)

   nIni := At('function detalhaCep(CEP)', cRet)

   If nIni == 0
      hwg_MsgInfo('Sem arquivo de CEP ', 'Aviso') // para aqui?????
      Return Nil
   EndIf

   nIni := At('document.Geral.submit();}</script><p>', cRet)
   If nIni == 0
      Return nil
   EndIf
   nIni+= 37
   cRet1:= SubStr(cRet, nIni)
   nFim := At('</p>', cRet1) - 1

   hwg_msgInfo(Troca_Acento(SubStr(cRet, nIni, nFim)), [teste aqui])

   While .t.
      nIni := At('<td width="150">', cRet)
      if nIni == 0
         exit
      EndIf
      nIni+= 16
      cRet1:= SubStr(cRet, nIni)
      If At('<a href="javascript:detalhaCep', cRet1) == 1
         nIni  += 45
    cRet1 := SubStr(cRet, nIni)
    nFim  := At('&nbsp;</a>', cRet1) - 1
    cArq  := Troca_Acento(StrTran(SubStr(cRet, nIni, nFim), '<br><br>', '-')) //Endereço
      Else
         nFim := At('&nbsp;</td>', cRet1) - 1
    cArq := Troca_Acento(SubStr(cRet, nIni, nFim)) //Endereço
      EndIf

      nIni := At('&nbsp;</td><td width="90">', cRet)
      If nIni == 0
         nIni:= At('&nbsp;</a></td><td width="90"', cRet)
       nIni+= 30
      Else
        nIni+= 26
      EndIf

      cRet1:= SubStr(cRet, nIni)
      nFim := At('&nbsp;</td>', cRet1) - 1
      cArq1:= Troca_Acento(SubStr(cRet, nIni, nFim)) //Bairro

      nIni := At('&nbsp;</td><td width="80">', cRet)
      nIni += 26
      cRet1:= SubStr(cRet, nIni)
      nFim := At('</td><td width="55">', cRet1) - 1
      cArq2:= Troca_Acento(SubStr(cRet, nIni, nFim)) //Cidade/Uf

      nIni := (At('</td><td width="55">', cRet) + 20)
      cRet1:= SubStr(cRet, nIni)
      nFim := At('</td></tr>', cRet1) - 1
      cArq3:= SubStr(cRet, nIni, nFim) //CEP
      cRet := cRet1

      IF !EMPTY(cArq3)
         AADD ( MATA, {cArq3, cArq, cArq1, cArq2} )
      ENDIF
   End

Return Nil

* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *

Function Troca_Acento(cTexto)

   cTexto := StrTran( cTexto, "&ccedil;", "ç" )
   cTexto := StrTran( cTexto, "&Ccedil;", "Ç" )
   cTexto := StrTran( cTexto, "&atilde;", "ã" )
   cTexto := StrTran( cTexto, "&Atilde;", "Ã" )
   cTexto := StrTran( cTexto, "&otilde;", "õ" )
   cTexto := StrTran( cTexto, "&Otilde;", "Õ" )
   cTexto := StrTran( cTexto, "&acirc;" , "â" )
   cTexto := StrTran( cTexto, "&Acirc;" , "Â" )
   cTexto := StrTran( cTexto, "&ecirc;" , "ê" )
   cTexto := StrTran( cTexto, "&Ecirc;" , "Ê" )
   cTexto := StrTran( cTexto, "&aacute;", "á" )
   cTexto := StrTran( cTexto, "&Aacute;", "Á" )
   cTexto := StrTran( cTexto, "&eacute;", "é" )
   cTexto := StrTran( cTexto, "&Eacute;", "É" )
   cTexto := StrTran( cTexto, "&iacute;", "í" )
   cTexto := StrTran( cTexto, "&Iacute;", "Í" )
   cTexto := StrTran( cTexto, "&oacute;", "ó" )
   cTexto := StrTran( cTexto, "&Oacute;", "Ó" )
   cTexto := StrTran( cTexto, "&uacute;", "ú" )
   cTexto := StrTran( cTexto, "&Uacute;", "Ú" )
   cTexto := StrTran( cTexto, "&agrave;", "à" )
   cTexto := StrTran( cTexto, "&Agrave;", "À" )
   cTexto := StrTran( cTexto, "&egrave;", "è" )
   cTexto := StrTran( cTexto, "&Egrave;", "È" )
   cTexto := StrTran( cTexto, "&igrave;", "ì" )
   cTexto := StrTran( cTexto, "&Igrave;", "Ì" )
   cTexto := StrTran( cTexto, "&ograve;", "ò" )
   cTexto := StrTran( cTexto, "&Ograve;", "Ò" )
   cTexto := StrTran( cTexto, "&ugrave;", "ù" )
   cTexto := StrTran( cTexto, "&Ugrave;", "Ù" )
   cTexto := StrTran( cTexto, "&iuml;"  , "ï" )
   cTexto := StrTran( cTexto, "&Iuml;"  , "Ï" )
   cTexto := StrTran( cTexto, "&uuml;"  , "ü" )
   cTexto := StrTran( cTexto, "&Uuml;"  , "Ü" )
   Return cTexto

* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *

FUNCTION TELA()

   LOCAL oDlg_Dados_NFe, oBrw_NFE, oButton1

      INIT DIALOG oDlg_Dados_NFe TITLE "Dados"  AT 0, 0 SIZE 993,606       ;
           FONT HFont():Add( 'Verdana',0,-14,400,,,) CLIPPER  NOEXITESC                             ;
           STYLE WS_POPUP+WS_CAPTION+WS_SYSMENU+WS_SIZEBOX+WS_MINIMIZEBOX+WS_MAXIMIZEBOX+DS_CENTER

        This_Hwg_Dados_NFe := oDlg_Dados_NFe

        @ 15,45 BROWSE oBrw_NFE ARRAY SIZE 935,450 STYLE WS_TABSTOP+WS_HSCROLL

        hwg_CREATEARLIST( oBrw_NFE, Mata )

        oBrw_NFE:aColumns[01]:heading  := "CEP        "
        oBrw_NFE:aColumns[02]:heading  := "Endereco   "
        oBrw_NFE:aColumns[03]:heading  := "Bairro     "
        oBrw_NFE:aColumns[04]:heading  := "Cidade     "

        oBrw_NFE:aColumns[01]:nJusHead := DT_CENTER
        oBrw_NFE:aColumns[02]:nJusHead := DT_LEFT
        oBrw_NFE:aColumns[03]:nJusHead := DT_LEFT
        oBrw_NFE:aColumns[04]:nJusHead := DT_LEFT

        oBrw_NFE:Refresh()
        oBrw_NFE:Setfocus()

        @ 841,556 BUTTON oButton1 CAPTION "Sai&r"  SIZE 135,35 STYLE BS_CENTER +WS_TABSTOP ;
                  ON CLICK {||  This_Hwg_Dados_NFe:Close() }

      ACTIVATE DIALOG oDlg_Dados_NFe

RETURN NIL

[JoséQuintas]

Bom saber.

Também gostei desta parte: "HB34+MINGW + HWGUI 2.20", estou baixando hwgui 2.20.

[Daniel]

Ola
Funciona Assim

Consulta por Cep deixar Logradouro em branco

Consulta por Cidade Uf e Endereço

Consulta por Endereço + Cidade deixar Logradouro em branco

[gilbertosilverio]

Daniel,

Obrigado pelas dicas de como usar.

Ontem, nos testes que estava fazendo, ocorreu este erro.

Error WINOLE/1007 O identificador não está no estado correto para a operação solicitada
(0x80072EF3): msxml5.dll (DOS Error -2147352567)
Called from ->WIN_OLEAUTO:GETRESPONSEHEADER(0)
Called from ->CONSULTA_CEP(92)
Called from ->MAIN(33)

HWGUI 2.20 Build 3
Date:01/17/17
Time:19:54:30

Esta forçando as pesquisas, e creio que foi devido a isso, colocava uma palavra qualquer na pesquisa por CEP/ENDERECO, tipo, COUTO, JOAO, ate que travou neste erro. Somente depois de algum tempo, começou a retornar as pesquisas.

Sera que a limite para as pesquisas?

[Hasse]

Boa noite colegas.

Compilando com Harbour MiniGui 3.4.3 - IDE do Roberto Lopez.

Na busca dá "Erro na Conexão com o Site"

A compilação foi feita sem qualquer alteração, tanto no PRG quanto em qualquer outro arquivo.

Após, ao clicar no botão "Sair" o aplicativo trava. Mensagem: "Busca de CEP (Não está respondendo)"

Clicando insistentemente no "X" aparece uma janela dando como uma das opções "Fechar o programa". Clicando em "Fechar o programa" ainda é necessário clicar em "Cancelar" para que o aplicativo aborte de forma forçada.

Onde está o problema ?

[Daniel]

Hasse

erro acostuma aparecer quanto o ole não esta funcionando de acordo
e testei aqui no hmg 3.4 não deu erro compilou certinho
só arquivo fmg no grid que tive que tirar as ultimas 2 linhas

[Hasse]

OK.
Tirei as citadas linhas.
Agora o aplicativo fecha corretamente.

Mas ainda não conecta. O erro de conexão continua lá.
Colando o endereço eletrônico no navegador conecta corretamente.

E como se corrige o funcionamento do Ole ?

[Daniel]

olha se tem estas DLL na pasta System32 msxml5.dll msxml5r.dll msxml6.dll msxml6r.dll

[JoséQuintas]

Existe uma diferenca entre Harbour e xHarbour, pelo menos usando wapi_CreateObject()

No xHarbour é obrigatório indicar a versão, mas no Harbour não.
O Harbour seleciona automático a versão que for necessária.
Isso altera a string dentro de wapi_CreateObject()

"MSXML2.ServerXMLHTTP.5.0"

Mesmo na nota fiscal eletrônica, que é padrão, tem UF que funciona com 5.0 ou não.
Lembrando um trecho que anotei na SefazClass

#ifdef __XHARBOUR__
      //IF ::cUF == "GO" .AND. ::cAmbiente == "2"
         ::cXmlRetorno := "Erro: Criando objeto MSXML2.ServerXMLHTTP.5.0"
         oServer := win_OleCreateObject( "MSXML2.ServerXMLHTTP.5.0" )
      //ELSE
      //   ::cXmlRetorno := "Erro: Criando objeto MSXML2.ServerXMLHTTP.6.0"
      //   oServer := win_OleCreateObject( "MSXML2.ServerXMLHTTP.6.0" )
      //ENDIF
#else
      oServer := win_OleCreateObject( "MSXML2.ServerXMLHTTP" )
#endif

[Hasse]

Boa tarde.

olha se tem estas DLL na pasta System32 msxml5.dll msxml5r.dll msxml6.dll msxml6r.dll

Pesquisei e encontrei somente as msxml6.dll msxml6r.dll

As msxml5.dll msxml5r.dl não se encontram lá.

Interessante que tem as msxml3.dll msxml3a.dll e msxml3r.dll

Preciso procurar na internet estas dll's faltantes ?
Encontrando, simplesmente copiar as citadas para aquela pasta ?

[Daniel]

Hasse
Não, e so voce troca esta linha

oServer := win_OleCreateObject( "MSXML2.ServerXMLHTTP.5.0" )

por esta

oServer := win_OleCreateObject( "MSXML2.ServerXMLHTTP.6.0" )

[Hasse]

Boa noite Daniel.

FUNCIONOU !!!! Muito legal. :)) :)) :))

Muito obrigado pela tua colaboração.

[Hasse]

Continuando.

1)-Parece-me que o Button_5 - "Importar" ainda não foi desenvolvido. A sua serventia seria importar os dados coletados para um cadastro nosso ?

2)-Com um novo Button_6 - "Limpar tabela", como eu poderia "zerar" a tabela com os dados anteriores já pesquisados.

     DEFINE BUTTON Button_6
            ROW    210
            COL    710
            WIDTH  100
            HEIGHT 28
            ACTION msgInfo( 'A implementar' )
            CAPTION "Limpar tabela"
            FONTNAME 'Arial'
     END BUTTON

Semelhante a um "Grid_1.data.release" ????

[Daniel]

1)-Parece-me que o Button_5 - "Importar" ainda não foi desenvolvido. A sua serventia seria importar os dados coletados para um cadastro nosso ?

Sim. Seria isto mesmo, fazer a função que melhor se adaptar ao seu programa.

2)-Com um novo Button_6 - "Limpar tabela", como eu poderia "zerar" a tabela com os dados anteriores já pesquisados.

Este botão seria assim

DEFINE BUTTON Button_4
            ROW    210
            COL    710
            WIDTH  100
            HEIGHT 28
            ACTION F_ConsultaCep.Grid_1.DeleteAllItems
            CAPTION "Limpar Dados"
            FONTNAME 'Arial'
     END BUTTON

[Hasse]

Perfeito, Daniel !!!!!!!!!
Funcionou muito bem.
Obrigado.