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.
