CEP dos correios on line

[JoséQuintas]

Acabo de liberar meu webservice que permite consultar os correios on line.
Por precaução, vou manter uma base de dados, e só consultar os correios se a informação for antiga.
Por enquanto a base tem 1 único CEP, mas vai ser atualizada a cada nova consulta.
Acredito que não vá sobrecarregar meu tráfego, então estou liberando geral.

www.jpatecnologia.com.br/cep.asp?cep=00000-000

o resultado será em html
<cep>00000-000</cep>
<endereco>xxxx</endereco>
<cidade>xxx</cidade>
<uf>xx</uf>
<infinc>9999/99/99 99:99</infinc>

Só pra lembrar....
Se formos pegar todos os CEPs possívels, de 1 a 99999-999, 1 por segundo, demoraria 1 ano pra fazer isso, e no final, o primeiro CEP já estaria um ano velho.
Tentar isso só faria com que os correios bloqueassem o recurso.
Então façam consultas normalmente sem abuso, pra termos isso sempre.

Coloquei só um prazo de validade em cada cep, assim reduz o acesso aos correios.
Só vai pesquisar um CEP se ele for antigo no banco de dados.
Por enquanto a base tem 1 CEP, só o que eu consultei durante os testes.
Portanto, começa sendo tudo on-line, direto dos correios.
E é direto dos correios mesmo.
Eu usava o da republicavirtual.com.br, mas descobri que é base antiga. Pesquisei e encontrei o mapa da mina.

Depois vou subir uma base que consegui mais atualizada, mas não vai fazer diferença nas consultas.
Como vai entrar com data 0000/00/00, só vai servir como reserva, se a dos correios falhar ou for bloqueada.
Por enquanto se a dos correios falhar, não vai ter nada, só o que tiver sido consultado até o dia.
Divirtam-se.

[marcos.gurupi]

Excelente! Parabens!

Mas o retorno nao traz tb o codigo do ibge?

[JoséQuintas]

Não. Só consegui o mais difícil.
O mais fácil fica com a tabela da Fazenda.... rs

[JoséQuintas]

Atualização no webservice:
1) Subi uma base de CEPs que parece ser de março deste ano, e deixei como data 0000/00/00, pra ser usada só em caso de erro no correio.

2) Reduzi o tempo de atualização da base para 30 dias (cada novo cep consultado e salvo na base, só será consultado 30 dias depois)

3) Não estava tratando corretamente quando o retorno do correio não tinha logradouro, e era CEP de cidade.
Como falhava na hora de pegar retorno do correio nessa situação, usava a informação do banco de dados.
Agora ok.

Não sei que outras situações poderão acontecer....
Parece que CEP de caixa postal vém diferente, mas só vou saber se aparecer e alguém avisar.

Obs.
Teoricamente não precisaria do limite de 30 dias, já que funciona on-line nos correios, mas.. melhor evitar sobrecarregar.

[Abel]

JoseQuintas,
que legal, parabens.

Agora como é que eu pego o retorno em html e uso no meu sistema e for necessario ?

Abracos,
ABEL

[JoséQuintas]

Abaixo a rotina que eu usava em Clipper.
Estou enxugando nesta postagem, então pode conter erros.
Em Harbour dá pra ser mais direto.
Obs. A rotina RunVbs() serve pra baixar arquivo, e retorna texto ou nome do arquivo.

Código: Selecionar todos

Function CepOk(mCep, mEndereco, mBairro, mCidade, mUf, mAltera)
Local mTexto := ""
mAltera := iif(mAltera==NIL,.f.,mAltera)
If " " $ mCep .Or. .Not. "-" $ mCep
   Return .t.
Endif
If mAltera
   Mensagem("Consultando CEP nos correios, ESC abandona")
   mTexto := RunVbs("T","http://www.jpatecnologia.com.br/cep.asp?cep=" + mCep  // cep com traço 00000-000
   mTexto := Upper(mTexto)
   mUf         := Pad(PegaXml("uf",mTexto),2)
   mCidade     := Pad(PegaXml("cidade",mTexto),Len(mCidade))
   mBairro     := Pad(PegaXml("bairro",mTexto),Len(mBairro))
   mLogradouro := Pad(PegaXml("logradouro",mTexto),Len(mLogradouro))
Endif
Return .t.

Function PegaXml(mTag,mTexto)
Local mTagIni, mTagFim, mResultado
mTag := Upper(mTag)
mTagIni := "<" + Upper(mTag) + ">"
mTagFim := "</" + Upper(mTag) + ">"
mResultado := Substr(mTexto,At(mTagIni,mTexto))
mResultado := Substr(mResultado,Len(mTagIni)+1)
mResultado := Substr(mResultado,1,At(mTagFim,mResultado)-1)
mResultado := Upper(mResultado)
Return mResultado

Function RunVbs(mTipo,mtxtScript)
Local mFIleResp, mTexto, mInkey, mSeconds, mSelect, mTmpVbs
mTmpVbs := "consultacep.vbs"
mFileResp := "resposta.txt"
Set Alternate To (mTmpVbs)
Set Alternate On
Set Console Off
?? [const adTypeBinary = 1]
? [const adSaveCreateOverwrite = 2]
? [const adModeReadWrite = 3]
? [sSource = "] + mTxtScript + ["]
? [sDest = "] + mFileResp + ["]
? [set oHTTP = CreateObject("Microsoft.XMLHTTP")]
? [oHTTP.open "GET", sSource, False]
? [oHTTP.send]
? [set stream = createobject("adodb.stream")]
? [stream.type = adTypeBinary]
? [stream.mode = adModeReadWrite]
? [stream.open]
? [stream.write oHTTP.responsebody]
? [stream.savetofile sDest, adSaveCreateOverwrite]
? [stream.close]
? [set oHTTP = Nothing]
? [set stream = nothing]
Set Alternate Off
Set Alternate To
wSave()
Run ("wscript " + mTmpVbs)
mInkey := 0
Do While mInkey != 27 .And. .Not. File(mFileResp)
   mInkey := MyInkey(1)
Enddo
wRestore()
If File(mFileResp)
   If mTipo == "T"
      mTexto := MemoRead(mFileResp) // Texto
      fErase(mFileResp)
   Else
      mTexto := mFileResp // Arquivo
   Endif
Else
   mTexto := ""
Endif
fErase(mTmpVbs)
Return mTexto

[Jairo Maia]

Olá José,

Está funcionando tudo direitinho, inclusive com CEP de Caixa Postal. A diferença é que no republicavirtual CEP de Caixa Postal retorna também a Rua e número, o que não tem implicação nehuma, já que na etiqueta o endereço de Caixa Postal precisa apenas:

- Caixa Postal
- Cidade
- Estado
- CEP

Realmente a base de dados é bem mais atualizada. Aqui na região de Campinas, no fim do ano passado as ruas de Paulínia passaram a ter CEPs por rua, e desatualizados no site republicavirtual.

Sua idéia de disponibilizar esse serviço qual seria exatamente? Por exemplo, eu poderia usar a consulta através do seu site nos sistemas dos clientes?

A idéia seria continuar usando o republicavirtual, e no caso de logradouro vazio, faria a pesquisa pelo seu site, e consideraria o retorno que estive mais completo.

[JoséQuintas]

Antigamente nesse webservice eu usava o república virtual, até descobrir que não é online.

É simples: o webservice atualiza minha base de dados, quanto mais consultas mais atualizada vai ficar minha base. As consultas são realmente on-line nos correios.

A base mysql é usada só pra reduzir as consultas on-line, evitando consultar o mesmo cep várias vezes seguidas.

É só não abusar que tem consulta pra sempre.
E se os correios bloquearem, a base mysql já começou mais atualizada que o república virtual, então não vai ser problema.

Note a data/hora retornada: é a data/hora real (do servidor) em que a consulta foi feita nos correios. Isso fica gravado na base de dados pra ver a validade da consulta. A consulta de um CEP se mantém por 30 dias antes de consultar novamente nos correios.

[ANDRIL]

Bom dia José.
Utilizando sua consulta de CEP o retorno obtido (os dados) estão em codificação UTF-8, sendo assim, não estamos conseguindo usar a função de conversão para OEM postada neste topico https://pctoledo.org/forum/viewto ... =43&t=4374 para uso em clipper puro. Voce saberia atraves do Asp alguma função para ja trazer as informacoes sem acentuação no retorno da consulta? Ou atraves do wscript fazer a conversão do arquivo, até tentei, mais conheço muito pouco. Veja o arquivo em .vbs

Código: Selecionar todos

const adTypeBinary = 1
const adTypeText = 2
const adSaveCreateOverwrite = 2
const adModeReadWrite = 3
sSource = "http://www.jpatecnologia.com.br/cep.asp?cep=08485-010"
sDest = "c:\temp\resposta.txt"
set oHTTP = CreateObject("Microsoft.XMLHTTP")
oHTTP.open "GET", sSource, False
oHTTP.send
set stream = createobject("adodb.stream")
stream.type = adTypeBinary
stream.mode = adModeReadWrite
stream.open
stream.write oHTTP.responsebody
stream.savetofile sDest, adSaveCreateOverwrite
stream.close
set oHTTP = Nothing
set stream = nothing

' aqui deveria criar o arquivo convertido

Const adSaveCreateNotExist = 1
Const CdoUS_ASCII = "us-ascii"

sNovo = "c:\temp\resposta.and"
Set obj = createobject("adodb.stream")
obj.Open
obj.Position = 0
obj.LoadFromFile sDest
obj.Charset = CdoUS_ASCII
obj.Type = adTypeText
obj.SaveToFile sNovo, adSaveCreateOverWrite
obj.Close
set obj = Nothing

Abraços.

[JoséQuintas]

o UTF-8 é resultado da página de internet.
Procurei manter o resultado original igual o correio no webservice. Aqui uso tudo em maiúsculas e sem acento.
Sempre tem o jeito tradicional:

Código: Selecionar todos

Function TiraAcento(mTexto)
Local mLetras := {}
Local nCont := 0
Local nPosicao := 0
Aadd( mLetras, { "€", "C" } )
Aadd( mLetras, { "‡", "C" } )
Aadd( mLetras, { " ", "A" } )
Aadd( mLetras, { "µ", "A" } )
Aadd( mLetras, { "Æ", "A" } )
Aadd( mLetras, { "Ç", "A" } )
Aadd( mLetras, { "¡", "I" } )
Aadd( mLetras, { "Ö", "I" } )
Aadd( mLetras, { "¢", "O" } )
Aadd( mLetras, { "à", "O" } )
Aadd( mLetras, { "£", "U" } )
Aadd( mLetras, { "é", "E" } )
Aadd( mLetras, { "‚", "E" } )
Aadd( mLetras, { "", "E" } )
Aadd( mLetras, { "º", "." } )
Aadd( mLetras, { "'", " " })
Aadd( mLetras, { "ã", "A" } )
Aadd( mLetras, { "á", "A" } )
Aadd( mLetras, { "ç", "C" } )
Aadd( mLetras, { "é", "E" } )
Aadd( mLetras, { "ê", "E" } )
Aadd( mLetras, { "í", "I" } )
Aadd( mLetras, { "ó", "O" } )
Aadd( mLetras, { "ô", "O" } )
Aadd( mLetras, { "ú", "U" } )
Aadd( mLetras, { "â", "A" } )
Aadd( mLetras, { "Á", "A" } )
Aadd( mLetras, { "õ", "O" } )
Aadd( mLetras, { "É", "E" } )
Aadd( mLetras, { "Í", "I" } )
Aadd( mLetras, { "Ç", "C" } )
Aadd( mLetras, { "Ê", "E" } )
Aadd( mLetras, { "Ó", "O" } )
Aadd( mLetras, { "Ô", "O" } )
Aadd( mLetras, { "Õ", "O" } )
Aadd( mLetras, { "Ú", "U" } )
Aadd( mLetras, { "¥", "N" } )
Aadd( mLetras, { "Ã", "A" } )
Aadd( mLetras, { "Á", "A" } )
Aadd( mLetras, { "Â", "A" } )
Aadd( mLetras, { "À", "A" } )
Aadd( mLetras, { "â", "A" } )
Aadd( mLetras, { "Ü", "U" } )
Aadd( mLetras, { "ü", "U" } )
Aadd( mLetras, { "+", " " } )
Aadd( mLetras, { "`", " " } )
Aadd( mLetras, { "Ñ", "N" } )
Aadd( mLetras, { "È", "E" } )
Aadd( mLetras, { "ª", "A" } )
Aadd( mLetras, { "º", "O" } )
Aadd( mLetras, { "ª", "." } )
Aadd( mLetras, { "§", "" } )

For nCont = 1 To Len(mLetras)
   Do While mLetras[nCont,1] $ mTexto
      nPosicao := At(mLetras[nCont,1],mTexto)
      mTexto := Substr(mTexto, 1, nPosicao-1 ) + mLetras[nCont,2] + Substr(mTexto,nPosicao+1)
   Enddo
Next
mTexto := Upper(mTexto) // Acrescentado
Return mTexto

usava no webservice antes:

Código: Selecionar todos

Function TiraAcento( mTexto )
   mTexto = Replace(mTexto, "'", " ")
   mTexto = Replace(mTexto, "ã", "A")
   mTexto = Replace(mTexto, "á", "A")
   mTexto = Replace(mTexto, "ç", "C")
   mTexto = Replace(mTexto, "é", "E")
   mTexto = Replace(mTexto, "ê", "E")
   mTexto = Replace(mTexto, "í", "I")
   mTexto = Replace(mTexto, "ó", "O")
   mTexto = Replace(mTexto, "ô", "O")
   mTexto = Replace(mTexto, "ú", "U")
   mTexto = Replace(mTexto, "â", "A")
   mTexto = Replace(mTexto, "Á", "A")
   mTexto = Replace(mTexto, "õ", "O")
   mTexto = Replace(mTexto, "É", "E")
   mTexto = Replace(mTexto, "Í", "I")
   mTexto = Replace(mTexto, "Ç", "C")
   mTexto = Replace(mTexto, "Ê", "E")
   mTexto = Replace(mTexto, "Ó", "O")
   mTexto = Replace(mTexto, "Ô", "O")
   mTexto = Replace(mTexto, "Õ", "O")
   mTexto = Replace(mTexto, "Ú", "U")
   mTexto = Replace(mTexto, "Ã", "A")
   mTexto = Replace(mTexto, "Á", "A")
   mTexto = Replace(mTexto, "Â", "A")
   mTexto = Replace(mTexto, "À", "A")
   mTexto = Replace(mTexto, "â", "A")
   mTexto = Replace(mTexto, "Ü", "U")
   mTexto = Replace(mTexto, "ü", "U")
   mTexto = Replace(mTexto, "+", " ")
   mTexto = Replace(mTexto, "`", " ")
   mTexto = Replace(mTexto, "Ñ", "N")
   mTexto = Replace(mTexto, "È", "E")
   mTexto = Replace(mTexto, "ª", "A")
   mTexto = Replace(mTexto, "º", "O")
   mTexto = Replace(mTexto,"%D3", "O")
   mTexto = Replace(mTexto, "%E3", "A")
   mTexto = Replace(mTexto, "%E1", "A")
   mTexto = Replace(mTexto, "%E2", "A")
   mTexto = Replace(mTexto, "%ED", "I")
   mTexto = Replace(mTexto, "%EA", "E")
   mTexto = Replace(mTexto, "%C9", "E")
   mTexto = Replace(mTexto, "%E9", "E")
   mTexto = Replace(mTexto, "%F4", "O")
   mTexto = Replace(mTexto, "%F3", "O")
   mTexto = Replace(mTexto, "%F5", "O")
   mTexto = Replace(mTexto, "%FA", "U")
   mTexto = Replace(mTexto, "%27", " ")
   mTexto = Replace(mTexto, "%E7", "C")
   mTexto = Replace(mTexto, "%C2", "A")
   mTexto = Replace(mTexto, "%FC", "U")
   mTexto = Replace(mTexto, "%28", "(")
   mTexto = Replace(mTexto, "%29", ")")
   mTexto = Replace(mTexto, "%C1", "A")
   mTexto = Replace(mTexto, "%CD", "I")
   mTexto = Replace(mTexto, "¦", "A")
   mTexto = Replace(mTexto, "%2C", ",")
   mTexto = Replace(mTexto, "%2F", "/")
   mTexto = Replace(mTexto,Chr(34)," ")
   mTexto = UCase(mTexto)
   TiraAcento = mTexto
End Function

[ANDRIL]

José, copie o código que postou (copiando para o clipboard, copiando direto da página) colando no TextPad e também no EDIT fiz os testes novamente e o resultado foi o "mesmo".

Nos quadros em vermelho estão as letras que foram substituídas pela função TiraAcentos(). Note que em UTF a palavra Igarapé se aberto em windows (notepad por exemplo) aparece certo, agora se
aberto no EDIT aparece Ú. Esse é o problema, por que as funções de troca de acentuação trocam as letras acentuadas pelas suas correspondentes sem acentuação, exemplo é por e, É por E etc. Sendo o Ú trocado por U quando na verdade deveria ser E. Os quadros em verdes a função trocou os espaços pela letra A.

Não sei como estão conseguindo, pois já tentei de todas as formas possíveis aqui, e nada. Talvez se sua função ASP rodar no SERVIDOR já retirando os acentos, funcione. Se possível colocar um segundo parametro na sua url cep.asp?cep=08485-010?removeacento=true assim o servidor já retornaria o resultado limpo se assim o quisermos.

Abraços

[sygecom]

Olá José,
Essa sua busca tem possibilidade de busca também pelo endereço que retorno um vetor com todas as possibilidades de ruas com parte do endereço para poder selecionar o CEP ?

[JoséQuintas]

Desse jeito não.
Mas se fizer alguma coisa sobre isso, implicaria no endereço estar correto inclusive na acentuação.

[ANDRIL]

possível colocar um segundo parametro na sua url cep.asp?cep=08485-010?removeacento=true

José, tem como pelo site ja retirar a acentuação?
No aguardo.

[JoséQuintas]

Andril, pera aí... fiz besteira.
Na hora de postar a função, peguei uma do tempo do Clipper, esqueci que a atual ainda serve.
Aqui exatamente o que uso hoje no Harbour, pelo menos até agora ninguém comentou sobre problemas.
A minha XmlNode() tá complicada. Criei uma simples aqui durante a postagem mas não testei.
Não lembro se tive problema com StrTran(), porque a substituição com StrTran() seria mais rápida.

Código: Selecionar todos

mOperacao="INCLUSAO"
mCep := Space(8)
mEndereco := Space(40)
mNumero := Space(10)
mComplemento := Space(20)
mCidade := Space(30)
mBairro := Space(20)
mUf := Space(2)
@ 1, 0 Say "CEP:" Get mCep Picture "@K 99999-999" Valid CepOk(@mCep,@mEndereco,@mCidade,@mUf,(mOperacao="INCLUSAO"))
@ Row()+1, 0 Say "Endereco:" Get mEndereco
@ Row()+1, 0 Say "Numero:" Get mNumero
@ Row()+1, 0 Say "Complemento:" Get mComplemento
@ Row()+1, 0 Say "Bairro:" Get mBairro
@ Row()+1, 0 Say "Cidade:" Get mCidade
@ Row()+1, 0 Say "UF:" Get mUf
Read



Function CepOk(mCep, mEndereco, mBairro, mCidade, mUf, mPesquisa)
Local mTexto, mInkey, mSeconds
mPesquisa := iif(mPesquisa==NIL,.t.,mPesquisa)
If .Not. mPesquisa
   Return .t.
Endif
mTexto := WebCep(mCep)
mUf       := Pad(XmlNode(mTexto,"UF"),2)
mCidade   := Pad(XmlNode(mTexto,"CIDADE"),Len(mCidade))
mBairro   := Pad(XmlNode(mTexto,"BAIRRO"),Len(mBairro))
mEndereco := Pad(XmlNode(mTexto,"LOGRADOURO"),Len(mEndereco))
Return .t.

Function WebCep(mCep)
Local mTexto
mTexto := DownloadTexto( ;
   "http://www.jpatecnologia.com.br/cep.asp" + ;
   "?cep=" + mCep )
mTexto := Upper(TiraAcento(mTexto))
Return mTexto

Function DownloadTexto(cUrl)
Local oHttp, cRetorno, aRetorno, nCont
cRetorno := ""
Begin Sequence With {|e| Break(e)}
   oHttp := Win_OleCreateObject("MSXML2.ServerXMLHTTP")
   oHttp:Open( "GET", cUrl, .f.)
   oHttp:Send()
   aRetorno := oHttp:ResponseBody()
   cRetorno := ""
   For nCont = 1 To Len(aRetorno)
      cRetorno := cRetorno + Chr(aRetorno[nCont])
   Next
   oHttp:Close()
End Sequence   
Return cRetorno   

Function TiraAcento(mTexto)
Local mLetras := {}
Local nCont := 0
Local nPosicao := 0
Aadd( mLetras, { "€", "C" } )
Aadd( mLetras, { "‡", "C" } )
Aadd( mLetras, { " ", "A" } )
Aadd( mLetras, { "µ", "A" } )
Aadd( mLetras, { "Æ", "A" } )
Aadd( mLetras, { "Ç", "A" } )
Aadd( mLetras, { "¡", "I" } )
Aadd( mLetras, { "Ö", "I" } )
Aadd( mLetras, { "¢", "O" } )
Aadd( mLetras, { "à", "O" } )
Aadd( mLetras, { "£", "U" } )
Aadd( mLetras, { "é", "E" } )
Aadd( mLetras, { "‚", "E" } )
Aadd( mLetras, { "", "E" } )
Aadd( mLetras, { "º", "." } )
Aadd( mLetras, { "'", " " })
Aadd( mLetras, { "ã", "A" } )
Aadd( mLetras, { "á", "A" } )
Aadd( mLetras, { "ç", "C" } )
Aadd( mLetras, { "é", "E" } )
Aadd( mLetras, { "ê", "E" } )
Aadd( mLetras, { "í", "I" } )
Aadd( mLetras, { "ó", "O" } )
Aadd( mLetras, { "ô", "O" } )
Aadd( mLetras, { "ú", "U" } )
Aadd( mLetras, { "â", "A" } )
Aadd( mLetras, { "Á", "A" } )
Aadd( mLetras, { "õ", "O" } )
Aadd( mLetras, { "É", "E" } )
Aadd( mLetras, { "Í", "I" } )
Aadd( mLetras, { "Ç", "C" } )
Aadd( mLetras, { "Ê", "E" } )
Aadd( mLetras, { "Ó", "O" } )
Aadd( mLetras, { "Ô", "O" } )
Aadd( mLetras, { "Õ", "O" } )
Aadd( mLetras, { "Ú", "U" } )
Aadd( mLetras, { "¥", "N" } )
Aadd( mLetras, { "Ã", "A" } )
Aadd( mLetras, { "Á", "A" } )
Aadd( mLetras, { "Â", "A" } )
Aadd( mLetras, { "À", "A" } )
Aadd( mLetras, { "â", "A" } )
Aadd( mLetras, { "Ü", "U" } )
Aadd( mLetras, { "ü", "U" } )
Aadd( mLetras, { "+", " " } )
Aadd( mLetras, { "`", " " } )
Aadd( mLetras, { "Ñ", "N" } )
Aadd( mLetras, { "È", "E" } )
Aadd( mLetras, { "ª", "A" } )
Aadd( mLetras, { "º", "O" } )
Aadd( mLetras, { "ª", "." } )
Aadd( mLetras, { "§", "" } )

For nCont = 1 To Len(mLetras)
   Do While mLetras[nCont,1] $ mTexto
      nPosicao := At(mLetras[nCont,1],mTexto)
      mTexto := Substr(mTexto, 1, nPosicao-1 ) + mLetras[nCont,2] + Substr(mTexto,nPosicao+1)
   Enddo
Next
mTexto := Upper(mTexto) // Acrescentado
Return mTexto

// esta última função não testei, pode precisar ajuste. pega o que estaria entre <endereco> até </endereco>
Function XmlNode(cXml,cTag)
Local nInicio := 0, nFim := 0, nTamanho := 0, cNode := ""
nInicio := At("<" + cTag + ">",cXml)
nFim   := At("</" + cTag + ">",cXml)
If nInicio != 0 .And. nFim != 0
   nInicio := nInicio + Len(cTag) + 2
   cNode := Substr(cXml,nInicio,nFinal-nInicio-1)
Endif
Return cNode