Visual Basic Foro
Programación => Visual Basic 6 => Mensaje iniciado por: Bazooka en Julio 13, 2012, 09:49:14 am
-
Hola necesitaría tomar la fecha real desde algún lugar remoto y no tengo la menor idea!! alguna sugerencia?
Muchas gracias!!
-
yo investigaria esta web: http://www.timeanddate.com/worldclock/
-
yo investigaria esta web: http://www.timeanddate.com/worldclock/
Hola si estan las horas y fechas de todos los paises ...
y? por donde empiezo?
-
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
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 :)
-
Buenisimo Leandro!!! sos un capo loco eso es exactamente lo que necesitaba!!!
-
HOLA!!!
http://www.timeapi.org/utc/now
GRACIAS POR LEER!!!
-
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
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