mkyx Posted January 19, 2015 Report Share Posted 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 endif cen:=substr(cBuf, at('>Logradouro:', cBuf) + 21, 200) cen:=substr(cen, at('respostadestaque', cen) + 18, at('</span>', cen)-(at('respostadestaque', cen) + 19)) 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) * Ronaldbuch 1 Quote Link to comment Share on other sites More sharing options...
microfly Posted January 19, 2015 Report Share Posted January 19, 2015 valeu parceiro Quote Link to comment Share on other sites More sharing options...
oribeiro Posted January 19, 2015 Report Share Posted January 19, 2015 Não consegui compilar com xBuild.bat do xHarbour. Qual é o segredo? Quote Link to comment Share on other sites More sharing options...
mkyx Posted January 20, 2015 Author Report Share Posted January 20, 2015 Posta o erro. Pois pode está relacionado à falta de alguma lib Quote Link to comment Share on other sites More sharing options...
oribeiro Posted January 20, 2015 Report Share Posted January 20, 2015 Faltava o arquivo #include "corget.ch" Tirei essa linha e passou. Obrigado, Quote Link to comment Share on other sites More sharing options...
sistem Posted January 20, 2015 Report Share Posted January 20, 2015 acho que nao esta mais funcionando Quote Link to comment Share on other sites More sharing options...
kapiaba Posted January 20, 2015 Report Share Posted 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 VistaLocalidade / UF: São Paulo /SP CEP: 01313000 Obg. abs. Quote Link to comment Share on other sites More sharing options...
giovanyvecchi Posted January 20, 2015 Report Share Posted 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 Quote Link to comment Share on other sites More sharing options...
mkyx Posted January 20, 2015 Author Report Share Posted 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('</span>', cen)-(at('respostadestaque', cen) + 19)) Assim, vai dar certo. Quote Link to comment Share on other sites More sharing options...
Eduardo Bilato Posted January 21, 2015 Report Share Posted 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 ) //----------------------------------------------------------------------------// Quote Link to comment Share on other sites More sharing options...
kapiaba Posted January 21, 2015 Report Share Posted 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 Quote Link to comment Share on other sites More sharing options...
kapiaba Posted January 21, 2015 Report Share Posted 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. Quote Link to comment Share on other sites More sharing options...
Euclidao Posted January 21, 2015 Report Share Posted 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 1 Quote Link to comment Share on other sites More sharing options...
kapiaba Posted January 21, 2015 Report Share Posted 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 ) //----------------------------------------------------------------------------// Quote Link to comment Share on other sites More sharing options...
Eduardo Bilato Posted January 22, 2015 Report Share Posted 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í kapiaba 1 Quote Link to comment Share on other sites More sharing options...
Marca Posted July 3, 2015 Report Share Posted July 3, 2015 Ola Esta consulta ao site dos correios parece não estar mais funcionando Quem utiliza poderia nos dizer ? Quote Link to comment Share on other sites More sharing options...
kapiaba Posted July 3, 2015 Report Share Posted 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? Eduardo Bilato 1 Quote Link to comment Share on other sites More sharing options...
rochinha Posted July 3, 2015 Report Share Posted 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. Eduardo Bilato 1 Quote Link to comment Share on other sites More sharing options...
miragerr Posted July 4, 2015 Report Share Posted 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. rochinha 1 Quote Link to comment Share on other sites More sharing options...
oribeiro Posted July 4, 2015 Report Share Posted July 4, 2015 Baixe em: www.oasysitu.com/util/cepbr.exe É um instalador do CEP.Dbf de todo o Brasil rochinha 1 Quote Link to comment Share on other sites More sharing options...
kapiaba Posted July 6, 2015 Report Share Posted 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. Quote Link to comment Share on other sites More sharing options...
Marca Posted July 7, 2015 Report Share Posted July 7, 2015 Temos que trocar o topico do post para : Busca CEP Quase infalível...Rssss kapiaba 1 Quote Link to comment Share on other sites More sharing options...
oribeiro Posted July 17, 2015 Report Share Posted 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? kapiaba 1 Quote Link to comment Share on other sites More sharing options...
Eduardo Bilato Posted July 20, 2015 Report Share Posted 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 Quote Link to comment Share on other sites More sharing options...
dorneles Posted July 20, 2015 Report Share Posted July 20, 2015 Olá Estou utilizando esse, sem problema. oHttp:= TIpClientHttp():new( "http://cep.republicavirtual.com.br/web_cep.php?cep="+::cCep+"&formato=xml") Quote Link to comment Share on other sites More sharing options...
Recommended Posts
Join the conversation
You can post now and register later. If you have an account, sign in now to post with your account.