Capturar / obter Data e Hora de website

Olá a todos,

Apesar de já existir exemplo de capturar Data e Hora de Website, partilho outro exemplo.
Para este exemplo criei um website  dthr.dx.am  para consultar a Data e Hora num servidor em Linux com PHP.

No servidor criei um ficheiro index.php com o seguinte código:

Código:

<?php
date_default_timezone_set("Europe/Lisbon");
echo "" . date("d-m-Y H:i:s");
?>

A função responsável pela captura tem o seguinte código:

Código:

Function fncDataHoraNet() As Date
'ahteixeira 2018 para MaximoAccess
    
    Dim objIE As Object, objTb As Object

    Set objIE = CreateObject("InternetExplorer.Application")
    
    objIE.Visible = False
    objIE.Navigate "http://dthr.dx.am"
    
    Do While objIE.Busy: DoEvents: Loop
    Do While objIE.ReadyState <> 4: DoEvents: Loop
    
    Set objTb = objIE.Document.all.Item(i)
  
       fncDataHoraNet = objTb.innerText
    
    objIE.Quit
    Set objTb = Nothing
    Set objIE = Nothing
End Function

No exemplo que anexo, criei um botão com o seguinte código:

Código:

Private Sub CmdConsultar_Click()
'ahteixeira 2018 para MaximoAccess
'Requer função: fncDataHoraNet
Dim xData As Date

    Me.CmdConsultar.Caption = "Aguarde por favor"
    
    xData = fncDataHoraNet()
    
    Me.txtDataHora = xData
    Me.txtData = Left(xData, 10)
    Me.txtHora = Right(xData, 8)
    
    Me.CmdConsultar.Caption = "Consultar data e hora online"
End Sub

Abraço

Nota:
Aproveito para informar que este fórum é de Access e o código em PHP é apenas complemento do exemplo.
Não é permitido tirar dúvidas no Repositório de Exemplos.

Obrigado Amigos!

Olá a todos,

Adicionei um novo método na consulta ao website via "XML HttpRequest" que fica mais rápido:

Código:

Function fncDataHoraNetXML() As String
'ahteixeira 2020 para MaximoAccess
'requer a referencia Microsoft XML 6.0

    Dim xmlhttp As XMLHTTP60
    Dim sResposta As String

    Set xmlhttp = New XMLHTTP60
    
    xmlhttp.Open "GET", "http://dthr.dx.am/index.php" & "?cb=" & Timer() * 100, False
    xmlhttp.send

    sResposta = Trim(xmlhttp.ResponseText)
    fncDataHoraNetXML = sResposta
End Function

Requer a referência ao Microsoft XML 6.0.

Abraço

Olá a todos,

Aproveito para informar que criei outro endereço dthr.alwaysdata.net alternativo ao dthr.dx.am



A diferença é que o anterior está alojado num servidor que não permite ter o certificado SSL para uma ligação segura (https).
Fica o endereço alternativo para quem necessitar, o código é o mesmo só é necessário ajustar a URL.

Abraço

Olá a todos,

Como alguns colegas não tem servidor próprio e estão a usar as URLs do exemplo, foram adicionadas os seguinte fusos horários:

dthr.dx.am/belem.php
dthr.alwaysdata.net/belem.php

dthr.dx.am/manaus.php
dthr.alwaysdata.net/manaus.php

dthr.dx.am/noronha.php
dthr.alwaysdata.net/noronha.php

dthr.dx.am/rio_branco.php
dthr.alwaysdata.net/rio_branco.php

dthr.dx.am/sao_paulo.php
dthr.alwaysdata.net/sao_paulo.php

Se desejarem que seja adicionada mais alguma zona é só pedir.
Não esquecer de ajustar a URL no código na seguinte linha:

Código:

xmlhttp.Open "GET", "http://dthr.dx.am/sao_paulo.php" & "?cb=" & Timer() * 100, False

Abraço a todos