Busca CEP no Correio

[oribeiro]

PessoAll,

Eu uso a rotina abaixo para pesquisar um CEP no correio, porém ela parou de funcionar. Acho que houve alguma mudança no site do correio, alguém sabe me informar como corrigir essa função para que ele volte a funcionar?

if cCep<>"00000000"

oCep:=cCep

cUrl:="http://www.correios.com.br/servicos/dnec/consultaLogradouroAction.do?Metodo=listaLogradouro&CEP="+ cCEP + "&TipoConsulta=cep"

oUrl:=turl():New( cUrl )

opg := TipClientHttp():New( oUrl ,.t.)

opg:nConnTimeout := 20000

// ? "Connecting with", oUrl:cServer

if !(opg:Open( cUrl ))

MsgInfo('Não consegui acessar o site dos correios!','OASyS Informação')

else

// ? "abriu"

oPg:Post("?Metodo=listaLogradouro&CEP=" + cCEP + "&TipoConsulta=cep") //ResponseText

// ? "postou 1"

cUrl :="http://www.correios.com.br/servicos/dnec/detalheCEPAction.do?Metodo=detalhe&Posicao=1&TipoCep=2&CEP=$query"

opg:Open( cUrl )

oPg:Post("?Metodo=detalhe&Posicao=1&TipoCep=2&CEP=$query")

// ? "postou detalhamento"

cBuf := opg:readAll()

// ? "leu"

cBuf = Stuff(cBuf,1,at('Logradouro:',cBuf)-87,"")

cBuf = Stuff(cBuf,at('',cBuf)+8,len(cBuf),"")

nPos := at("value",cBuf)+7

cLOG := substr(cBuf, nPos, at('', cBuf, nPos) - nPos)

cBuf := Right(cBuf,Len(cBuf)-nPos)

nPos := at("value",cBuf)+7

cBAI := substr(cBuf, nPos, at('', cBuf, nPos) - nPos)

cBuf := Right(cBuf,Len(cBuf)-nPos)

nPos := at("value",cBuf)+7

cCID := substr(cBuf, nPos, at('/', cBuf, nPos) - nPos)

cUF := substr(cBuf, at('/', cBuf, nPos)+1, 2)

cBuf := Right(cBuf,Len(cBuf)-nPos)

nPos := at("value",cBuf)+7

cCEP := substr(cBuf, nPos, at('', cBuf, nPos) - nPos)

opg:close()

if oCEP == StrTran(cCEP,'-')

msginfo(cLOG+chr(13)+cBAI+chr(13)+cCID+chr(13)+cUF+chr(13)+cCEP,"Encontrei o CEP: "+oCep)

lAchou := .T.

if lCep // Arquivo de CEP aberto

Select &oArquivo

DbSetOrder( 2 ) // CEP

SEEK cCep

IF EOF()

DBAPPEND()

ENDIF

If FnRlock()

cLog = " " + Upper(TrocAcentos(cLog,"WIN"))

cLog = StrTran(cLog,' ALAMEDA ', 'ALAM. ')

cLog = StrTran(cLog,' AVENIDA ', 'AV. ' )

cLog = StrTran(cLog,' ESTRADA ', 'ESTR. ')

cLog = StrTran(cLog,' RODOVIA ', 'ROD. ' )

cLog = StrTran(cLog,' RUA ', 'R. ' )

cLog = StrTran(cLog,' TRAVESSA ', 'TRAV. ')

cLog = Alltrim( cLog )

REPLACE Cep WITH Upper(cCep)

REPLACE Endereco WITH cLog

REPLACE Cidade WITH Upper(TrocAcentos(cCid,"WIN"))

REPLACE Estado WITH Upper(cUF)

REPLACE Compl WITH Upper(TrocAcentos(cBai,"WIN"))

DbCommit()

DbUnlock()

Endif

DBSetOrder( nOrdem )

oLbx:UpStable()

oLbx:Refresh()

endif

else

msginfo('Não encontrei o CEP no site dos correios!',oCep)

endif

endif

endif

id=code>id=code>

Oscar Ribeiroid=size4>

OASyS Informáticaid=blue>id=size4>

Fwh2.4+xHb0.99.60+BCC551+WorkShopid=size1>

[oribeiro]

PessoAll,

Eu uso a rotina abaixo para pesquisar um CEP no correio, porém ela parou de funcionar. Acho que houve alguma mudança no site do correio, alguém sabe me informar como corrigir essa função para que ele volte a funcionar?

if cCep<>"00000000"

oCep:=cCep

cUrl:="http://www.correios.com.br/servicos/dnec/consultaLogradouroAction.do?Metodo=listaLogradouro&CEP="+ cCEP + "&TipoConsulta=cep"

oUrl:=turl():New( cUrl )

opg := TipClientHttp():New( oUrl ,.t.)

opg:nConnTimeout := 20000

// ? "Connecting with", oUrl:cServer

if !(opg:Open( cUrl ))

MsgInfo('Não consegui acessar o site dos correios!','OASyS Informação')

else

// ? "abriu"

oPg:Post("?Metodo=listaLogradouro&CEP=" + cCEP + "&TipoConsulta=cep") //ResponseText

// ? "postou 1"

cUrl :="http://www.correios.com.br/servicos/dnec/detalheCEPAction.do?Metodo=detalhe&Posicao=1&TipoCep=2&CEP=$query"

opg:Open( cUrl )

oPg:Post("?Metodo=detalhe&Posicao=1&TipoCep=2&CEP=$query")

// ? "postou detalhamento"

cBuf := opg:readAll()

// ? "leu"

cBuf = Stuff(cBuf,1,at('Logradouro:',cBuf)-87,"")

cBuf = Stuff(cBuf,at('',cBuf)+8,len(cBuf),"")

nPos := at("value",cBuf)+7

cLOG := substr(cBuf, nPos, at('', cBuf, nPos) - nPos)

cBuf := Right(cBuf,Len(cBuf)-nPos)

nPos := at("value",cBuf)+7

cBAI := substr(cBuf, nPos, at('', cBuf, nPos) - nPos)

cBuf := Right(cBuf,Len(cBuf)-nPos)

nPos := at("value",cBuf)+7

cCID := substr(cBuf, nPos, at('/', cBuf, nPos) - nPos)

cUF := substr(cBuf, at('/', cBuf, nPos)+1, 2)

cBuf := Right(cBuf,Len(cBuf)-nPos)

nPos := at("value",cBuf)+7

cCEP := substr(cBuf, nPos, at('', cBuf, nPos) - nPos)

opg:close()

if oCEP == StrTran(cCEP,'-')

msginfo(cLOG+chr(13)+cBAI+chr(13)+cCID+chr(13)+cUF+chr(13)+cCEP,"Encontrei o CEP: "+oCep)

lAchou := .T.

if lCep // Arquivo de CEP aberto

Select &oArquivo

DbSetOrder( 2 ) // CEP

SEEK cCep

IF EOF()

DBAPPEND()

ENDIF

If FnRlock()

cLog = " " + Upper(TrocAcentos(cLog,"WIN"))

cLog = StrTran(cLog,' ALAMEDA ', 'ALAM. ')

cLog = StrTran(cLog,' AVENIDA ', 'AV. ' )

cLog = StrTran(cLog,' ESTRADA ', 'ESTR. ')

cLog = StrTran(cLog,' RODOVIA ', 'ROD. ' )

cLog = StrTran(cLog,' RUA ', 'R. ' )

cLog = StrTran(cLog,' TRAVESSA ', 'TRAV. ')

cLog = Alltrim( cLog )

REPLACE Cep WITH Upper(cCep)

REPLACE Endereco WITH cLog

REPLACE Cidade WITH Upper(TrocAcentos(cCid,"WIN"))

REPLACE Estado WITH Upper(cUF)

REPLACE Compl WITH Upper(TrocAcentos(cBai,"WIN"))

DbCommit()

DbUnlock()

Endif

DBSetOrder( nOrdem )

oLbx:UpStable()

oLbx:Refresh()

endif

else

msginfo('Não encontrei o CEP no site dos correios!',oCep)

endif

endif

endif

id=code>id=code>

Oscar Ribeiroid=size4>

OASyS Informáticaid=blue>id=size4>

Fwh2.4+xHb0.99.60+BCC551+WorkShopid=size1>

[sygecom]

De uma olhada no link abaixo, venho usando sem problemas.

http://www.pctoledo.com.br/forum/viewtopic.php?f=43&t=9481

Leonardo Machado

Porto Alegre-RS

Hwgui + Mysql / xHarbour 1.0.0

[oribeiro]

Leonardo,

A minha aplicação não cria o objeto MSSOAP. Dá sempre "Não consegui acessar o WEB SERVICE".

Qual é o segredo?

TRY

oSoapClient := CreateObject( "MSSOAP.SoapClient" )

CATCH

TRY

oSoapClient := CreateObject( "MSSOAP.SoapClient" )

CATCH

MsgAlert( "Não consegui acessar o WEB SERVICE.", "Pesquisa CEP")

Return .F.

END

END

id=code>id=code>

Oscar Ribeiroid=size4>

OASyS Informáticaid=blue>id=size4>

Fwh2.4+xHb0.99.60+BCC551+WorkShopid=size1>

[sygecom]

Você viu o segundo post logo abaixo ? onde tem um link que informo que algumas maquinas já não tem mais acesso a SOAP e ai tem que instalar manualmente.

Leonardo Machado

Porto Alegre-RS

Hwgui + Mysql / xHarbour 1.0.0

[oribeiro]

Obrigado.

Oscar Ribeiroid=size4>

OASyS Informáticaid=blue>id=size4>

Fwh2.4+xHb0.99.60+BCC551+WorkShopid=size1>

[aferra]

Olá Oscar, por acaso vc está usando esta solução para pegar os dados do correio??? estou tentando faze-la funcionar mas nada de dar certo....

Alessandroid=blue>

FW9.07+xHb121+PellesC+CDX

Fico feliz com os Meus erros, pois eles me apontam a direção para o acerto.id=red>

[kapiaba]

citação:

Você viu o segundo post logo abaixo ? onde tem um link que informo que algumas maquinas já não tem mais acesso a SOAP e ai tem que instalar manualmente.

Leonardo Machado

Porto Alegre-RS

Hwgui + Mysql / xHarbour 1.0.0

---

id=quote>id=quote>

Bom dia Leonardo, vc. não teria este mesmo exemplo em FIVEWIN?

Abs

João Santos - São Paulo.

kmt_karinha@pop.com.br

joao@pleno.com.br

Fone: (11) 3106-2832 / 8243-5632 - TIM

FWH 2.7 - xHARBOUR WorkShop.Exe

[vagner]

Vixi,

Pessoal, vcs estão desenterrando mensagens ? hehehe

Não se pode mais recuperar os dados do correio, eles bloquearam os acessos, pois agora vendem os dados, existe a consulta on-line, mas para cada uma vc precisa informar os dados

Vagner Wirts

"Ele não sabendo que era impossível, foi lá e fez"

[Theotokos]

Oscar, eu uso este aqui...

FindCep() -> procura pelo CEP

FindCep_Endereco() -> procura pelo Endereco, Bairro, Cidade

*

Este Site permite a consulta gratuita dê uma olhada lá no site explica melhor, se o volume for muito grande de pesquisa ai tem a opção paga...

*

function FindCEP( cCep,ccepa,oJan )

Local oPg, cBuf, tmp, aRet := array(7)

aFill(aRet,'')

cbuf :=space(255)

xcep := (cCep)

mcepa = alltrim(tiratraco(ccepa))

mcepx = alltrim(xcep)

*

If Empty(xCep)

MsgGet( "É Preciso Digitar o Cep","CEP",@xCEP,"BMP\BB20.BMP")

xCep := (xCep)

mcepx = alltrim(xcep)

End

*

*if mcepx <> mcepa

*if mcepx <> "00000000"

if internet_ok("www.terra.com.br",80)

if xCep <> "00000000"

mChaveCep = "cadastre no site para obter a chave"

oPg := CreateObject("Microsoft.XMLHTTP")

xComando:="http://www.buscarcep.com.br/?cep=" + xCEP + "&formato=xml&chave=cadastre no site para obter a chave."

oPg:Open("GET",xComando,.f.)

oPg:Send()

cBuf := oPg:responseBody

if rtrim(substr(cBuf, at('', cBuf)+15, 7)) <> "sucesso"

MsgInfo("CEP não encontrado, favor verificar....","Busca")

cBuf = space(255)

return .t.

endif

endif

*

mestado := ((substr(cBuf, at('', cBuf) + 4, 2)))

mCidade := ((substr(cBuf, at('', cBuf) + 8, at('', cBuf) - (at('', cBuf) + 8))))

mxBairro := ((substr(cBuf, at('', cBuf) + 8, at('', cBuf) - (at('', cBuf) + 8))))

mxEndere := ((substr(cBuf, at('', cBuf) + 17, at('', cBuf) - (at('', cBuf) + 17))))

mxendere += " "+((substr(cBuf, at('', cBuf) + 12, at('', cBuf) - (at('', cBuf) + 12))))

*

mxBairro := HB_OemToAnsi( HB_UTF8ToStr( mxBairro ))

mxEndere := HB_OemToAnsi( HB_UTF8ToStr( mxEndere ))

mCidade := HB_OemToAnsi( HB_UTF8ToStr( mCidade ))

*

if empty(mxEndere)

if MsgYesNo("Cidade sem Logradouro nos Correios, Confirma troca ?")

mEndere := mxendere

mBairro := mxBairro

Else

Return .f.

endif

else

mEndere := mxendere

mBairro := mxBairro

endif

mCod_cidade := upper((substr(cBuf,at('', cBuf) + 28, 07)))

mIbgeUF := upper((substr(cBuf, at('', cBuf)+ 9, 02)))

*

dEndereco := Substr(mEndere+space(40),1,40)

dBairro := Substr(mBairro+space(30),1,40)

dCidade := Substr(mCidade+space(50),1,50)

dEstado := Substr(mestado+space(2),1,2)

dCep := SubStr(xCep,1) // ,5)+"-"+SubStr(xCep,6)

*

oJan:Update()

oJan:Display()

endif

*endif

*endif

return .t.

Function RetAcentoHTML(cStr,lAnsi,lTudo)

DEFAULT lAnsi TO .F.,lTudo TO .T.

IF __ANSI $ cStr

cStr := STRTRAN(cStr,__ANSI,"")

lAnsi := .T.

ENDIF

IF lAnsi

cStr := AnsiToHtml( cStr )

ELSE

cStr := OemToHtml( cStr )

ENDIF

IF !lTudo

cStr := STRTRAN(cStr,"&","&")

cStr := STRTRAN(cStr,"<" ,"<")

cStr := STRTRAN(cStr,">" ,">")

ENDIF

RETURN cStr

Function TiraAcento(xStr)

xStr := StrTran(xStr,"á","a")

xStr := StrTran(xStr,"ã","a")

xStr := StrTran(xStr,"é","e")

xStr := StrTran(xStr,"ó","o")

xStr := StrTran(xStr,"ç","c")

Return(xStr)

Function TiraTraco(xStr)

xStr := StrTran(xStr,"-","")

Return(xStr)

function FindCEP_Endereco( cEndPs, cUFPs, cCidPs, cBaiPs, oJan )

Local oPg, cBuf, tmp, aRet := array(7)

Local oBrwEIP

Local lConcluir := .f.

aFill(aRet,'')

cbuf :=space(255)

*

If Empty(cEndPS)

MsgInfo("É Preciso digitar sempre Dois Campos"+CRLF+;

"Endereço e o Estado"+CRLF+;

"Endereço e a Cidade"+CRLF,"Busca CEP")

Return(.f.)

End

*

if internet_ok("www.terra.com.br",80)

mChaveCep = "cadastre no site para obter a chave"

oPg := CreateObject("Microsoft.XMLHTTP")

xComando:="http://www.buscarcep.com.br/?cep=" + ;

"&logradouro="+cEndPs+"&uf="+cUFPs+"&cidade="+cCidPs+"&bairro="+cBaiPS+"&formato=xml&chave=cadastre no site para obter a chave."

oPg:Open("GET",xComando,.f.)

oPg:Send()

cBuf := oPg:responseBody

*

*

MemoWrit( "XML.TXT", cBuf)

*

xmlDoc := TXmlDocument():New( cBuf )

IF xmlDoc:nStatus != HBXML_STATUS_OK

Msginfo("erro ao ler XML ")

RETURN

ENDIF

oXmlNode := XmlDoc:findFirst( "retorno" )

aCtNode := { }

Do While oXmlNode != Nil

xmlIter := TXmlIterator():New( oXmlNode ) // xmlDoc:oRoot )

xmlNode := xmlIter:Find()

aTmp := { }

DO WHILE xmlNode != NIL

if !empty(xmlNode:cData)

if subs(xmlNode:cData,1,1) # "<"

oCampo := xmlNode:cName

oConteudo:= xmlNode:cData

end

AADD( aTmp, HB_OemToAnsi( HB_UTF8ToStr(oConteudo) ) )

else

oCampo := xmlNode:cName

end

*

xmlNode := xmlIter:Next() // joga pro proximo campo

*

ENDDO

If !Empty(aTmp)

AADD( aCtNode, aTmp )

End

oXmlNode := XmlDoc:findNext()

Enddo

*

If Len(aCtNode) > 0

Define Dialog oDlgExc Title "CEP's Encontrados" From 0,0 To 320,450 Pixel

@ 1, 2 XBROWSE oBrwEIP SIZE 220, 120 UPDATE

oBrwEIP:CreateFromCode()

oBrwEIP:SetArray( aCtNode )

oBrwEIP:aCols[1]:bStrData := {|| aCtNode[oBrwEIP] }

oBrwEIP:aCols[1]:cHeader := "Cep"

oBrwEIP:aCols[1]:nWidth := 70

oBrwEIP:aCols[2]:bStrData := {|| aCtNode[oBrwEIP] }

oBrwEIP:aCols[2]:cHeader := "UF"

oBrwEIP:aCols[2]:nWidth := 25

oBrwEIP:aCols[3]:bStrData := {|| aCtNode[oBrwEIP] }

oBrwEIP:aCols[3]:cHeader := "Cidade"

oBrwEIP:aCols[3]:nWidth := 150

oBrwEIP:aCols[4]:bStrData := {|| aCtNode[oBrwEIP] }

oBrwEIP:aCols[4]:cHeader := "Bairro"

oBrwEIP:aCols[4]:nWidth := 150

oBrwEIP:aCols[5]:bStrData := {|| aCtNode[oBrwEIP]+" "+aCtNode[oBrwEIP] }

oBrwEIP:aCols[5]:cHeader := "Endereco"

oBrwEIP:aCols[5]:nWidth := 350

For nC1 := 06 To Len(oBrwEIP:aCols)

oBrwEIP:aCols[nC1]:Hide()

Next nC1

@ 125,050 BUTTON oBtn PROMPT "TRANSFERIR" SIZE 50, 20 ACTION (lConcluir := .t., oDlgExc:End()) UPDATE OF oDlgExc PIXEL

@ 125,110 BUTTON oBtn PROMPT "Cancelar" SIZE 50, 20 ACTION (lConcluir := .f., oDlgExc:End()) UPDATE OF oDlgExc PIXEL

Activate Dialog oDlgExc Centered

*

IF lConcluir

dEndereco := Substr(aCtNode[oBrwEIP]+" "+aCtNode[oBrwEIP]+space(40),1,40)

dBairro := Substr(aCtNode[oBrwEIP]+space(30),1,40)

dCidade := Substr(aCtNode[oBrwEIP]+space(50),1,50)

dEstado := Substr(aCtNode[oBrwEIP]+space(2),1,2)

dCep := SubStr(aCtNode[oBrwEIP],1,5)+"-"+SubStr(aCtNode[oBrwEIP],6)

End

End

*

oJan:Update()

oJan:Display()

endif

return .t.

id=code>id=code>

Editado por - Theotokos on 21/06/2011 14:20:14

[SISTEMASIT]

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

function FindCEP( cCep ) //devem ser somente os numeros

Local oPg, cBuf, tmp, aRet := array(7)

aFill(aRet,'')

cbuf :=space(255)

xcep := ccep

if isinternet()

if xCep <> "00000000" .and. !empty(xCep)

oPg:=CreateObject("Microsoft.XMLHTTP")

oPg:Open("GET","http://cep.republicavirtual.com.br/web_cep.php?cep=" + xCep + "&formato=xml",.F.)

ErroNET:=.F.

Try

oPg:Send()

catch oError

ErroNET:=.T.

End Try

if !ErroNET

cBuf := oPg:responseBody

if rtrim(substr(cBuf, at('', cBuf), 9)) = ""

exib_alert("CEP não encontrado, Verificar","CEP On-Line")

cBuf = space(255)

end

else

exib_alert("Erro na busca","CEP On-Line")

cBuf = space(255)

end

end

end

mCEPestado = upper(tiraacento(substr(cBuf, at('', cBuf) + 4, 2)))

mCEPCidade = upper(tiraacento(substr(cBuf, at('', cBuf) + 8, at('', cBuf) - (at('', cBuf) + 8))))

mCEPBairro = upper(tiraacento(substr(cBuf, at('', cBuf) + 8, at('', cBuf) - (at('', cBuf) + 8))))

mCEPEndere := upper(tiraacento(substr(cBuf, at('', cBuf) + 17, at('', cBuf) - (at('', cBuf) + 17))))

mCEPendere+= " "+upper(tiraacento(substr(cBuf, at('', cBuf) + 12, at('', cBuf) - (at('', cBuf) + 12))))

return

Rubem Jr

http://sistemasit.com

Belem/PA