Busca IBGE

[kapiaba]

// By Vagner Wirts - 26/02/2014 - Todos os direitos reservados.

#Include "FiveWin.Ch"


Function Main()


   cCidade := "São Paulo"


   PegaCodigoIBge()


Retu(Nil)


/*********************************************************  

 * Função      : PegaCodigoIBge() - Funcao para pegar o estado

 * Programador : vagner wirts

 * Data        : 06/07/2011 - 10:34:25 Por : Vagner

 * Revisado em : 06/07/2011 - 10:34:22 Por : Vagner

 * Parâmetros  :  

**********************************************************/  

Static Function PegaCodigoIBge()


   Local oPag,oGet,oBrush,oDlg,oBtn

   Local cCom,cBuf,cRet,cCid := AllTrim(cCidade)

   Local nX,nPos,nQtd

   Local aMens,aMen,aCombo,aAux,aRect

   Local lAchou,lFinal


   cCid := Lower(StrTran(SemAcentos(cCid)," ","+"))


   oPag := CreateObject("Microsoft.XMLHTTP")

   cCom := "http://www.ibge.gov.br/home/geociencias/areaterritorial/area.php?nome="+cCid+"&codigo=&submit.x=41&submit.y=14"

   oPag:Open("GET",cCom,.f.)

   oPag:Send()


   cBuf := oPag:responseBody


   nPos := RAt("</table>",cBuf)

   cRet := Left(cBuf,nPos-1)

   nPos := RAt("Área",cRet)

   cRet := Right(cRet,Len(cRet)-nPos-1)


   nPos := At("<tr>",cRet)

   cRet := Right(cRet,Len(cRet)-nPos+1)


   nPos := RAt("</tr>",cRet)

   cRet := Left(cRet,nPos+4)


   aMens := {}

   aMen := {}


   For nX := 1 To MlCount(cRet)


      AaDd(aMens,AllTrim(MemoLine(cRet,,nX)))


   Next


   AEval(aMens,{|x| Iif(!Empty(x),AaDd(aMen,x),)})


   For nX := 1 To Len(aMen)


      aMen[nX] := StrTran(aMen[nX],'<td align="center">',"")

      aMen[nX] := StrTran(aMen[nX],'</td>',"")

      aMen[nX] := StrTran(aMen[nX],'<td>',"")


   Next


   lAchou := .F.

   lFinal := .F.


   aMens  := {}

   aCombo := {}


   nQtd := 0


   For nX := 1 To Len(aMen)


      If AllTrim(aMen[nX]) == "<tr>"


         lAchou := .T.

         nQtd := 1

         aAux := {}


      Endif


      If AllTrim(aMen[nX]) == "</tr>"


         lAchou := .F.

         lFinal := .T.


      Endif


      If lAchou .and. nQtd != 0


         If nQtd > 1 .and. nQtd < 6


            AaDd(aAux,aMen[nX])


         Endif


         nQtd ++


      Endif


      If lFinal .and. nQtd > 0


         AaDd(aMens,aAux)

         AaDd(aCombo,aAux[4]+"/"+aAux[2])


         lFinal := .F.


      Endif


   Next


   nPos := 1


   If Len(aCombo) > 1


      cVar  := aCombo[1]


      //aRect := {0,0,100,20}  // nao sei que five e este nao fica legal.

      aRect := { 0, 0, 600, 400 }  // FWH 13.06 funfa legal.


      oBrush := TBrush():New("NULL")


      DEFINE DIALOG oDlg FROM 0, 082 TO 400, 600 PIXEL                    ;

             TITLE( "Escolha Uma Cidade Para Pesquisar IBGE" )            ;

             BRUSH oBrush TRANSPARENT STYLE nOr( DS_SYSMODAL, DS_MODALFRAME )


      oDlg:lHelpIcon := .F.


      @ 0010,00 COMBOBOX oGet VAR cVar ITEMS aCombo         ;

                SIZE ( aRect[ 4 ] - aRect[ 2 ] ) * 0.50, 50 ;

                OF oDlg Valid((nPos := oGet:nAt),.T.) PIXEL


      @ 0150, 110 Button oBtn Prompt "&Saida" ;

                  Action ( oDlg:End() ) Of oDlg Default PIXEL


      ACTIVATE DIALOG oDlg CENTERED


   Endif


   If Len(aCombo) == 0


      MsgStop("Não encontrei essa cidade no site do IBGE."+CRLF+CRLF+"Favor verificar.")


   Else


      cCiIbge := Right(aMens[nPos][3],5)

      cCidade := aMens[nPos][4]

      cEstado := aMens[nPos][2]

      cUFIbge := aMens[nPos][1]


      ? cCidade, cCiIbge, cEstado, cUfIbge


   Endif


Retu(Nil)


/*********************************************************

 * Função      : SemAcentos - Função para Retirar todos acentos

 * Programador : Vagner

 * Data        : 02/07/2008 - 19:02:35

 * Revisado em : 02/07/2008 - 19:02:35 Por : vagner

 * Revisado em : 05/06/2013 as 15:03:13 - Por Antenor

 * Parâmetros  :

 * cVar - Variável para ser Transformada

 * Retorno :

 * cVar - Variável Transformada

 * lUpp - .T.-transforma em maiuscula, .F.-deixa como vem

**********************************************************/

Function SemAcentos( cVar, lUpp )


   Default lUpp := .T.


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

   cVar := StrTran(cVar,"à","a")

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

   cVar := StrTran(cVar,"â","a")

   cVar := StrTran(cVar,"â","a")

   cVar := StrTran(cVar,"ä","a")

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

   cVar := StrTran(cVar,"è","e")

   cVar := StrTran(cVar,"ê","e")

   cVar := StrTran(cVar,"ë","e")

   cVar := StrTran(cVar,"í","i")

   cVar := StrTran(cVar,"ï","i")

   cVar := StrTran(cVar,"î","i")

   cVar := StrTran(cVar,"ì","i")

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

   cVar := StrTran(cVar,"ö","o")

   cVar := StrTran(cVar,"ô","o")

   cVar := StrTran(cVar,"ò","o")

   cVar := StrTran(cVar,"õ","o")

   cVar := StrTran(cVar,"ú","u")

   cVar := StrTran(cVar,"ü","u")

   cVar := StrTran(cVar,"û","u")

   cVar := StrTran(cVar,"ù","u")

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


   cVar := StrTran(cVar,"Á","A")

   cVar := StrTran(cVar,"À","A")

   cVar := StrTran(cVar,"Ã","A")

   cVar := StrTran(cVar,"Â","A")

   cVar := StrTran(cVar,"Â","A")

   cVar := StrTran(cVar,"Ä","A")

   cVar := StrTran(cVar,"É","E")

   cVar := StrTran(cVar,"È","E")

   cVar := StrTran(cVar,"Ê","E")

   cVar := StrTran(cVar,"Ë","E")

   cVar := StrTran(cVar,"Í","I")

   cVar := StrTran(cVar,"Ï","I")

   cVar := StrTran(cVar,"Î","I")

   cVar := StrTran(cVar,"Ì","I")

   cVar := StrTran(cVar,"Ó","O")

   cVar := StrTran(cVar,"Ö","O")

   cVar := StrTran(cVar,"Ô","O")

   cVar := StrTran(cVar,"Ò","O")

   cVar := StrTran(cVar,"Õ","O")

   cVar := StrTran(cVar,"Ú","U")

   cVar := StrTran(cVar,"Ü","U")

   cVar := StrTran(cVar,"Û","U")

   cVar := StrTran(cVar,"Ù","U")

   cVar := StrTran(cVar,"Ç","C")

   cVar := StrTran(cVar,"&","e")


   If lUpp


      cVar := Upper(cVar)


   Endif


Return( cVar )


// FIM DO PROGRAMA