Hay alguna forma de tomar la fecha real de alguna WEB

[Bazooka]

Hola necesitaría tomar la fecha real desde algún lugar remoto y no tengo la menor idea!! alguna sugerencia?

Muchas gracias!!

[xkiz ™]

yo investigaria esta web: http://www.timeanddate.com/worldclock/

[Bazooka]

yo investigaria esta web: http://www.timeanddate.com/worldclock/

Hola si estan las horas y fechas de todos los paises ...
y? por donde empiezo?

[LeandroA]

Hola fijate este link http://vbnet.mvps.org/index.html?code/network/winsocksynctime.htm
en base a eso lo resumí para hacer una función

Código: (vb) [Seleccionar]


Option Explicit


Dim UTCDATE As Date
Dim lState As Long

Private Function GetRemoteDate() As String
    Dim lTimeOut As Long
   
    lState = 0
    UTCDATE = Empty
    lTimeOut = Timer + 5
       
    Winsock1.Close
    Winsock1.Connect "time-a.timefreq.bldrdoc.gov", 37
       
    Do While lState = 0
        DoEvents
        If lTimeOut < Timer Then lState = 2: Exit Do
    Loop
    If lState = 1 Then GetRemoteDate = UTCDATE
End Function

Private Sub Form_Load()
    MsgBox GetRemoteDate
End Sub

Private Sub Winsock1_DataArrival(ByVal bytesTotal As Long)
   On Error Resume Next
   Dim sTime As String
   Dim NTPTime As Double
   Dim dwSecondsSince1990 As Long
   
   If bytesTotal = 4 Then
        Winsock1.GetData sTime, vbString
        NTPTime = Asc(Left$(sTime, 1)) * (256 ^ 3) + _
                Asc(Mid$(sTime, 2, 1)) * (256 ^ 2) + _
                Asc(Mid$(sTime, 3, 1)) * (256 ^ 1) + _
                Asc(Right$(sTime, 1))
               
        dwSecondsSince1990 = NTPTime - 2840140800#

        UTCDATE = DateAdd("s", CDbl(dwSecondsSince1990), #1/1/1990#)
        If Err.Number = 0 Then lState = 1 Else lState = 2
        Winsock1.Close
   End If
   
End Sub

Private Sub Winsock1_Close()
   Winsock1.Close
   If lState = 0 Then lState = 2
End Sub

Private Sub Winsock1_Error(ByVal Number As Integer, Description As String, ByVal Scode As Long, ByVal Source As String, ByVal HelpFile As String, ByVal HelpContext As Long, CancelDisplay As Boolean)
    Winsock1.Close
    lState = 2
End Sub

Eso si esto te da la hora en UTC 0:00 después vos tenes que hacer la diferencia horaria de la pc: Saludos 

[Bazooka]

Buenisimo Leandro!!! sos un capo loco eso es exactamente lo que necesitaba!!!

[79137913]

HOLA!!!

http://www.timeapi.org/utc/now

GRACIAS POR LEER!!!

[LeandroA]

Buena ese link  79137913

aca un example, esta largo porque es una función que tenia para ese tipo de fecha, pero en ese caso puntual se puede simplificar, esa función si agrega la diferencia horaria

Código: (vb) [Seleccionar]


Private Declare Function GetTimeZoneInformation Lib "KERNEL32" (lpTimeZoneInformation As TIME_ZONE_INFORMATION) As Long
Private Type TIME_ZONE_INFORMATION
   Bias As Long
   None(0 To 169) As Byte
End Type


Public Function PubDateToVBDate(ByVal sPubDate As String) As Date
    Dim tTZI           As TIME_ZONE_INFORMATION
    Dim lRet As Long
    Dim TDelay As String
    Dim sSimbol As String
    Dim sHour As String
    Dim sMinute As String
    Dim ArrMonthEnglish As Variant
    Dim i As Long
 
    GetTimeZoneInformation tTZI
   
    sPubDate = UCase(sPubDate)
   
    ArrMonthEnglish = Array("JAN", "FEB", "MAR", "APR", "MAY", "JUN", "JUL", "AUG", "SEP", "OCT", "NOV", "DEC")
   
    For i = 0 To 11
        sPubDate = Replace(sPubDate, CStr(ArrMonthEnglish(i)), i + 1)
    Next
   
    If Len(sPubDate) = 5 Then
        sPubDate = Now & " " & sPubDate
    End If

    If IsDate(sPubDate) Then
        PubDateToVBDate = DateAdd("h", -(tTZI.Bias / 60), CDate(sPubDate))
        Exit Function
    End If
 
    lRet = InStr(sPubDate, ", ")
    If lRet Then
        sPubDate = Mid(sPubDate, lRet + 2)
    End If

    If IsDate(sPubDate) Then 'por las dudas
        PubDateToVBDate = DateAdd("h", -(tTZI.Bias / 60), CDate(sPubDate))
        Exit Function
    End If
   
    lRet = InStr(sPubDate, " ")

    If lRet = 0 Then
        sPubDate = Replace(sPubDate, "T", " ")
        If Right(sPubDate, 1) = "Z" Then
            sPubDate = Replace(sPubDate, "Z", "+00:00")
        End If
        TDelay = Replace(Right$(sPubDate, 6), ":", "")
        sPubDate = Left$(sPubDate, Len(sPubDate) - 6)
    Else
       
        Select Case Right(sPubDate, 3)
            Case "GMT":         TDelay = "+0000"
            Case "EDT":         TDelay = "-0400"
            Case "CDT", "EST":  TDelay = "-0500"
            Case "CST", "MDT":  TDelay = "-0600"
            Case "MST", "PDT":  TDelay = "-0700"
            Case "PST", "ADT":  TDelay = "-0800"
            Case "AST", "HDT":  TDelay = "-0900"
            Case "HDT":         TDelay = "-1000"
        End Select

        If Len(TDelay) Then
            sPubDate = Left(sPubDate, Len(sPubDate) - 4)
        Else
            TDelay = Right(sPubDate, 5)
            sPubDate = Left(sPubDate, Len(sPubDate) - 6)
         
        End If
    End If
   
    If IsDate(sPubDate) Then
   
        sSimbol = Left$(TDelay, 1)
        sHour = Mid$(TDelay, 2, 2)
        sMinute = Right$(TDelay, 2)
       
        If IsNumeric(sHour) And IsNumeric(sMinute) Then
            If sSimbol = "+" Then
                sPubDate = DateAdd("h", -Val(sHour), CDate(sPubDate))
                sPubDate = DateAdd("m", -Val(sMinute), CDate(sPubDate))
            ElseIf sSimbol = "-" Then
                sPubDate = DateAdd("h", Val(sHour), CDate(sPubDate))
                sPubDate = DateAdd("m", Val(sMinute), CDate(sPubDate))
            End If
           
            PubDateToVBDate = DateAdd("h", -(tTZI.Bias / 60), CDate(sPubDate))
     
        End If
       
    End If
           
End Function

Private Sub Form_Load()
MsgBox PubDateToVBDate(URLGet("http://www.timeapi.org/utc/now"))
End Sub


Function URLGet(URL)
  Set Http = CreateObject("Microsoft.XMLHTTP")
  Http.Open "GET", URL & "?RND=" & Timer, False
  Http.Send

  If Http.Status = "200" Then URLGet = Http.responseText
End Function