[Script] Clase VBScript para gestión de fechas y horas

Cortesía de Alex K. Angelopoulus [MVP] publicado en "microsoft.public.scripting.wsh"


Here's a date-and-time calculation class for people to look at, reuse, and
comment on as they see fit. (Paging Dr. Stockton!)

This is all WMI/filetime/timezone related; no ISO8601 representation info in
here. It could have been included, but the conceptual focus of this class is
conversions that fall outside the scope of mere reformatting of VT_DATE
constructs.

Material below is broken up into WHY; GENERAL INFO; KNOWN BUGS/LIMITATIONS;
CLASS DEMO CODE; and CLASS CODE.

==>
WHY?
This class is essentially written as a "wrapper" around a representation of
a point in time, and is intended to simplify working with both UTC/local
value issues and custom time formats which are not consistently supported on
various PC platforms.

For example:
+ WbemScripting.SWbemDateTime can be used to calculate WBEM and filetime
values - but it is not available before XP. The DMTF and Filetime
manipulations here depend on nothing beyond VBScript itself.
+ Time zone offset information is not available within VBScript, and all
dates are localized, making absolute calculations difficult. The class can
extract this information from the registry or a WMI string, and works in
terms of UTC time internally.

==>
GENERAL INFO
The class is instantiated like any internal class of course:
Set dt = New VBScriptDateTime

When instantiated, it determines the UTC time zone offset in minutes
(available thereafter in the ActiveBias property) and then initializes
itself to "Now" adjusted to UTC. So if the correct current date/time for
you is 2003-11-03 04:33:21 in the EST zone, the string representation
returned from the class if you pulled it immediately after instantiating
would be 2003-11-03 09:33:21.

You can "set" the internal time instance from a string/number/other
representation as required for local Date/UTC Date/JScript date/Unix time
(a.k.a. ctime() )/DMTF string (a.k.a. WBEM string)/filetime string.

You can then read the date/time value out in each of those formats as well,
allowing for easy translation.

To assist in special tasks, there are localToUTC and utcToLocal methods to
directly translate a VT_DATE between local and UTC time, and a
DateTimeSerial method which can be used to populate the instance from
year/month/day/hour/minute/second/millisecond values.

==>
KNOWN BUGS/LIMITATIONS
+ fromFileTimeString is a fake right now. It will throw an error if called.

==>
CLASS DEMO CODE

Set dt = New VBScriptDateTime
dt.DateTimeSerial 1990, 1, 1, 0, 0, 0, 0

WScript.Echo "toVBDateTime:", dt.toVBDateTime
WScript.Echo "tolocalVBDateTime:", dt.tolocalVBDateTime
WScript.Echo "toUnixTime:", dt.toUnixTime
WScript.Echo "toJavascript:", dt.toJScript
WScript.Echo "toDmtfString:", dt.toDmtfString
WScript.Echo "toFileTimeString:", dt.toFileTimeString
WScript.Echo "UTC-relative offset in minutes:", dt.ActiveBias
WScript.Echo "Right now the UTC date and time is:", dt.localToUTC( Now() )

==>
CLASS CODE

'==> ' NAME : Class VBScriptDateTime
'
' AUTHOR : Alex K. Angelopoulos , aka
' DATE : 2003-11-01
'
' About : This is a wrapper for describing an instant in time
' Initialized to Now().
'
' PUBLIC PROPERTIES AND METHODS:
'
' ActiveBias()
' Returns assumed UTC-relative bias for local system or
' original data. Note that this is automatically determined
' based on registry data EXCEPT for DMTF date strings.
'
' fromVbDateTime(vbDateTime) | toVBDateTime()
' Reads in or returns a UTC-referenced VT_DATE value.

' fromLocalVbDateTime(localVBDateTime) | tolocalVBDateTime()
' Reads in or returns a LOCAL VT_DATE value.
'
' fromJScript(jsDateTime) | toJScript()
' Reads in or returns time represented as a UTC-referenced
' "Javascript time" - milliseconds since midnight 1970-01-01 UTC.
'
' fromUnixTime(unixTime) | toUnixTime()
' Reads in or returns time represented as a UTC-referenced
' "Unix time" - seconds since midnight 1970-01-01 UTC.
'
' utcToLocal(vbDateTime) | localToUTC(vbDateTime)
' Translate a VT_DATE from local to UTC or UTC to local.
' DOES NOT affect the internal time instance.
'
' DateTimeSerial(y, m, d, h, n, s, msec)
' Sets value of time instance from set of serial values for date
' time elements - year, month, day, hour, minute, second, and
' milliseconds.
'
' fromDmtfString(WbemDateTimeValue) | toDmtfString()
' Reads in or returns time represented as a DMTF string, of the
' form yyyymmddhhnnss.xxxxxxbbbb
' 20031102065244.000000-300
' [y] year, [m] month, [d] day, [h] hour, [n] minute, [s] second,
' [x] microseconds, [b] UTC offset in minutes
'
' fromFileTimeString(fileTimeString) | toFileTimeString()
' Reads in or returns time represented as a "filetime string";
' handled as a string since 64-bit math is not directly possible
' in VBScript.
'
'==>
Class VBScriptDateTime
' Represents an instant in time, with various methods implemented
' to simplify deriving it from or presenting it in special formats:
' DMTF (a.k.a. WBEM) time strings, filetime strings, etc on systems
' which do not natively support them.

' Internal manipulation is done on a UTC-referenced date.
' A class for manipulating and translating various dates in VBScript,
' without requirements for special WMI support, 64-bit binaries, etc.
'
' This class just wraps up a UTC-referenced time-point, represented by
' a VT_DATE with auxiliary millisecond count.

' NOTE ON CALENDAR SECONDS -
' Seconds used in calculating the start of Unix time and file time
' may best be termed "calendar seconds" - the presumption is that
' there are exactly 86,400 of them per day.
' These contain the internal values for the date/time value;
' NOTE: these represent a UTC date/time - internal calculations are all
' presumed to be UTC unless otherwise noted; localized times determined
' from VBScript's internal non-UTC functions are immediately translated
' into UTC times where used.
Private [_vbDateTime] ' VT_DATE value. For our purposes, it is assumed
' that this value refers to a UTC-localized date-time.
Private [_milliseconds] ' contains millisecond portion of time
Private [_activeBias] ' local bias relative to UTC in minutes
Private [SerialSeconds_1970_01_01] ' constant containing serial seconds
' from the beginning of VBScript time to 1970-01-01
Private [SerialKiloSeconds_1601_01_01] ' constant containing thousands
' of serial seconds from 1601-01-01 to the beginning of VBScript time
' => ' Properties, initialization, and helper functions


Public Property Get ActiveBias()
' Returns system's current UTC-relative time bias in minutes
ActiveBias = [_activeBias]
End Property


Private Sub Class_initialize()
' set up some constants we will use.
[SerialSeconds_1970_01_01] = 2209161600
[SerialKiloSeconds_1601_01_01] = 9435312
' first step is to get the time zone bias
[_activeBias] = ActiveBiasFromRegistry()
' now populate the internal date and time values from "Now()"
' to give us the default time stamp value...
fromLocalVbDateTime Now()
' Will we read localized values and output localized values?
' We default to false.
End Sub


Public Function localToUTC(vbDateTime)
' takes a local VT_DATE and converts it to a UTC value
' based on system's settings.
localToUTC = DateAdd("n", - [_activeBias], vbDateTime)
End Function


Public Function utcToLocal(vbDateTime)
' takes a UTC VT_DATE and converts it to a local value
' based on system's settings.
utcToLocal = DateAdd("n", [_activeBias], vbDateTime)
End Function


Private Function ActiveBiasFromRegistry()
' Returns UTC active offset bias from the registry in minutes.
' This is what you would ADD to a local time to turn
' it into a UTC time, or SUBTRACT from a UTC time to
' get it into local time.
Dim tzBias, i, tzBiasValue
tzBiasValue = CreateObject("Wscript.Shell"). _
RegRead("HKLM\System\CurrentControlSet\Control\" _
& "TimeZoneInformation\ActiveTimeBias")
Select Case VarType(tzBiasValue)
case vbLong tzBias = tzBiasValue
case vbVariant
tzBias = 0
For i = 0 To UBound(tzBiasValue)
tzBias = tzBias + (tzBiasValue(k) * 256^k)
Next
case else
err.raise vbObjectError + 1, "ActiveTimeBias", _
"Can't recognize type of data: " & tzBiasValue
end select
' now flip the sign to get offset relative to UTC.
ActiveBiasFromRegistry = - CLng(tzBias)
End Function


Public Function LP0( num, i)
' takes number num and left pads it with zeros to length i
' The function name is simply to make calls more compact;
' LeftPadwithZeros() would be a more precise name.
dim diff: diff = i - len(num)
if diff > 0 then LP0 = String(diff, "0") & num else LP0 = num
End Function


' => ' "FROM" functions - these initialize the internal date-time value
' from various types of source data.

Public Sub fromLocalVbDateTime(localVBDateTime)
fromVbDateTime CDate( localVBDateTime - CDate([_activeBias]/24/60) )
End Sub


Public Sub fromVbDateTime(vbDateTime)
' populates internal time value from a UTC-adjusted VT_DATE
[_vbDateTime] = vbDateTime
[_milliseconds] = 0
End Sub


Public Sub fromDmtfString(WbemDateTimeValue)
' populates internal time and bias values from a DMTF time string;
' e.g.: "20031102065244.000000-300"
' NOTE: - THIS WILL OVERRIDE THE LOCAL BIAS VALUE
dim y, mon, d, h, min, sec
y = CLng( Left(WbemDateTimeValue, 4) )
mon = CLng( Mid(WbemDateTimeValue, 5, 2) )
d = CLng( Mid(WbemDateTimeValue, 7, 2) )
h = CLng( Mid(WbemDateTimeValue, 9, 2) )
min = CLng( Mid(WbemDateTimeValue, 11, 2) )
sec = CLng( Mid(WbemDateTimeValue, 13, 2) )
[_milliseconds] = CDbl( Mid(WbemDateTimeValue, 16, 6)/1000 )
[_activeBias] = CLng( Right(WbemDateTimeValue, 4) )
[_vbDateTime] = CDate( _
CDBl( DateSerial(y, mon, d) ) _
+ ( (sec/60 + min)/60 + h )/24 _
)
End Sub


Public Sub fromJScript(jsDateTime)
' populate our date-time string value from the Javascript date/time;
' note that Javascript time uses the same base as Unix time
FromVbDateTime CDate(jsDateTime/1000 + [SerialSeconds_1970_01_01])
' We will lose javascript's milliseconds in the process, so we set
' the value here. To prevent a near-certain overflow, we convert to
' a string and then take the right-hand portion of the value.
[_milliseconds] = CLng( Right(Round(jsDateTime), 3) )
End Sub


Public Sub fromUnixTime(unixTime)
FromVbDateTime CDate(unixTime + [SerialSeconds_1970_01_01])
End Sub


Public Sub fromFileTimeString(fileTimeString)
' populates from a string representation of a 64-bit integer filetime
Err.Raise vbObjectError + 911, "fromFileTimeString", _
"This function is not yet implemented."
End Sub


Public Sub DateTimeSerial(y, m, d, h, n, s, msec)
[_vbDateTime] = CDate( DateSerial(y, m, d) + TimeSerial(h, n, s) )
[_milliseconds] = msec
end sub


' => ' "TO" functions - these return the internal date-time value in
' various forms/formats.


Public Function toVBDateTime()
' Returns a VB date-time string
toVBDateTime = [_vbDateTime]
End Function


Public Function tolocalVBDateTime()
' Returns a VB date-time string
tolocalVBDateTime = [_vbDateTime] + CDate([_activeBias]/24/60)
End Function


Private Function toSerialSeconds()
' Returns the time instance represented as serial seconds
toSerialSeconds = [_vbDateTime]*86400 + [_milliseconds]/1000
End Function


Public Function toUnixTime()
toUnixTime = toSerialSeconds() - [SerialSeconds_1970_01_01]
End Function


Public Function toJScript()
' Returns the time instance in a Javascript date/time format.
' note that Javascript time uses the same base as Unix time, just in
' milliseconds instead of seconds so this looks like the toUnixTime
' function.
toJScript = (toSerialSeconds() - [SerialSeconds_1970_01_01]) * 1000
End Function


Public Function toDmtfString()
' Returns the time instance in a DMTF time string.
dim ymdhns ' string for building year-month-day-hour-minute-second
dim muSec ' string used for building microseconds
dim tzBias ' string used for building the TZ offset
dim t: t = utcToLocal([_vbDateTime])
ymdhns = LP0(year(t), 4) & LP0(month(t), 2) & LP0(day(t), 2) _
& LP0(hour(t), 2) & LP0(minute(t), 2) & LP0(second(t), 2)
muSec = LP0(Round([_milliseconds]*1000), 6)
if Sgn([_activeBias]) = -1 then tzBias = "-" else tzBias = "+"
tzBias = tzBias & LP0(Abs([_activeBias]), 4)
toDmtfString = ymdhns & "." & muSec & tzBias
End Function


Public Function toFileTimeString()
' Returns the time instance as a string corresponding to a 64-bit
' integer file time.
' This is a bit cumbersome; basically we cheat on this by breaking
' our analysis down into thousands of seconds and everything else.
dim hiSec, loSec, tmp
tmp = toSerialSeconds()
loSec = LP0( CLng( ( tmp - Int(tmp/1000)*1000 ) ), 2 ) _
& String(7, "0")
hiSec = CLng( Int(tmp/1000) + [SerialKiloSeconds_1601_01_01] )
toFileTimeString = hiSec & loSec
End Function


End Class



Saludos
Ramon Jimenez
Microsoft Services