PC Toledo

Enviado: **19 Jul 2012 01:30**

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.

Enviado: **19 Jul 2012 14:44**

Excelente! Parabens!

Mas o retorno nao traz tb o codigo do ibge?

Enviado: **19 Jul 2012 18:42**

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

Enviado: **25 Jul 2012 21:34**

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.

Enviado: **25 Jul 2012 23:29**

JoseQuintas,
que legal, parabens.

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

Abracos,
ABEL

Enviado: **26 Jul 2012 01:25**

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

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.

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.

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.

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

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".
Imagem

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

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 ?

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

ANDRIL escreveu: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.

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

PC Toledo

CEP dos correios on line

CEP dos correios on line

CEP dos correios on line

CEP dos correios on line

CEP dos correios on line

CEP dos correios on line

CEP dos correios on line

CEP dos correios on line

CEP dos correios on line

CEP dos correios on line

CEP dos correios on line

CEP dos correios on line

CEP dos correios on line

CEP dos correios on line

CEP dos correios on line

CEP dos correios on line