Información Zona Horaria

Crea un nuevo proyecto, pega el código en un formulario y pulsa F5:

Option Explicit
Private Type SYSTEMTIME
   wYear As Integer
   wMonth As Integer
   wDayOfWeek As Integer
   wDay As Integer
   wHour As Integer
   wMinute As Integer
   wSecond As Integer
   wMilliseconds As Integer
End Type
Private Type TIME_ZONE_INFORMATION
   Bias As Long
   StandardName(0 To 63) As Byte
   StandardDate As SYSTEMTIME
   StandardBias As Long
   DaylightName(0 To 63) As Byte
   DaylightDate As SYSTEMTIME
   DaylightBias As Long
End Type
Private Declare Function GetTimeZoneInformation Lib "kernel32" (lpTimeZoneInformation As TIME_ZONE_INFORMATION) As Long
Private Sub Form_Load()
    Dim nRet As Long, Tz As TIME_ZONE_INFORMATION
    Dim Valor As Long, Cadena As String
    
    Valor = GetTimeZoneInformation(Tz)
    If Valor  -1 Then
        Select Case nRet
            Case 0: Cadena = "Desconocido"
            Case 1: Cadena = "Estándar"
            Case 2: Cadena = "Daylight Savings Time..."
        End Select
        Cadena = CStr(Tz.StandardName)
        Cadena = Left(Cadena, InStr(Cadena + Chr(0), Chr(0)) - 1)
        Print "UTC Bias: " & Tz.Bias / 60 & " hrs."
        Print " ST Zone: " & Cadena
        Print " ST Date: " & tzDate(Tz.StandardDate)
        Print " ST Bias: " & Tz.StandardBias & " mins."
        Print " DT Zone: " & Format(Tz.DaylightName)
        Print " DT Date: " & tzDate(Tz.DaylightDate)
        Print " DT Bias: " & Tz.DaylightBias & " mins."
    End If
End Sub
Private Function tzDate(St As SYSTEMTIME) As Date
    Dim I As Long, N As Long, D1 As Long, D2 As Long
    
    If St.wYear Then
        tzDate = DateSerial(St.wYear, St.wMonth, St.wDay) + TimeSerial(St.wHour, St.wMinute, St.wSecond)
    Else
        D1 = DateSerial(Year(Now), St.wMonth, 1)
        D2 = DateSerial(Year(D1), St.wMonth + 1, 0)
        If St.wDay = 5 Then
            For I = D2 To D1 Step -1
                If WeekDay(I) = (St.wDayOfWeek + 1) Then Exit For
            Next
        Else
            For I = D1 To D2
                If WeekDay(I) = (St.wDayOfWeek + 1) Then
                    N = N + 1
                    If N = St.wDay Then Exit For
                End If
            Next
        End If
        tzDate = I + TimeSerial(St.wHour, St.wMinute, St.wSecond)
    End If
End Function

NOTA: Recuerda que para que Print sea efectivo el formulario debe tener la propiedad AutoRedraw a True.

Anuncios

Responder

Introduce tus datos o haz clic en un icono para iniciar sesión:

Logo de WordPress.com

Estás comentando usando tu cuenta de WordPress.com. Cerrar sesión /  Cambiar )

Google photo

Estás comentando usando tu cuenta de Google. Cerrar sesión /  Cambiar )

Imagen de Twitter

Estás comentando usando tu cuenta de Twitter. Cerrar sesión /  Cambiar )

Foto de Facebook

Estás comentando usando tu cuenta de Facebook. Cerrar sesión /  Cambiar )

Conectando a %s