Page 4 of 4

Re: un pequeño ejemplo ...meteo.prg

PostPosted: Wed Mar 14, 2018 9:46 pm
by acuellar
Gracias Estimado Manuel por responder

Este mi programa. Porfa lo puede compilar

Code: Select all  Expand view

#include "FiveWin.ch"
#define HTTPREQUEST_PROXYSETTING_PROXY 2
#include "ttitle.ch"
//REQUEST HB_LANG_ESWIN
*
function Pronostico()
  local obmp ,cBmp
  local oIco ,cCity:= "Santa Cruz de la Sierra, BO"+space(20)
  local cUrl := "http://l.yimg.com/a/i/brand/purplelogo//uh/us/news-wea.gif"
  Private oTimer,oWnd,Alerta1,Alerta2,lProxy:=.T.,vMD
  Private nInt:=0
 
  If !hb_Ping( "192.10.1.7" ) == 0
    lProxy:=.F.
  Endif
   
  If lProxy
     cProxy:= "192.10.1.7:8080"
  Endif
 
  DEFINE WINDOW oWnd FROM 0,1 TO 0,1 STYLE WS_POPUP
   
  ACTIVATE WINDOW oWnd ON INIT (Llamada(cCity),oWnd:Hide())
 
return nil
*
Function llamada(cCity)
  Local oHttp,cResp,cDir,Formato:="json",cUnits:= "c"

cDir := "https://query.yahooapis.com/v1/public/yql?q=select * from weather.forecast where woeid in (select woeid from geo.places(1)"
cDir:= cDir + " where text= '"+ cCity +"' ) and u='"+cUnits+"'&format=" + Formato
 nInt++

 Try
      oHttp := CreateObject("winhttp.winhttprequest.5.1")
      If lProxy
        oHttp:SetProxy( HTTPREQUEST_PROXYSETTING_PROXY,cProxy  )
      Endif
     
      oHttp:Open("GET", cDir, .f. )
      oHttp:Send()
      cResp := oHttp:ResponseText()
      oHttp:WaitForResponse()  
       leejson( cResp )
   Catch
     MsgStop( "No pudo cargar el pronóstico" )
      If nInt=2
        oWnd:End();__Quit()
      Endif
      llamada(cCity)
     
   End Try
   
Return nil
*
function Leejson(cResp)
local hvar,hvar1,hvar2,cTexto:="",oDlg, cBmp,nValor,oBmp,ofont1,ofont2,oBrwForecast
local i,cImage,cMin,cMax,cData,cDay,ahTexto,hDias,cPrev,cUrl

 hb_jsondecode( cResp, @hvar )

 hvar1:= hvar["query"]["results"]["channel"]

 Define font ofont1 name "Arial" size 0,16 bold
 DEFINE Font ofont2 NAME "Verdana" SIZE 0,13
 
 DEFINE DIALOG oDlg TITLE "Pronóstico del tiempo" SIZE 500,395 pixel color CLR_BLACK,CLR_WHITE;oDlg:lHelpIcon:=.F.
 DEFINE TIMER oTimer INTERVAL 60000*3 ACTION (oDlg:End(),oTimer:End(),oWnd:End())
       *    
      @ 05 ,80 SAY "Santa Cruz de la Sierra, BO" OF oDlg SIZE 180, 20 pixel Font ofont1 color CLR_BLACK,CLR_WHITE
      cFecha:=cDow(Date())+", "+StrZero(day(date()),2)+" de "+cMonth(date())+" del "+Str(Year(date()))+"  "+time()
      @ 16, 70 SAY cFecha OF oDlg pixel SIZE 180, 20 color CLR_BLACK,CLR_WHITE FONT ofont1

     hvar2:= hvar1["wind"]

     @ 30, 120 say "Actual" SIZE 50, 20  OF oDlg pixel COLOR CLR_BLACK,CLR_WHITE FONT ofont1
     @ 40, 70 say "Sensación térmica " OF oDlg  pixel color CLR_BLACK,CLR_WHITE FONT ofont2

     gC:=Str(Round((Val(hVar2["chill"])-32)*5/9,0),2)
 
     @ 40, 145 say alltrim( gC+chr(186)+" C")  OF oDlg pixel color CLR_BLACK,CLR_WHITE FONT ofont2
     @ 40, 145 say alltrim( hVar2["chill"]+chr(186)+" "+ hvar1["units"]["temperature"] )  OF oDlg pixel color CLR_BLACK,CLR_WHITE FONT ofont2
     @ 50, 70 say "Vientos "  OF oDlg  pixel  color CLR_BLACK,CLR_WHITE FONT ofont2
     @ 50, 145 say  hVar2["speed"]+" "+ hvar1["units"]["speed"]  OF oDlg pixel  color CLR_BLACK,CLR_WHITE FONT ofont2

     hvar2:= hvar1["atmosphere"]
     @ 60, 70 say "Humedad " OF oDlg pixel  color CLR_BLACK,CLR_WHITE FONT ofont2
     @ 60, 145 say  hVar2["humidity"] + " %" OF oDlg pixel  color CLR_BLACK,CLR_WHITE FONT ofont2

      nValor:= hVar2["rising"]
      if  nValor == "0"
         cTexto := "Estable"
     elseif nValor == "1"
         cTexto := "Inestable subiendo"
     elseif nValor == "2"
         cTexto := "Inestable bajando"
     endif

     @ 70, 70 say "Comportamiento"  OF oDlg pixel color CLR_BLACK,CLR_WHITE FONT ofont2
     @ 70, 145 say cTexto OF oDlg pixel color CLR_BLACK,CLR_WHITE FONT ofont2
     
      hvar2:= hvar1["astronomy"]

     @ 82, 65 say "Salida del sol " + hVar2["sunrise"] OF oDlg pixel color CLR_BLACK,CLR_WHITE FONT ofont2
     @ 82, 145 say "Ocaso " + hVar2["sunset"] OF oDlg pixel color CLR_BLACK,CLR_WHITE FONT ofont2

      hvar2:= hvar1["item"]

    aHTexto:=hVar2["forecast"]
    nRow:=101;nCol:= 5
    nD=0

   for i=1 to len(aHTexto)
     hDias:=aHTexto[i]
     cData:=If(i=1,"    Hoy",dToc(Date()+nD)) //hDias["date"])
     cDay:= Left(cDow(Date()+nD)+"    ",9) //hDias["day"]
     cMax:= hDias["high"]
     cMin:= hDias["low"]
     cPrev:= hDias["text"]
     cUrl:= "http://l.yimg.com/a/i/us/we/52/"+hDias["code"]+".gif"
 
 @ nRow,nCol+3 say cData OF oDlg  pixel color CLR_BLACK,CLR_WHITE FONT ofont2
 nRow+= 8
 @ nRow,nCol+6 say cDay OF oDlg  pixel color CLR_BLACK,CLR_WHITE FONT ofont2
 nRow+= 8
 @ nRow,nCol+15 say cMax OF oDlg  pixel color CLR_BLACK,CLR_WHITE FONT ofont2
 nRow+= 8
 @ nRow,nCol+15 say cMin OF oDlg  pixel color CLR_BLACK,CLR_WHITE FONT ofont2
* nRow+= 8
* @ nRow,nCol say cPrev OF oDlg  pixel color CLR_BLACK,CLR_WHITE FONT ofont2
 nRow+= 10
 @ nRow,nCol+7 xIMAGE oBmp FILE cBmp OF oDlg size 32,32 pixel NOBORDER
 
 cargaBmp(cUrl,oBmp)
  obmp:lTransparent := .t.
 nCol+=50
 nRow:=101
 nD++
next

  @ 92, 2 GROUP oGroup TO 160,248 LABEL "CADA DÍA" OF oDlg  pixel TRANSPARENT
  @ 163, 2 GROUP oGroup TO 192,200 LABEL "RECOMENDACIONES" OF oDlg  pixel TRANSPARENT
  Alertas()
  If Day(Date())>(16-vMD) .And. Day(Date())<(21-vMD)
    @ 171,6 Say Alerta1 OF oDlg  pixel size 190,10 FONT ofont1 color CLR_HRED,CLR_WHITE
    @ 181,6 Say Alerta2 OF oDlg  pixel size 190,10 color CLR_HRED,CLR_WHITE FONT ofont1
   Else
    @ 171,6 Say Alerta1 OF oDlg  pixel size 190,10 FONT ofont1 color CLR_BLACK,CLR_WHITE
    @ 181,6 Say Alerta2 OF oDlg  pixel size 190,10 color CLR_BLACK,CLR_WHITE FONT ofont1
   
   endif
      cTexto:=hVar2["condition"]["code"]

      cTexto:="http://l.yimg.com/a/i/us/we/52/"+cTexto+".gif"

      @ 40,22  xIMAGE oBmp FILE cBmp OF oDlg size 32,32 pixel NOBORDER
 
      cargaBmp(cTexto,oBmp)
      obmp:lTransparent := .t.

 ACTIVATE DIALOG oDlg CENTERED ON INIT oTimer:Activate()

  ofont1:end();ofont2:end()
  oWnd:End()
Return nil
*
Function cargaBmp(cUrl,oImage)
  local cResp := loadBmp(cUrl),nZeroZeroClr
   
  if !Empty( cResp )
     oImage:SetBmp(cResp)
  endif
Return nil
*
Function loadBmp(cUrl)
  local oHttp,cResp := nil

   Try
      oHttp := CreateObject( "winhttp.winhttprequest.5.1" )
      If lProxy
        oHttp:SetProxy( HTTPREQUEST_PROXYSETTING_PROXY,cProxy  )
      Endif
      oHttp:Open("GET", cUrl, .f. )
      oHttp:Send()
   
      cResp := oHttp:ResponseBody()
      oHttp:WaitForResponse()  
     
   Catch
      //MsgStop( "Error" )
      Return cResp
   End Try
 
Return cResp
*
Function Alertas()
   vMD:=0
   cFec:=dTos(date())
   If cDow(ctod("20/"+Subs(cFec,5,2)+"/"+Left(cFec,4)))="Domingo"
     vMD:=1
   Endif
   
   If Day(Date())>(16-vMD) .And. Day(Date())<(21-vMD)
         nDias:=(20-vMD)-Day(Date())
         cDia:=If(nDias=0,"Hoy último día ","Le queda"+If(nDias=1," ","n ")+StrZero(nDias,1)+If(nDias=1," día"," días"))
         Alerta1:=cDia+" para presentar su RCIVA"
         Alerta2:="Si presentó, ignore la recomendación."
    Else
         xAzar:=nRandom(10)
         xAzar:=If(xAzar=0,1,xAzar)
          If xAzar=1
           Alerta1:="Vacie la carpeta Deleted Items del servidor"
           Alerta2:="para mejorar el rendimiento de su Outlook"
         ElseIf xAzar=2
           Alerta1:="Borre los correos no deseados del servidor"
           Alerta2:="para mejorar el rendimiento de su Outlook"
         ElseIf xAzar=3
           Alerta1:="No olvide revisar sus llamadas telefónicas"
           Alerta2:="En el sistema AGENTEL, coloque el nombre"
         ElseIf xAzar=4
           Alerta1:="No responda un correo a TODOS_MAIL "
           Alerta2:="Si la respuesta es personal, el 80% no lo borra"
         ElseIf xAzar=5
           Alerta1:="Lea su correo escrito antes de enviarlo "
           Alerta2:="Asi evitará volver a reenviar corregido"
         ElseIf xAzar=6
           Alerta1:="No imprima el contenido de un correo completo"
           Alerta2:="Si lo necesario es lo último recibido"
         ElseIf xAzar=7
           Alerta1:="No imprima el contenido de un correo,"
           Alerta2:="si no es muy importante, ayude a la ecología"
         ElseIf xAzar=8
           Alerta1:="Apague las luces y artefactos eléctricos"
           Alerta2:="que no esté usando."
         ElseIf xAzar=9
           Alerta1:="Cuide sus herramientas de trabajo"
           Alerta2:="En la empresa son suya."
         ElseIf xAzar=10
           Alerta1:="Mantenga su carpeta de correo peronal .PST"
           Alerta2:="Borrando correos no necesarios o antiguos."
         ElseIf xAzar=11
           Alerta1:="No olvide que los formularios RCIVA deben ser entregados "
           Alerta2:="hasta el 20. Si TOT.GANADO>7000 debe exportar via DaVinci"
         Endif
         
     Endif
 Return Nil
 *

#pragma BEGINDUMP
#include <hbapi.h>
#include <winsock2.h>
#include <iphlpapi.h>
#include <icmpapi.h>

int hb_Ping( const char * cp )
{
    HANDLE hIcmpFile;
    unsigned long ipaddr;
    DWORD dwRetVal;
    char SendData[32] = "Data Buffer";
    LPVOID ReplyBuffer;
    DWORD ReplySize;

    ipaddr = inet_addr( cp );
    if (ipaddr == INADDR_NONE)
        return 1;
   
    hIcmpFile = IcmpCreateFile();
    if (hIcmpFile == INVALID_HANDLE_VALUE)
        return 2;

    ReplySize = sizeof(ICMP_ECHO_REPLY) + sizeof(SendData);
    ReplyBuffer = (VOID*) malloc(ReplySize);
    if (ReplyBuffer == NULL)
        return 3;
   
    dwRetVal = IcmpSendEcho(hIcmpFile, ipaddr, SendData, sizeof(SendData),
        NULL, ReplyBuffer, ReplySize, 1000);

    if (dwRetVal == 0)
        return 4;
   
    return 0;

}

HB_FUNC( HB_PING )
{
   hb_retni( hb_Ping( hb_parc( 1 ) ) );
}

#pragma ENDDUMP
 
 


Gracias por la ayuda.

Re: un pequeño ejemplo ...meteo.prg

PostPosted: Wed Mar 14, 2018 10:42 pm
by acuellar
El problema está en el xIMAGE
Usando IMAGE funciona pero necesita de freeimage.dll el cual quiero evitar.

No logro hacerlo funcionar con xIMAGE

Re: un pequeño ejemplo ...meteo.prg

PostPosted: Fri Mar 16, 2018 12:00 pm
by mastintin
Mira asi :
Code: Select all  Expand view


@ nRow,nCol+7  XIMAGE oBmp SOURCE loadBmp(cUrl) OF oDlg size 142,35 NOBORDER

// cargaBmp(cUrl,oBmp)
 // obmp:lTransparent := .t.

 

Re: un pequeño ejemplo ...meteo.prg

PostPosted: Fri Mar 16, 2018 2:29 pm
by acuellar
Gracias Estimado Manuel

Funciona.
Pero hay un problema que no cambia la imagen.
Muestra la misma.

Le agregué oBmp:Refresh() y nada.

Gracias por la ayuda.

Re: un pequeño ejemplo ...meteo.prg

PostPosted: Fri Jan 11, 2019 1:49 pm
by acuellar
Estimado Manuel

Dejó de funcionar el Meteo.

Porfa me ayuda a confirmar que es la página.

Gracias por la ayuda.

Re: un pequeño ejemplo ...meteo.prg

PostPosted: Fri Jan 11, 2019 10:07 pm
by cnavarro

Re: un pequeño ejemplo ...meteo.prg

PostPosted: Mon Jan 14, 2019 2:37 pm
by acuellar
Gracias Cristobal

Ya hice la solicitud para crear un usuario. Estoy esperando que me den respuesta.

Re: un pequeño ejemplo ...meteo.prg

PostPosted: Fri Jan 18, 2019 7:24 pm
by acuellar
Estimado Manuel

Ha intentado ud. hacerlo funcionar?

Re: un pequeño ejemplo ...meteo.prg

PostPosted: Fri Oct 07, 2022 6:28 pm
by karinha
Buenas tardes, hay un ejemplo completo para hacer pruebas?

Good afternoon, is there a complete example for testing?

Gracias, thanks.

Regards, saludos.