Busca CEP infalível

mkyx · January 19, 2015

Para quem interessar: rotina busca cep

#INCLUDE "FIVEWIN.CH"

#include "corget.ch"

FUNCTION MAIN()

SET DATE BRITISH

SET CENTURY ON

Tb_UF:="BA/DF/GO/MT/MG/PE/RS/RO/SP/MS/CE/ES/MA/PA/PI/PR/RN/AC/AL/AM/AP/PB/RJ/RR/SC/SE/TO"

DEFINE CURSOR OCURSOR HAND

DEFINE FONT OFNT NAME "ARIAL" SIZE 0,16

DEFINE DIALOG ODLG_c FROM 1,1 TO 25,70 TITLE "BUSCA CEP" FONT OFNT

@ 5,5 TO 150,268 LABEL "" OF ODLG_c PIXEL

@ 15,10 SAY OS03_C PROMPT "NOME:" SIZE 42,10 OF ODLG_c PIXEL COLOR CLR_BLUE

@ 30,10 SAY OS04_C PROMPT "CEP:" SIZE 20,10 OF ODLG_c PIXEL COLOR CLR_BLUE

@ 45,10 SAY OS05_C PROMPT "ENDEREÇO:" SIZE 70,10 OF ODLG_c PIXEL COLOR CLR_BLUE

@ 60,10 SAY OS05_C PROMPT "NÚMERO:" SIZE 40,10 OF ODLG_c PIXEL COLOR CLR_BLUE

@ 85,10 SAY OS05_C PROMPT "COMPLEMENTO:" SIZE 45,10 OF ODLG_c PIXEL COLOR CLR_BLUE

@ 100,10 SAY OS06_C PROMPT "BAIRRO:" SIZE 25,10 OF ODLG_c PIXEL COLOR CLR_BLUE

@ 115,10 SAY OS07_C PROMPT "CIDADE:" SIZE 30,10 OF ODLG_c PIXEL COLOR CLR_BLUE

@ 130,10 SAY OS08_C PROMPT "UF:" SIZE 20,10 OF ODLG_c PIXEL COLOR CLR_BLUE

ne_c:=space(50)

ce_c:=space(9)

en_c:=space(50)

nu_c:=space(10)

cpl_c:=space(50)

ba_c:=space(35)

cd_c:=space(35)

UF_C:=SPACE(2)

@ 14,60 GET OG04_C VAR NE_C SIZE 200,10 OF ODLG_C PIXEL

@ 29,60 GET OG05_C VAR CE_C PICTURE "99999-999" SIZE 37,10 OF ODLG_C PIXEL

@ 28,99 BUTTON o_BUSCA PROMPT "BUSCA CEP" of odlg_C pixel size 40,12 action b_cep_c(@og06_c,@og09_c,@og10_c,@og11_c,@ce_c,@og07_c)

O_busca:CTOOLTIP:="Busca os Dados do CEP na InterNet"

o_busca:oCursor:=oCursor

o_busca:CVARNAME:="BUSCAR"

@ 44,60 GET OG06_C VAR EN_C SIZE 200,10 OF ODLG_C PIXEL

@ 59,60 GET OG07_C VAR NU_C PICTURE "XXXXXXXXXX" SIZE 40,10 OF ODLG_C PIXEL

@ 84,60 GET OG08_C VAR CPL_C SIZE 100,10 OF ODLG_C PIXEL

@ 99,60 GET OG09_C VAR BA_C SIZE 80,10 OF ODLG_C PIXEL

@ 114,60 GET OG10_C VAR CD_C SIZE 80,10 OF ODLG_C PIXEL

@ 129,60 GET OG11_C VAR UF_C PICTURE "AA" SIZE 20,10 OF ODLG_C PIXEL VALID alltrim(UPPER(UF_C))$upper(Tb_UF) .OR. OG11_C:NLASTKEY=38 .OR. OG11_C:NLASTKEY=9

ACTIVATE DIALOG ODLG_c CENTERED

RETURN .T.

FUNCTION B_CEP_C(oEndere1,oBairro1,oCidade1,oEstado1,cCep,oNumero)

local oPg, cBuf,cResult, error_net,oerror

local cUr2 :="http://m.correios.com.br/movel/buscaCepConfirma.do?cepEntrada=<"+tira(cCep,"Z")+">&metodo=buscarCep"

local cMsgSto:="COLOQUE NOME DA SUA EMPRESA"

CURSOR("AGUARDE")

if !ISInternet()

MsgStop("Não Há Coneccão com a INTERNET","SEM SINAL PARA CONECÇÃO")

CURSORARROW()

Return(.T.)

endif

oPg = CreateObject("Microsoft.XMLHTTP")

oPg:Open("GET",cUr2,.F.)

ERROR_NET:=.T.

Try

oPg:Send()

catch oError

msgstop("ERRO AO CONSULTAR C.E.P..!!! " + oError:Description + ". FAÇA MANUALMENTE",cMsgsto)

ERROR_NET:=.F.

END TRY

if ERROR_NET==.T.

cBuf = oPg:ResponseBody

cResult =substr(cBuf, at('<resultado>',cBuf)+11,1)

if left(cBuf,2) # "OK"

ERROR_NET :=.T.

endif

cen:=substr(cBuf, at('>Logradouro:', cBuf) + 21, 200)

cen:=substr(cen, at('respostadestaque', cen) + 18, at('', cen)-(at('respostadestaque', cen) + 19))

cba:=substr(cBuf, at('>Bairro:', cBuf) + 17, 150)

cba:=substr(cba, at('respostadestaque', cba) + 18, at('', cba)-(at('respostadestaque', cba) + 18))

cci:=substr(cBuf, at('Localidade', cBuf) + 23, 250)

cci:=substr(cci, at('respostadestaque', cci) + 18, at('', cci)-(at('respostadestaque', cci) + 18))

CCI:=ALLTRIM(CCI)

ccp:=substr(cBuf, at('>CEP:', cBuf) + 14, 100)

ccp:=substr(ccp, at('respostadestaque', ccp) + 18, at('', ccp)-(at('respostadestaque', ccp) + 18))

cuf:=RIGHT(CCI,LEN(CCI)-at('/', cci))

cci:=left(CCI,LEN(CCI)-at('/', cci))

IF LEN(ALLTRIM(CUF))>1

oEstado1:Varput(substr(alltrim(sAcento(upper(cuf)))+space(2),1,2))

ENDIF

IF LEN(ALLTRIM(CCI))>2

oCidade1:Varput(substr(alltrim(sAcento(upper(cCi)))+space(35),1,35))

ENDIF

IF LEN(ALLTRIM(CBA))>2

oBairro1:Varput(substr(alltrim(sAcento(upper(cBa)))+space(35),1,35))

ENDIF

IF LEN(ALLTRIM(CEN))>2

oEndere1:Varput(substr(alltrim(sAcento(upper(cen)))+space(60),1,60))

ENDIF

oEstado1:Refresh()

oCidade1:Refresh()

oBairro1:Refresh()

oEndere1:Refresh()

oNumero:Setfocus()

CURSORARROW()

return(.T.)

static function sAcento(cTes)

cTes =strtran(cTes,'ã','Ã')

cTes =strtran(cTes,'á','Á')

cTes =strtran(cTes,'â','Â')

cTes =strtran(cTes,'é','É')

cTes =strtran(cTes,'ê','Ê')

cTes =strtran(cTes,'õ','Õ')

cTes =strtran(cTes,'ó','Ó')

cTes =strtran(cTes,'ô','Ô')

cTes =strtran(cTes,'ç','Ç')

cTes =sTrtran(cTes,'ú','Ú')

cTes =sTrtran(cTes,'ü','Ü')

cTes =strtran(cTes,'í','Í')

Return cTes

FUNCTION TIRA

PARAMETERS FF,GG

FF=ALLTRIM(FF)

N0=""

MAIS:="N"

FOR I=1 TO LEN(FF)

IF SUBSTR(FF,I,1)$"QWERTYUIOPASDFGHJKLZXCVBNMÇ"

MAIS="S"

ENDIF

AA=SUBSTR(FF,I,1)

IF GG="S"

pos:=at(AA,"ÁÉÍÓÚáéíóúÇç")

if pos>0

AA:=SUBSTR("AEIOUaeiouCc",pos,1)

endif

N0:=N0+AA

ENDIF

IF GG="Z" .AND. AA$"0123456789"

N0:=N0+AA

ENDIF

NEXT I

RETURN(N0)

*

microfly · January 19, 2015

valeu parceiro

oribeiro · January 19, 2015

Não consegui compilar com xBuild.bat do xHarbour.

Qual é o segredo?

mkyx · January 20, 2015

Posta o erro.

Pois pode está relacionado à falta de alguma lib

oribeiro · January 20, 2015

Faltava o arquivo

#include "corget.ch"

Tirei essa linha e passou.

Obrigado,

sistem · January 20, 2015

acho que nao esta mais funcionando

kapiaba · January 20, 2015

Olá, em FWH13.06, não funcionou corretamente. Eu digito o CEP: 01313-000, deveria retornar:

AVENIDA NOVE DE JULHO - Mas não retorna nada.

O restante retorna, se é que eu entendi...

Correto seria:

Logradouro: Avenida Nove de Julho - até 1299 - lado ímpar
Bairro: Bela Vista
Localidade / UF: São Paulo /SP
CEP: 01313000

Obg. abs.

giovanyvecchi · January 20, 2015

Para os acentos e caracteres especiais usem a função HTML_TO_ANSI(), Da bliblioteca HbTip.lib de harbour

 FUNCTION HTML_TO_ANSI(f_cTxt)
  Local iFor := 0, cRetTxt := ""
  
  cRetTxt := HtmlToAnsi(f_cTxt) // Entity Name
  
  // HTML Reserved Characters
  For iFor := 34 to 62
    cRetTxt := StrTran(cRetTxt,""+Alltrim(Str(iFor))+";",Chr(iFor))
  Next
  
  // ISO 8859-1 Characters
  For iFor := 192 to 255
    cRetTxt := StrTran(cRetTxt,""+Alltrim(Str(iFor))+";",Chr(iFor))
  Next
 
  // ISO 8859-1 Symbols
  For iFor := 160 to 247
    cRetTxt := StrTran(cRetTxt,""+Alltrim(Str(iFor))+";",Chr(iFor))
  Next
   
 RETURN cRetTxt

mkyx · January 20, 2015

Kapiaba,

favor alterar o valor de 200 para 250, na linha que apura o endereço: variável CEN

assim:

cen:=substr(cBuf, at('>Logradouro:', cBuf) + 21, 250)

cen:=substr(cen, at('respostadestaque', cen) + 18, at('', cen)-(at('respostadestaque', cen) + 19))

Assim, vai dar certo.

Eduardo Bilato · January 21, 2015

Essa é mais simples e busca cep, endereço, ou faixa de cep

exemplo de faixa de cep: 13614

//----------------------------------------------------------------------------//
//
// Autor:    Eduardo de Camargo Bilato(EBL)
// Objetivo: Utilizar webservice dos correios para buscar cep/endereço
//
//----------------------------------------------------------------------------//

#Include "FiveWin.Ch"

#DEFINE ILF CHR(13)+CHR(10)

Function Cep( cCep )

local oCep
local xCep := padr( if( cCep <> nil,cCep,'' ),60 )

while .t.

   msgget( 'Busca CEP','Informe o CEP/Endereço desejado:',@xCep )

   if empty( xCep )
      exit
   endif

   oCep := TBusca_Cep():New( xCep )

   oCep:End()

   xCep := space(60)

enddo

Return Nil

//----------------------------------------------------------------------------//

*------------------------------------------------------------------------------------------------
*  Classe    TBusca_Cep
*  Data      10/03/2014
*  Autor     EBL
*  Objetivo  Utiliza WebService para obter Cep
*-------------------------------------------------------------------------------------------------

CLASS TBusca_Cep

   DATA cCep
   DATA cTitulo
   DATA cEndereco
   DATA cBairro
   DATA cCidade
   DATA cUF
   DATA oXmlHttp

   DATA nCont
   DATA aResp

   DATA cTag1 AS CHARACTER INIT '<span class="resposta'
   DATA cTag2 AS CHARACTER INIT '</span>'
   DATA cTag3 AS CHARACTER INIT 'destaque">'

   DATA cBuffer  AS CHARACTER INIT ''

   METHOD New( xCep ) CONSTRUCTOR

   METHOD Load()

   METHOD Quebra_String( cBuff )

   METHOD End()

ENDCLASS

//----------------------------------------------------------------------------//

METHOD New( xCep ) CLASS TBusca_Cep

::cCep      := xCep
::cTitulo   := space(20)
::cEndereco := space(60)
::cBairro   := space(40)
::cCidade   := space(60)
::cUF       := space(02)

::nCont     := 0
::aResp     := {}

if ::cCep <> NIL
   Self:Load()
endif

return Self

//----------------------------------------------------------------------------//

METHOD Load() CLASS TBusca_Cep

local nCnt  := 0
local nCn1  := 0
local nSeq  := 1
local nAux  := 0
local nPag  := 0

local aBuff := {}
local cLink := ''
local cLin0 := 'http://m.correios.com.br/movel/buscaCepConfirma.do?cepEntrada='+::cCep+'&metodo=buscarCep'
local cLin1 := 'http://m.correios.com.br/movel/buscaCepConfirma.do?cepEntrada='+::cCep+'&metodo=proximo&numPagina='

local nMaxPag := 1

for n1 := 1 to int( nMaxPag ) step 10

   SysRefresh()
   
   nPag++
   
   if nPag == 1
      cLink := cLin0
   else
      cLink := cLin1+alltrim(str(nPag-1))
   endif
   
   ::oXmlHttp := CreateObject( "Microsoft.XMLHTTP" )
   
   if ::oXmlHttp <> nil
      
      ::oXmlHttp:Open( 'GET',cLink,.f. )
      
      ::oXmlHttp:Send()
      
      ::cBuffer := strtran( ::oXmlHttp:ResponseBody,CHR(13),'' )
      
      aBuff := hb_aTokens( ::cBuffer,CHR(10) )
      
   else
      exit
   endif

   SysWait(1)

   ::nCont := 0
   ::aResp := {}
   
   for wx:=1 to len( aBuff )

      if empty( aBuff[wx] )
         loop
      endif
      
      //são 10 registros por página
      if nPag == 1
         
         nAux := Busca_Limit( aBuff[wx] )
         
         if nAux > 0
            nMaxPag := nAux
         endif
         
      endif
      
      ::Quebra_String( aBuff[wx] )
      
   next
   
   for xx:=1 to len( ::aResp )
      
      nCn1++

      if nCn1%2 == 0
         if nCnt == 0
            ::cEndereco := ::aResp[xx]
            nCnt++
         elseif nCnt == 1
            ::cBairro := ::aResp[xx]
            nCnt++
         elseif nCnt == 2
            ::cCidade := ::aResp[xx]
            nCnt++
         elseif nCnt == 4
            ::cCep := ::aResp[xx]
            nCnt++
         endif
         nCn1 := 0
      elseif nCnt == 3
         ::cUF := ::aResp[xx]
         nCnt++
         nCn1 := 0
      endif

      if nCnt == 5
         
         nAux := at( ' ',::cEndereco )
         if nAux > 0
            ::cTitulo := left( ::cEndereco,nAux-1 )
            ::cEndereco := substr( ::cEndereco,nAux+1 )
         endif

         ? 'Sequência: ' + alltrim(str(nSeq)) ;
         ,                                    ;
         , 'Cep: '       + ::cCep             ;
         , 'Titulo: '    + ::cTitulo          ;
         , 'Endereço: '  + ::cEndereco        ;
         , 'Bairro: '    + ::cBairro          ;
         , 'Cidade: '    + ::cCidade          ;
         , 'UF: '        + ::cUF
         
         nCnt := 0
         nSeq++

      endif

   next
   
   ::oXmlHttp:Abort()
   
next

if nSeq == 1
   msginfo( 'CEP não encontrado','Busca' )
endif

return

//----------------------------------------------------------------------------//

METHOD Quebra_String( cBuff ) CLASS TBusca_Cep

local nIni     := 0
local nFim     := 0

local uDado    := ''
local xString  := ''

for xx:=1 to len( cBuff )

   uDado += substr( cBuff,xx,1 )
   
   //evitar que o programa se perca na separação dos resultados
   if 'Cliente:' $ uDado .or.;
      'Unidade:' $ uDado
      nIni := 0
      nFim := 0
      ::nCont := 0
      loop
   endif
   
   if ( ::cTag1 $ uDado ) .or. ( ::cTag3 $ uDado )
      uDado := ''
      nIni  := xx
      ::nCont := 1
   elseif ( ::cTag2 $ uDado )
      uDado := ''
      nFim  := xx-len(::cTag2)
      ::nCont := 2
   endif

   if nIni > 0 .and. nFim > 0

      xString := Limpa_Leitura( substr( cBuff,nIni,nFim ) )

      aadd( ::aResp,xString )

      nIni := 0
      nFim := 0

      ::nCont := 0

   endif

next

uDado := alltrim(uDado)

if ::nCont == 1 .and. !empty(uDado)
   
   if !('Cliente:' $ uDado)
      
      uDado := Limpa_Leitura( uDado )
      
      aadd( ::aResp,uDado )

   endif
   
endif

return

//----------------------------------------------------------------------------//

METHOD End() CLASS TBusca_Cep

Self := nil

return

//----------------------------------------------------------------------------//

static Function Busca_Limit( cBuff )

local nRegistros := 0

local nAt  := at( '<input type="hidden" name="regTotal" value="',cBuff )
local cStr := cBuff

if nAt > 0

   cStr := substr( cStr,nAt+44 )

   nAt := at( '">',cStr ) - 1
   
   nRegistros := val( left( cStr,nAt ) )

endif

Return nRegistros

//----------------------------------------------------------------------------//

static Function Limpa_Leitura( cText )

local oCep     := TBusca_Cep():new()
local cNewText := alltrim( cText )

cNewText := strtran( cNewText,oCep:cTag1,'' )
cNewText := strtran( cNewText,oCep:cTag2,'' )
cNewText := strtran( cNewText,oCep:cTag3,'' )
cNewText := strtran( cNewText,'/'       ,'' )
cNewText := strtran( cNewText,'<br>'    ,'' )
cNewText := strtran( cNewText,'>'       ,'' )

Return cNewText

//----------------------------------------------------------------------------//

static Function LerBuffer( cTexto,cStri1 )

local nPos1 := 0
local nPos2 := 0
local cRetor := ""

local cStri2 := Stuff( cStri1,2,0,'/' )

if Upper( cStri1 ) $ Upper( cTexto )

   nPos1 := At( Upper( cStri1 ),Upper( cTexto ) ) + Len( cStri1 )
   nPos2 := At( Upper( cStri2 ),Upper( cTexto ) )

   if nPos1 == 0
      cRetor := ''
   elseif nPos2 == 0
      cRetor := SubStr( cTexto,nPos1 )
   else
      cRetor := SubStr( cTexto,nPos1,nPos2-nPos1 )
   endif

endif

Return( cRetor )

//----------------------------------------------------------------------------//

kapiaba · January 21, 2015

Agora sim, funciona perfeito em FWH1306 fox xHarbour



#INCLUDE "FIVEWIN.CH"

// #include "corget.ch"


FUNCTION MAIN()


   SET DATE BRITISH

   SET CENTURY ON


   Tb_UF:="BA/DF/GO/MT/MG/PE/RS/RO/SP/MS/CE/ES/MA/PA/PI/PR/RN/AC/AL/AM/AP/PB/RJ/RR/SC/SE/TO"


   DEFINE CURSOR OCURSOR HAND

   DEFINE FONT OFNT NAME "ARIAL" SIZE 0,16


   DEFINE DIALOG ODLG_c FROM 1,1 TO 25,70 TITLE "BUSCA CEP" FONT OFNT


   /// ISTO NAO FUNCIONA NAS NOVAS VERSOES

   //@ 5,5 TO 150,268 LABEL "" OF ODLG_c PIXEL


   @ 15,10 SAY OS03_C PROMPT "NOME:" SIZE 42,10 OF ODLG_c PIXEL COLOR CLR_BLUE


   @ 30,10 SAY OS04_C PROMPT "CEP:" SIZE 20,10 OF ODLG_c PIXEL COLOR CLR_BLUE


   @ 45,10 SAY OS05_C PROMPT "ENDEREÇO:" SIZE 70,10 OF ODLG_c PIXEL COLOR CLR_BLUE


   @ 60,10 SAY OS05_C PROMPT "NÚMERO:" SIZE 40,10 OF ODLG_c PIXEL COLOR CLR_BLUE


   @ 85,10 SAY OS05_C PROMPT "COMPLEMENTO:" SIZE 45,10 OF ODLG_c PIXEL COLOR CLR_BLUE


   @ 100,10 SAY OS06_C PROMPT "BAIRRO:" SIZE 25,10 OF ODLG_c PIXEL COLOR CLR_BLUE


   @ 115,10 SAY OS07_C PROMPT "CIDADE:" SIZE 30,10 OF ODLG_c PIXEL COLOR CLR_BLUE


   @ 130,10 SAY OS08_C PROMPT "UF:" SIZE 20,10 OF ODLG_c PIXEL COLOR CLR_BLUE


   ne_c:=space(50)

   ce_c:=space(9)

   en_c:=space(50)

   nu_c:=space(10)

   cpl_c:=space(50)

   ba_c:=space(35)

   cd_c:=space(35)

   UF_C:=SPACE(2)


   @ 14,60 GET OG04_C VAR NE_C SIZE 200,10 OF ODLG_C PIXEL


   @ 29,60 GET OG05_C VAR CE_C PICTURE "99999-999" SIZE 37,10 OF ODLG_C PIXEL


   @ 28,99 BUTTON o_BUSCA PROMPT "BUSCA CEP" of odlg_C pixel size 40,12 ;

           action b_cep_c(@og06_c,@og09_c,@og10_c,@og11_c,@ce_c,@og07_c)


   O_busca:CTOOLTIP:="Busca os Dados do CEP na InterNet"

   o_busca:oCursor:=oCursor

   o_busca:CVARNAME:="BUSCAR"


   @ 44,60 GET OG06_C VAR EN_C SIZE 200,10 OF ODLG_C PIXEL


   @ 59,60 GET OG07_C VAR NU_C PICTURE "XXXXXXXXXX" SIZE 40,10 OF ODLG_C PIXEL


   @ 84,60 GET OG08_C VAR CPL_C SIZE 100,10 OF ODLG_C PIXEL


   @ 99,60 GET OG09_C VAR BA_C SIZE 80,10 OF ODLG_C PIXEL


   @ 114,60 GET OG10_C VAR CD_C SIZE 80,10 OF ODLG_C PIXEL


   @ 129,60 GET OG11_C VAR UF_C PICTURE "AA" SIZE 20,10 OF ODLG_C PIXEL ;

            VALID alltrim(UPPER(UF_C))$upper(Tb_UF) .OR. ;

                  OG11_C:NLASTKEY=38 .OR. OG11_C:NLASTKEY=9


   ACTIVATE DIALOG ODLG_c CENTERED


RETURN .T.



FUNCTION B_CEP_C(oEndere1,oBairro1,oCidade1,oEstado1,cCep,oNumero)


   local oPg, cBuf,cResult, error_net,oerror


   local cUr2 :="http://m.correios.com.br/movel/buscaCepConfirma.do?cepEntrada=<"+tira(cCep,"Z")+">&metodo=buscarCep"


   local cMsgSto:="COLOQUE NOME DA SUA EMPRESA"


   CURSOR("AGUARDE")


   if !ISInternet()


      MsgStop("Não Há Coneccão com a INTERNET","SEM SINAL PARA CONECÇÃO")


      CURSORARROW()


      Return(.T.)


   endif


   oPg = CreateObject("Microsoft.XMLHTTP")

   oPg:Open("GET",cUr2,.F.)


   ERROR_NET:=.T.


   Try


     oPg:Send()


   catch oError


     msgstop("ERRO AO CONSULTAR C.E.P..!!!    " + oError:Description + ". FAÇA MANUALMENTE",cMsgsto)


     ERROR_NET:=.F.


   END TRY


   if ERROR_NET==.T.


      cBuf = oPg:ResponseBody

      cResult =substr(cBuf, at('<resultado>',cBuf)+11,1)


      if left(cBuf,2) # "OK"

         ERROR_NET :=.T.

      endif


   endif


   /*

   cen:=substr(cBuf, at('>Logradouro:',     cBuf) + 21, 200)

   cen:=substr(cen, at('respostadestaque',     cen) + 18, at('</span>', cen)-(at('respostadestaque', cen) + 19))

   */


   /*

   Kapiaba,

   favor alterar o valor de 200 para 250, na linha que apura o endereço: variável CEN


   assim:

   */


   cen:=substr(cBuf, at('>Logradouro:',     cBuf) + 21, 250)

   cen:=substr(cen, at('respostadestaque',  cen) + 18, at('</span>', cen)-(at('respostadestaque', cen) + 19))


   // Assim, vai dar certo.


   cba:=substr(cBuf, at('>Bairro:',     cBuf) + 17, 150)

   cba:=substr(cba, at('respostadestaque',     cba) + 18, at('</span>', cba)-(at('respostadestaque', cba) + 18))


   cci:=substr(cBuf, at('Localidade',    cBuf) + 23, 250)

   cci:=substr(cci, at('respostadestaque',     cci) + 18, at('</span>', cci)-(at('respostadestaque', cci) + 18))

   CCI:=ALLTRIM(CCI)


   ccp:=substr(cBuf, at('>CEP:',     cBuf) + 14, 100)

   ccp:=substr(ccp, at('respostadestaque',     ccp) + 18, at('</span>', ccp)-(at('respostadestaque', ccp) + 18))


   cuf:=RIGHT(CCI,LEN(CCI)-at('/', cci))

   cci:=left(CCI,LEN(CCI)-at('/', cci))


   IF LEN(ALLTRIM(CUF))>1


      oEstado1:Varput(substr(alltrim(sAcento(upper(cuf)))+space(2),1,2))


   ENDIF


   IF LEN(ALLTRIM(CCI))>2


      oCidade1:Varput(substr(alltrim(sAcento(upper(cCi)))+space(35),1,35))


   ENDIF


   IF LEN(ALLTRIM(CBA))>2


      oBairro1:Varput(substr(alltrim(sAcento(upper(cBa)))+space(35),1,35))


   ENDIF


   IF LEN(ALLTRIM(CEN))>2


      oEndere1:Varput(substr(alltrim(sAcento(upper(cen)))+space(60),1,60))


   ENDIF


   oEstado1:Refresh()

   oCidade1:Refresh()

   oBairro1:Refresh()

   oEndere1:Refresh()

   oNumero:Setfocus()


   CURSORARROW()


return(.T.)


static function sAcento(cTes)


   cTes =strtran(cTes,'ã','Ã')

   cTes =strtran(cTes,'á','Á')

   cTes =strtran(cTes,'â','Â')

   cTes =strtran(cTes,'é','É')

   cTes =strtran(cTes,'ê','Ê')

   cTes =strtran(cTes,'õ','Õ')

   cTes =strtran(cTes,'ó','Ó')

   cTes =strtran(cTes,'ô','Ô')

   cTes =strtran(cTes,'ç','Ç')

   cTes =sTrtran(cTes,'ú','Ú')

   cTes =sTrtran(cTes,'ü','Ü')

   cTes =strtran(cTes,'í','Í')


Return cTes


FUNCTION TIRA


   PARAMETERS FF,GG


   FF=ALLTRIM(FF)


   N0    = ""

   MAIS := "N"


   FOR I=1 TO LEN(FF)


      IF SUBSTR(FF,I,1)$"QWERTYUIOPASDFGHJKLZXCVBNMÇ"

         MAIS="S"

      ENDIF


   NEXT


   FOR I=1 TO LEN(FF)

      AA=SUBSTR(FF,I,1)


      IF GG="S"


         pos:=at(AA,"ÁÉÍÓÚáéíóúÇç")


         if pos>0


            AA:=SUBSTR("AEIOUaeiouCc",pos,1)


         endif


         N0:=N0+AA


      ENDIF


      IF GG="Z" .AND. AA$"0123456789"


         N0:=N0+AA


      ENDIF


   NEXT I


RETURN(N0)


// FIM

Very Thanks

kapiaba · January 21, 2015

O correto é aqui?



   local cUr2 :="http://m.correios.com.br/movel/buscaCepConfirma.do?cepEntrada=<"+HTML_TO_ANSI(cCep,"Z")+">&metodo=buscarCep"

//   local cUr2 :="http://m.correios.com.br/movel/buscaCepConfirma.do?cepEntrada=<"+TIRA(cCep,"Z")+">&metodo=buscarCep"

nenhum dos dois comandos tirou a acentuação.

Se é que eu entendi...

abs.

Euclidao · January 21, 2015

Kapi, funciona também com Harbour 3.2

(nas versões anteriores, devolvia um ARRAY em cResult)

No programa:

/// ISTO NAO FUNCIONA NAS NOVAS VERSOES

deve ser corrigido para:

@ 5,5 GROUP TO 150,268 LABEL " Cliente " OF ODLG_c PIXEL

Para mim, pelo menos "SÂO PAULO" está saindo certo...

QCoisa, grite... Euclies

kapiaba · January 21, 2015

Só uma mudancinha para que não se morra de raiva no looping.



//----------------------------------------------------------------------------//

//

// Autor:    Eduardo de Camargo Bilato(EBL)

// Objetivo: Utilizar webservice dos correios para buscar cep/endereço

//

//----------------------------------------------------------------------------//


#Include "FiveWin.Ch"


#DEFINE ILF CHR(13)+CHR(10)


Function Cep( cCep )


local oCep

local xCep := padr( if( cCep <> nil,cCep,'' ),60 )


while .t.


   msgget( 'Busca CEP','Informe o CEP/Endereço desejado:',@xCep )


   if empty( xCep )

      exit

   endif


   oCep := TBusca_Cep():New( xCep )


   oCep:End()


   xCep := space(60)


enddo


Return Nil


//----------------------------------------------------------------------------//


*------------------------------------------------------------------------------------------------

*  Classe    TBusca_Cep

*  Data      10/03/2014

*  Autor     EBL

*  Objetivo  Utiliza WebService para obter Cep

*-------------------------------------------------------------------------------------------------


CLASS TBusca_Cep


   DATA cCep

   DATA cTitulo

   DATA cEndereco

   DATA cBairro

   DATA cCidade

   DATA cUF

   DATA oXmlHttp


   DATA nCont

   DATA aResp


   DATA cTag1 AS CHARACTER INIT '<span class="resposta'

   DATA cTag2 AS CHARACTER INIT '</span>'

   DATA cTag3 AS CHARACTER INIT 'destaque">'


   DATA cBuffer  AS CHARACTER INIT ''


   METHOD New( xCep ) CONSTRUCTOR


   METHOD Load()


   METHOD Quebra_String( cBuff )


   METHOD End()


ENDCLASS


//----------------------------------------------------------------------------//


METHOD New( xCep ) CLASS TBusca_Cep


::cCep      := xCep

::cTitulo   := space(20)

::cEndereco := space(60)

::cBairro   := space(40)

::cCidade   := space(60)

::cUF       := space(02)


::nCont     := 0

::aResp     := {}


if ::cCep <> NIL

   Self:Load()

endif


return Self


//----------------------------------------------------------------------------//


METHOD Load() CLASS TBusca_Cep


local nCnt  := 0

local nCn1  := 0

local nSeq  := 1

local nAux  := 0

local nPag  := 0


local aBuff := {}, nKey := VK_RETURN

local cLink := ''

local cLin0 := 'http://m.correios.com.br/movel/buscaCepConfirma.do?cepEntrada='+::cCep+'&metodo=buscarCep'

local cLin1 := 'http://m.correios.com.br/movel/buscaCepConfirma.do?cepEntrada='+::cCep+'&metodo=proximo&numPagina='


local nMaxPag := 1


for n1 := 1 to int( nMaxPag ) step 10


   SysRefresh()


   nPag++


   if nPag == 1

      cLink := cLin0

   else

      cLink := cLin1+alltrim(str(nPag-1))

   endif


   ::oXmlHttp := CreateObject( "Microsoft.XMLHTTP" )


   if ::oXmlHttp <> nil


      ::oXmlHttp:Open( 'GET',cLink,.f. )


      ::oXmlHttp:Send()


      ::cBuffer := strtran( ::oXmlHttp:ResponseBody,CHR(13),'' )


      aBuff := hb_aTokens( ::cBuffer,CHR(10) )


   else

      exit

   endif


   SysWait(1)


   ::nCont := 0

   ::aResp := {}


   for wx:=1 to len( aBuff )


      if empty( aBuff[wx] )

         loop

      endif


      //são 10 registros por página

      if nPag == 1


         nAux := Busca_Limit( aBuff[wx] )


         if nAux > 0

            nMaxPag := nAux

         endif


      endif


      ::Quebra_String( aBuff[wx] )


   next


   for xx:=1 to len( ::aResp )


      nCn1++


      if nCn1%2 == 0

         if nCnt == 0

            ::cEndereco := ::aResp[xx]

            nCnt++

         elseif nCnt == 1

            ::cBairro := ::aResp[xx]

            nCnt++

         elseif nCnt == 2

            ::cCidade := ::aResp[xx]

            nCnt++

         elseif nCnt == 4

            ::cCep := ::aResp[xx]

            nCnt++

         endif

         nCn1 := 0

      elseif nCnt == 3

         ::cUF := ::aResp[xx]

         nCnt++

         nCn1 := 0

      endif


      if nCnt == 5


         nAux := at( ' ',::cEndereco )

         if nAux > 0

            ::cTitulo := left( ::cEndereco,nAux-1 )

            ::cEndereco := substr( ::cEndereco,nAux+1 )

         endif


         ? 'Sequência: ' + alltrim(str(nSeq)) ;

         ,                                    ;

         , 'Cep: '       + ::cCep             ;

         , 'Titulo: '    + ::cTitulo          ;

         , 'Endereço: '  + ::cEndereco        ;

         , 'Bairro: '    + ::cBairro          ;

         , 'Cidade: '    + ::cCidade          ;

         , 'UF: '        + ::cUF


         nCnt := 0

         nSeq++


         // PARA SAIR DO LOOPING ETERNO... 21/01/2015

         DO CASE

         CASE nKey == VK_ESCAPE .OR. GETKEYSTATE( VK_ESCAPE ) .OR. ;

              LASTKEY() = VK_ESCAPE


            ::oXmlHttp:Abort()


            EXIT


         ENDCASE


      endif


   next


   // PARA SAIR DO LOOPING ETERNO... 21/01/2015 - PARA NAO MORRER DE RAIVA.

   DO CASE

   CASE nKey == VK_ESCAPE .OR. GETKEYSTATE( VK_ESCAPE ) .OR. ;

        LASTKEY() = VK_ESCAPE


      ::oXmlHttp:Abort()


      EXIT


   ENDCASE


   ::oXmlHttp:Abort()


next


if nSeq == 1

   msginfo( 'CEP não encontrado','Busca' )

endif


return


//----------------------------------------------------------------------------//


METHOD Quebra_String( cBuff ) CLASS TBusca_Cep


local nIni     := 0

local nFim     := 0


local uDado    := ''

local xString  := ''


for xx:=1 to len( cBuff )


   uDado += substr( cBuff,xx,1 )


   //evitar que o programa se perca na separação dos resultados

   if 'Cliente:' $ uDado .or.;

      'Unidade:' $ uDado

      nIni := 0

      nFim := 0

      ::nCont := 0

      loop

   endif


   if ( ::cTag1 $ uDado ) .or. ( ::cTag3 $ uDado )

      uDado := ''

      nIni  := xx

      ::nCont := 1

   elseif ( ::cTag2 $ uDado )

      uDado := ''

      nFim  := xx-len(::cTag2)

      ::nCont := 2

   endif


   if nIni > 0 .and. nFim > 0


      xString := Limpa_Leitura( substr( cBuff,nIni,nFim ) )


      aadd( ::aResp,xString )


      nIni := 0

      nFim := 0


      ::nCont := 0


   endif


next


uDado := alltrim(uDado)


if ::nCont == 1 .and. !empty(uDado)


   if !('Cliente:' $ uDado)


      uDado := Limpa_Leitura( uDado )


      aadd( ::aResp,uDado )


   endif


endif


return


//----------------------------------------------------------------------------//


METHOD End() CLASS TBusca_Cep


Self := nil


return


//----------------------------------------------------------------------------//


static Function Busca_Limit( cBuff )


local nRegistros := 0


local nAt  := at( '<input type="hidden" name="regTotal" value="',cBuff )

local cStr := cBuff


if nAt > 0


   cStr := substr( cStr,nAt+44 )


   nAt := at( '">',cStr ) - 1


   nRegistros := val( left( cStr,nAt ) )


endif


Return nRegistros


//----------------------------------------------------------------------------//


static Function Limpa_Leitura( cText )


local oCep     := TBusca_Cep():new()

local cNewText := alltrim( cText )


cNewText := strtran( cNewText,oCep:cTag1,'' )

cNewText := strtran( cNewText,oCep:cTag2,'' )

cNewText := strtran( cNewText,oCep:cTag3,'' )

cNewText := strtran( cNewText,'/'       ,'' )

cNewText := strtran( cNewText,'<br>'    ,'' )

cNewText := strtran( cNewText,'>'       ,'' )


Return cNewText


//----------------------------------------------------------------------------//


static Function LerBuffer( cTexto,cStri1 )


local nPos1 := 0

local nPos2 := 0

local cRetor := ""


local cStri2 := Stuff( cStri1,2,0,'/' )


if Upper( cStri1 ) $ Upper( cTexto )


   nPos1 := At( Upper( cStri1 ),Upper( cTexto ) ) + Len( cStri1 )

   nPos2 := At( Upper( cStri2 ),Upper( cTexto ) )


   if nPos1 == 0

      cRetor := ''

   elseif nPos2 == 0

      cRetor := SubStr( cTexto,nPos1 )

   else

      cRetor := SubStr( cTexto,nPos1,nPos2-nPos1 )

   endif


endif


Return( cRetor )


//----------------------------------------------------------------------------//

Eduardo Bilato · January 22, 2015

Bom dia Kapi

Na verdade não é um loop eterno, é o número dos ceps retornados para determinada faixa de cep pesquisado, num cep específico a mensagem só é exibida uma única vez.

Como algumas faixas de cep tem mais de 100 resultados, a mensagem vai aparecer para os mais de 100 ceps listados... aí estressa mesmo huahuaha

Essa rotina foi um teste que fiz pra saber como funcionava esse webservice, mas o retorno da rotina não precisa ser necessariamente uma mensagem para cada cep, pode ser um array de cep, uma listagem. É só ajustar pra retornar "o que ocê querê", o esqueleto já tá aí

Marca · July 3, 2015

Ola

Esta consulta ao site dos correios parece não estar mais funcionando

Quem utiliza poderia nos dizer ?

kapiaba · July 3, 2015

Eduardo, que houve, não está mais funcionado.

Acho que mudou o Link:

http://m.correios.com.br/movel/buscaCep.do

Confirma Eduardo?

rochinha · July 3, 2015

Amiguinhos,

Todos os sites tem recursos de verificação de hits e acessos e quando o site dos correios verificar um montante vindo de um único lugar eles tomam providencias.

O canal seria tentar juntar os nossos arquivos de CEP para obter um mais coeso o possível.

Algo como "Mostra-seu-que-eu-mostro-o-meu"

O meu tem 653.239 registros.

miragerr · July 4, 2015

Ola... Boa noite

Tenho um em SQL que tem mais de 805 mil registros... é de 2009 se não me engano.

Qualquer coisa estamos a disposição.

oribeiro · July 4, 2015

Baixe em: www.oasysitu.com/util/cepbr.exe

É um instalador do CEP.Dbf de todo o Brasil

kapiaba · July 6, 2015

Baixe em: www.oasysitu.com/util/cepbr.exe

É um instalador do CEP.Dbf de todo o Brasil

Oscar, o seu está desatualizado. E quando não se acha no CEP.DBF, dispara-se para os correios, pega-se o CEP e guarda para ir atualizando. abs.

Marca · July 7, 2015

Temos que trocar o topico do post para :

Busca CEP Quase infalível...

Rssss

oribeiro · July 17, 2015

Esses três servidores pararam de funcionar:

      if     nServ=1 // Tenta primeiro na "republica virtual"
         cUrl  :="http://republicavirtual.com.br/web_cep.php?cep=" + cCEP // cUrl  :="http://cep.republicavirtual.com.br/web_cep.php?cep="+ cCep +"&formato=xml"
         cServ :="República Virtual"
         cResOk:="sucesso"
         nServ :=nServ+1
      elseif nServ=2 // Tenta primeiro na "ceplivre"
         cUrl  :="http://ceplivre.pc2consultoria.com/index.php?module=cep&formato=xml&cep=" + Left(cCep,5)+"-"+Right(cCep,3)
         cServ :="Cep Livre"
         cResOk:="sucesso>1"
         nServ :=nServ+1
      else           // Depois tenta no "buscarcep" que é pago
         cUrl  :="http://www.buscarcep.com.br/?cep="+ cCep +"&formato=xml"
         cServ :="BuscarCep"
         cResOk:="sucesso"
         nServ :=999 // último recurso
      endif

Alguém conhece outro gratuito?

Eduardo Bilato · July 20, 2015

Bom dia Kapi

Eles mudaram o mecanismo de busca do webservice... talvez seja algo relacionado ao que o Rochinha disse

Inclusive não tem mais aquela opção de "lista de Ceps", só busca cep com 8 dígitos...

Uma pena isso pois era um serviço gratuito e oficial, então os dados eram confiáveis

dorneles · July 20, 2015

Olá

Estou utilizando esse, sem problema.

oHttp:= TIpClientHttp():new( "http://cep.republicavirtual.com.br/web_cep.php?cep="+::cCep+"&formato=xml")

Busca CEP infalível

Recommended Posts

Link to comment

Share on other sites

Link to comment

Share on other sites

Link to comment

Share on other sites

Link to comment

Share on other sites

Link to comment

Share on other sites

Link to comment

Share on other sites

Link to comment

Share on other sites

Link to comment

Share on other sites

Link to comment

Share on other sites

Link to comment

Share on other sites

Link to comment

Share on other sites

Link to comment

Share on other sites

Link to comment

Share on other sites

Link to comment

Share on other sites

Link to comment

Share on other sites

Link to comment

Share on other sites

Link to comment

Share on other sites

Link to comment

Share on other sites

Link to comment

Share on other sites

Link to comment

Share on other sites

Link to comment

Share on other sites

Link to comment

Share on other sites

Link to comment

Share on other sites

Link to comment

Share on other sites

Link to comment

Share on other sites

Join the conversation