Jump to content
Fivewin Brasil

DATA E HORA DE BRASILIA

kapiaba

By kapiaba
in Programação

 Share

Recommended Posts

kapiaba Enthusiast

kapiaba

Posted
Posted

Bom dia pessoal e Theotokos, esta função, em alguns processadores, está me gerando uma lentidão incrível, alguém já passou por isso e fez alguma correção/modificação? 

// FUNCAO PARA VERFICAR A DATA DE BRASILIA
FUNCTION HORA_COMPUTADOR()
	   // VERIFICA A DATA E HORA DE BRASILIA E CHECA SE ESTA IGUAL AO DO COMPUTADOR
   // CONTRIBUICAO: FORUM FIVEWIN - SHOW() - Theotokos.
	   aHrDt := HrDtInternet()
	   // aHrDt[1]  // A data de Brasilia
   IF CTOD( aHrDt[1]) <> Date() .AND. CTOD( aHrDt[1]) != CTOD( "  /  /    " )
	      MsgInfo( OemToAnsi( "ATEN€ÇO USUµRIO:                        " ) +CRLF+;
               OemToAnsi( "A DATA DO SEU MICRO ESTµ DIFERENTE DA DATA DE " + ;
                          "BRASILIA." )                                +CRLF+;
               OemToAnsi( "A DATA DO SEU MICRO : " + DTOC( Date() ) ) +CRLF+;
               OemToAnsi( "A DATA DE BRASILIA  : " + aHrDt[1]       ) +CRLF+;
               OemToAnsi( "SINCRONIZE O RELàGIO DO SEU WINDOWS...  " ) +CRLF+;
               OemToAnsi( "PARA FICAR COM DATA E HORA DE BRASILIA. " ) +CRLF+;
               OemToAnsi( "SE VOCÒ NÇO SINCRONIZAR O RELàGIO, TERµ " ) +CRLF+;
               OemToAnsi( "PROBLEMAS NA HORA DA TRANSMISSÇO DA NFE." ) +CRLF+;
               OemToAnsi( "VEJA O BOTÇO: <Hora de Brasilia> NA TELA" ) +CRLF+;
               OemToAnsi( "TECLE <ENTER> PARA CONTINUAR...         " ),      ;
               OemToAnsi( "SINCRONIZE O RELàGIO DO WINDOWS URGENTE!" ) )
	   ENDIF
	RETURN NIL
// VERIFICA A DATA E HORA DE BRASILIA E CHECA SE ESTA IGUAL AO DO COMPUTADOR
Function HrDtInternet()
	   Local oHttp, ;
         cResp1       := "", ;
         cResp        := "", ;
         cHora      := "", ;
         cData      := ""
   local _oTmr // O timer inpedirá o PROGRAMA de parar de responder
	   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.)
      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("Data: "+cData+CRLF+"Hora: "+cHora,"Na internet")
	Return( {cData, cHora} )

Link to comment
Share on other sites
frkiko Newbie

frkiko

Posted
Posted

Mudei para este link.... eu passava pelo primeiro e sem resposta passava para este.

     Try
         oHttp:=CreateObject("winhttp.winhttprequest.5.1")
         oHttp:Open("GET","http://www.horariodebrasilia.org/",.f.)
         oHttp:Send()
         cHtml:=oHttp:ResponseText()
         //<h3 id="dia-topo">Quarta-feira, 2 de dezembro de 2015</h3><p id="relogio">08:05:50</p>
         cDados:=SubStr(cHtml,At('<h3 id="dia-topo">',cHtml))
         cDados:=Substr(cDados,19,At('/p>',cDados)-3)
         cData :=SubStr(cDados,1,At('</h3>',cDados)-1)
         cHora :=SubStr(cDados,At('"relogio">',cDados)+10,8)
      Catch
      End Try

Link to comment
Share on other sites
frkiko Newbie

frkiko

Posted
Posted

      vMes:={"Janeiro","Fevereiro","Março","Abril","Maio","Junho","Julho","Agosto","Setembro","Outubro","Novembro","Dezembro"}

      cDia:=StrZero(Val(SubStr(cData,At(",",cData)+1,3)),2,0)
      cMes:=SubStr(cData,At("de ",cData)+3)
      cMes:=AllTrim(SubStr(cMes,1,At(" de ",cMes)-1))
      for I:=1 to 12
         IF cMes==Lower(vMes)
            cMes:=StrZero(I,2,0)
            Exit
         ENDIF
      next

   cAno:=SubStr(AllTrim(Right(cData,5)),1,4)
? cDia+"/"+cMes+"/"+cAno

 

 

Link to comment
Share on other sites
CIACPD Newbie

CIACPD

Posted
Posted

Olá João, Tenta a rotina abaixo 

// -------------------------------------------------------------------------- //
function atualiza_hora()
      local xdia_atu , xhora_atu
      try
         oHttp := CreateObject( "winhttp.winhttprequest.5.1" )
         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
      
RETURN NIL
// -------------------------------------------------------------------------- //

Daniel Segura

Link to comment
Share on other sites
kapiaba Enthusiast

kapiaba

Posted
  • Author
Posted

Thanks my friend Daniel vou provar. O Problema Daniel é que se ele acionar o Internet Explorer, IPHODE, porquê, como o IE está muito velho e desatualizado, pesado pra K7, demora uma eternidade para retornar a hora, ai dá: "Programa não está respondendo". 

Link to comment
Share on other sites
kapiaba Enthusiast

kapiaba

Posted
  • Author
Posted

Daniel, manda esta funções que faltam, porfa. Obg. abs. 


Embarcadero C++ 7.30 for Win32 Copyright (c) 1993-2017 Embarcadero Technologies, Inc.
daniel.c:
Turbo Incremental Link 6.80 Copyright (c) 1997-2017 Embarcadero Technologies, Inc.
Error: Unresolved external '_HB_FUN_STREXTRACT' referenced from C:\FWH1701\SAMPLES\DANIEL.OBJ
Error: Unresolved external '_HB_FUN_ZERACOD' referenced from C:\FWH1701\SAMPLES\DANIEL.OBJ
Error: Unresolved external '_HB_FUN_QMESNUM' referenced from C:\FWH1701\SAMPLES\DANIEL.OBJ
Error: Unable to perform link
* Linking errors *

Link to comment
Share on other sites
CIACPD Newbie

CIACPD

Posted
Posted

Olá João, Tenta a rotina abaixo 

// -------------------------------------------------------------------------- //
function atualiza_hora()
      local xdia_atu , xhora_atu
      try
         oHttp := CreateObject( "winhttp.winhttprequest.5.1" )
         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
      
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))
//----------------------------------------------------------------------------// 

Daniel Segura

Link to comment
Share on other sites
kapiaba Enthusiast

kapiaba

Posted
  • Author
Posted

Perfect friend. Many thanks. Abs. 

#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: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 ) )
	//----------------------------------------------------------------------------//

Link to comment
Share on other sites

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.

Guest
Reply to this topic...

×   Pasted as rich text.   Paste as plain text instead

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

Loading...
×
 Share
Go to topic listing
×
×
  • Create New...