CONSEGUIR LA FECHA Y HORA DE INTERNET

[rterraz]

Hola Amigos
Tengo una aplicacion en FWH en la cual necesito saber la Fecha y Hora de Internet
lo hago asi:
oHttp := CreateObject("winhttp.winhttprequest.5.1")
oHttp:Open("GET","http://www.horacerta.com.br/index.php?city=buenos_aires",.f.)
oHttp:Send()
cResp1 := oHttp:ResponseText() // cResp tiene la respuesta de la pagina consultada

Ahora bien
Tengo otra aplicacion hecha con fw240 (16 bits) en la cual necesito hacer lo mismo
El problema es que no reconoce la funcion CreateObject() que parece que solo funciona en 32bits
usando shellexecute() el sistema me abre la pagina en el explorador pero yo necesito solamente la respuesta del sitio
consultado que son la FECHA y TIME pero no se como implementar el "GET" para obtener esto
Alguien sabe como hacerlo ?
Agradecido por sus respuestas

[Marcelo Via Giglio]

Hola,

prueba con el protocolo NTP, Antonio, hizo una implementación

http://forums.fivetechsupport.com/viewtopic.php?f=3&t=25246&p=150436&hilit=ntp#p150436

no se si funcionara en 16 bits

Saludos

Marcelo

[Marcelo Via Giglio]

Hola,

prueba con el protocolo NTP, Antonio, hizo una implementación

http://forums.fivetechsupport.com/viewtopic.php?f=3&t=25246&p=150436&hilit=ntp#p150436

no se si funcionara en 16 bits

Saludos

Marcelo

[karinha]

Intenta asi:

Code: Select all  Expand view

// \samples\HRDTBRA.PRG - Hora e data(fecha) de Brasilia/Buenos aires.

#include "FiveWin.ch"

static oWnd

function Main()

   local oBar, aHrDt

   SET DATE BRITISH
   // SET TIME FORMAT TO "HH:MM:SS"

   // ? aHrDt := HrDtInternet()

   DEFINE WINDOW oWnd TITLE "Hora de Brasilia e Buenos Aires"

   DEFINE BUTTONBAR oBar _3D OF oWnd

   DEFINE BUTTON OF oBar ;
      ACTION MsgRun( "Aguarde a Hora de Brasilia e Buenos Aires", ;
                     "Wait a moment Please.                  ", ;
                     { | | HrDtInternet() } )

   SET MESSAGE OF oWnd TO "Fuso Horario de Brasilia e Buenos Aires" ;
      NOINSET CLOCK DATE KEYBOARD

   ACTIVATE WINDOW oWnd

return nil

Function HrDtInternet()

   Local oHttp,        ;
         cResp1 := "", ;
         cResp  := "", ;
         cHora  := "", ;
         cData  := ""
   local _oTmr // O timer inpedirá o SISCOM de parar de responder
   local cDados := ""
   local wDIA, wMES, wANO, wHOR, wMIN, wSEG

   DEFINE TIMER _oTmr ;
      INTERVAL 1000   ;
      ACTION SysRefresh()
   ACTIVATE TIMER _oTmr

   IF !IsInternet()
      _oTmr:End()
      Return( {DtoC(Date()), Time()} )
   ENDIF

   Try
      oHttp := CreateObject("winhttp.winhttprequest.5.1")
      //oHttp:Open("GET","http://www.horacerta.com.br/index.php?city=sao_paulo",.f.)  // erro en el site
      //oHttp:Open("GET","http://www.horacerta.com.br/index.php?city=recife",.f.)
      oHttp:Open("GET","http://www.horacerta.com.br/index.php?city=buenos_aires",.f.)
      oHttp:Send()
      cResp1 := oHttp:ResponseText()
   Catch
      _oTmr:End()
      Return( {DtoC(Date()), Time()} )
   End Try

   *<input name="mostrador" type="text" size="25" value="19/09/2011 - 01:02:00 PM" />

   cResp     := SubStr( cResp1 , At( '<input name="mostrador"', cResp1 ) )
   cResp     := Substr( cResp    , 1, At( '/>', cResp )-2 )
   cDados    := SubStr( cResp  , At( 'value="', cResp )+7 )
   cData := SubStr( cDados,  1, 10)
   cHora := SubStr( cDados, 14 )

   /*
   If "PM" $ cHora
      cHora := Str(Val(SubStr(cHora,1,2))+12,2)+SubStr(cHora,3,7)
   End
   */

   If "PM" $ cHora .AND. SubStr(cHora,1,2) != "12"
      cHora := Str(Val(SubStr(cHora,1,2))+12,2)+SubStr(cHora,3,7)
   Endif

   wDIA := VAL(SUBSTR( cData, 1, 2 ) )
 
   wMES := VAL(SUBSTR( cData, 4, 2 ) )
   wANO := VAL(SUBSTR( cData, 7, 4 ) )
 
   wHOR := VAL(SUBSTR( cHora, 1, 2 ) )
   wMIN := VAL(SUBSTR( cHora, 4, 2 ) )
   wSEG := VAL(SUBSTR( cHora, 7, 2 ) )

   _oTmr:End()

   MsgInfo("Fecha: "+cData+CRLF+"Hora: "+cHora,"En Buenos Aires.")

Return( {cData, cHora} )
 

[karinha]

Code: Select all  Expand view

// \samples\DANIEL.PRG

#include "FiveWin.ch"

REQUEST HB_LANG_PT
REQUEST HB_CODEPAGE_PT850

STATIC oWnd

//----------------------------------------------------------------//

FUNCTION Main()

   LOCAL oBar

   SET DATE BRITISH
   SET EPOCH TO 1950
   SET CENTURY ON
   SET SOFTSEEK OFF
   SET WRAP ON
   SETCANCEL( .F. )
   SET CONFIRM OFF
   SET DELETED ON
   SET ESCAPE OFF
   SET EXACT ON  // CONTROLA O :=, = e ==
   SET EXCLUSIVE OFF
   SET MULTIPLE OFF

   HB_LANGSELECT( 'PT' )     // Default language is now Portuguese
   HB_SETCODEPAGE( "PT850" )

   SkinButtons()

   DEFINE WINDOW oWnd TITLE "Atualiza Hora"

   DEFINE BUTTONBAR oBar _3D OF oWnd

   DEFINE BUTTON OF oBar ACTION atualiza_hora()

   SET MESSAGE OF oWnd TO "Atualiza Hora" NOINSET CLOCK DATE KEYBOARD

   ACTIVATE WINDOW oWnd

RETURN nil

// -------------------------------------------------------------------------- //

// IDENTADO COM: HBFORMAT.EXE C:\XHARBOUR\BIN

// -------------------------------------------------------------------------- //

FUNCTION atualiza_hora()

   LOCAL xdia_atu , xhora_atu

   try
      oHttp := CreateObject( "winhttp.winhttprequest.5.1" )
      oHttp:SetTimeouts(40000,40000,40000,40000) // VERIFICAR SE FICA LENTO
      oHttp:Open( "GET", "http://24timezones.com/pt_horamundial/brasilia_hora_local.php" , .F. )
      oHttp:Send()
      cHtml := oHttp:ResponseText()
   catch
      RETURN .T.
   end
     
   cHora := alltrim( StrExtract( cHtml, '<span id="currentTime">', '</span>' ) )
   cHora1 := TRANSF( cHora, "99:99:99" )
     
   x_am_pm  := alltrim( substr( cHora , 10 , 2 ) )
   ntamtot  := len( cHora )
   nposmesi := rat( ',' , cHora ) + 1
   nposmesf := ( ntamtot - nposmesi ) - 4
   nposanoi := ntamtot - 3
     
   nposdiaf := rat( ',' , cHora ) - 1
   nposdiai := nposdiaf - 1
   nposdiaf := nposdiaf - nposdiai
     
   dia := alltrim( substr( cHora , nposdiai , 2        ) )
   mes := alltrim( substr( cHora , nposmesi , nposmesf ) )
   ano := alltrim( substr( cHora , nposanoi , 4        ) )
     
   IF x_am_pm = 'PM' .AND. ( val( substr( cHora1 , 1 , 2 ) ) < 12 )
      xhora1 := zeracod( str( val(substr( cHora1 , 1 , 2 ) ) + 12 ,2 ) )
      cHora1 := xhora1 + substr( cHora1 , 3 )
   ENDIF
     
   data_atual_site := dia + '/' + qmesnum( mes ) + '/' + ano

      /*
      ? 'cHora'  , cHora  ,;
        'cHora1' , cHora1 ,;
        'Dia' , dia ,;
        'Mes' , mes ,;
        'Ano' , ano ,;
        'x_am_pm' , x_am_pm,;
        'data_atual_site' , data_atual_site,;
        'DataAtual' , date(),;
        'HoraAtual' , time()
      */
     
   xdia_atu  := date()
   xhora_atu := time()
     
   IF data_atual_site # dtoc( xdia_atu )

      //xdate := "Date " + data_atual_site
      //try
      //   winexec( xdate )
      //catch
      //end

      msginfo( "Favor corrigir a data do seu Equipamento." + CRLF + CRLF + ;
         "Data na Internet: " + data_atual_site + CRLF + ;
         "Data do Equipamento: " + dtoc( xdia_atu ) , "CIACPD Informa." )

   ENDIF
     
   IF substr( cHora1 , 1 , 4 ) # substr( xhora_atu , 1 , 4 )
      //try
      //   winexec( cHora1 )
      //catch
      //end
      msginfo( "Favor corrigir a hora do seu Equipamento." + CRLF + CRLF + ;
         "Hora na Internet: " + cHora1 + CRLF + ;
         "Hora do Equipamento: " + xhora_atu , "CIACPD Informa." )
   ENDIF

   ? cHora1, data_atual_site
     
RETURN NIL

// -------------------------------------------------------------------------- //

FUNCTION StrExtract( cText, cAfter, cBefore )

   LOCAL cRet := SUBSTR( cText, AT( cAfter,cText ) + LEN( cAfter ) )
   LOCAL n

   IF ( n := AT( cBefore,cRet ) ) > 0
      cRet := LEFT( cRet, n - 1 )
   ENDIF */

RETURN ( cRet )

// -------------------------------------------------------------------------- //

FUNCTION ZeraCod( Cod )

RETURN Padl( AllTrim( Cod ), Len( cod ), [0] )

//----------------------------------------------------------------------------//

FUNCTION qmesnum( pmes )

   LOCAL nmesnum

   IF len( alltrim( pmes ) ) < 1
      pmes := 'Janeiro'
   ENDIF

   PRIVATE Tmes := { "JANEIRO", "FEVEREIRO", "MARÇO", "ABRIL", "MAIO", "JUNHO", "JULHO", "AGOSTO", "SETEMBRO", "OUTUBRO", "NOVEMBRO", "DEZEMBRO" }
   nmesnum := ascan( tmes, Alltrim( upper(pmes ) ) )

RETURN zeracod( str( nmesnum,2 ) )

//----------------------------------------------------------------------------//
 

[karinha]

Code: Select all  Expand view

/*
// baseado em exemplo disponibilizado na Seção de Downloads pelo
// Pablo César do PcToledo.
*/

#Include "FiveWin.ch"
#Include "hbcompat.ch"

Function Main()

   LOCAL cRetHr

   // Alert( STRTRAN( PegaDtHrBrasilia(), '*',';' )  )
   cRetHr := MsgRun( "Verificando a Hora de Brasilia.", ;
                     "Por Favor, Espere!"             , ;
                     { || STRTRAN( PegaDtHrBrasilia(), '*',';' ) } )

   ? "Hora de Brasilia: ", cRetHr

RETURN NIL

Function PegaDtHrBrasilia()

   Local OOLE, CDIA, CMES, CANO, CDATA, CHORA
   Local cRet := "", cPagina := ""
   Local cTexto := "Local time in Brasilia"

   IF ( oOle := Cria_OLE( "InternetExplorer.Application", , .T. ) ) == NIL

      RETURN( .F. )

   ENDIF

   oOle:Visible   := .F. // Apresenta o Browser
   oOle:ToolBar   := .F. // Desativa a barra de ferramentas
   oOle:StatusBar := .F. // Desativa a barra de status
   oOle:MenuBar   := .F. // desativa a barra de menu
   oOle:Navigate("http://www.timeanddate.com/worldclock/fullscreen.html?n=45")
   
   WHILE oOle:ReadyState() != 4  // Aguarda página ser carregada, mesmo q não seja visualizado no Navegador (opão Visible := F ou T)

      SysWait( .5 )

   ENDDO

   *** Retrieve the entire HTML document as a string
   cPagina := oOle:Document():Body:InnerText

   oOle := NIL

   If cTexto $ cPagina

      cPagina := Substr(cPagina,At(cTexto,cPagina)+25)
      cPagina := Substr(cPagina,At(",",cPagina)+1)
      cPagina := Alltrim(Substr(cPagina,1,At(CRLF,cPagina)+11))
      cDia := Strzero(Val(Substr(cPagina,1,At(" ",cPagina))),2,0)
      cPagina := Substr(cPagina,At("de ",cPagina)+3)
      cMes := VqMes(lower(Alltrim(Substr(cPagina,1,At(" ",cPagina)))))
      cPagina := Substr(cPagina,At("de ",cPagina)+3)
      cAno := Substr(cPagina,1,At(CRLF,cPagina)-1)
      cPagina := Substr(cPagina,At(CRLF,cPagina)+2)
      cData := cDia+"/"+cMes+"/"+cAno
      cHora := Substr(cPagina,1,8)
      cRet := cData+'*'+cHora

   Else

      cRet := "Ocorreu um Erro"

   Endif

Return( cRet )

********************************************************************************
Function VqMes(cText)

   Local cNMes

   Do Case
      Case cText=="janeiro"
           cNMes := "01"
      Case cText=="fevereiro"
           cNMes := "02"
      Case cText=="março"
           cNMes := "03"
      Case cText=="abril"
           cNMes := "04"
      Case cText=="maio"
           cNMes := "05"
      Case cText=="junho"
           cNMes := "06"
      Case cText=="julho"
           cNMes := "07"
      Case cText=="agosto"
           cNMes := "08"
      Case cText=="setembro"
           cNMes := "09"
      Case cText=="outubro"
           cNMes := "10"
      Case cText=="novembro"
           cNMes := "11"
      Case cText=="dezembro"
           cNMes := "12"      
   EndCase

Return( cNMes )

//------------------------------------------------------------------------------
FUNCTION Cria_OLE(cObj_OLE, cMsg, lGetActiveObj)

   /* Cria objeto Ole */
   LOCAL oObj_OLE := NIL

   cMsg:='Erro ao tentar carregar objeto...Tente novamente'

   lGetActiveObj:=.F.

   IF lGetActiveObj

      TRY

         oObj_OLE := GetActiveObject( cObj_OLE )

      CATCH

         TRY

            oObj_OLE := CREATEOBJECT(cObj_OLE)

         CATCH

            Alert(cMsg)

            RETURN oObj_OLE

         END

      END

   ELSE

      TRY

         oObj_OLE := CREATEOBJECT(cObj_OLE)

      CATCH

         Alert( cMsg )

         RETURN oObj_OLE

      END

   ENDIF

RETURN oObj_OLE

// FIM
 

[rterraz]

Hola amigos
Gracias por su ayuda.
Probe todo lo que me envian y nada anda en 16bits!
La funcion CreateObject() no existe en 16bits
Intente usando CreateOleObject() pero no puedo lograr lo que necesito
Salu2 a todos

[karinha]

rterraz, si no funciona en 16 bits, haga un programa en 32 bits y llame con WINEXEC (). Es solo una idea.

Saludos.

[karinha]

Mira se ayuda via FTP:

http://bielsys.blogspot.com/2009/02/actualizacion-automatica-de.html

Saludos.