| Details:
You will find here below full content of mdChronoConvertion VBA module attached
Attribute VB_Name = “mdChronoConvertion”
Option Explicit
‘—————————————————————————————–
‘Internal types
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(31) As Integer
StandardDate As SYSTEMTIME
StandardBias As Long
DaylightName(31) As Integer
DaylightDate As SYSTEMTIME
DaylightBias As Long
End Type
‘—————————————————————————————–
‘Functions from the Windows API’s
Private Declare Function SystemTimeToTzSpecificLocalTime Lib “kernel32” _
(ByRef lpTimeZoneInformation As TIME_ZONE_INFORMATION, ByRef lpUniversalTime As SYSTEMTIME, ByRef lpLocalTime As SYSTEMTIME) As Integer
Private Declare Function TzSpecificLocalTimeToSystemTime Lib “kernel32” _
(ByRef lpTimeZoneInformation As TIME_ZONE_INFORMATION, ByRef lpLocalTime As SYSTEMTIME, ByRef lpUniversalTime As SYSTEMTIME) As Integer
Private Declare Function GetTimeZoneInformation _
Lib “kernel32” (lpTimeZoneInformation As TIME_ZONE_INFORMATION) As Long
‘—————————————————————————————–
‘Internal functions for simple conversion
Private Function SystemTimeToDate(lpSystemTime As SYSTEMTIME) As Date
Dim retDate As Date
retDate = DateTime.DateSerial(lpSystemTime.wYear, lpSystemTime.wMonth, lpSystemTime.wDay) + DateTime.TimeSerial(lpSystemTime.wHour, lpSystemTime.wMinute, lpSystemTime.wSecond)
SystemTimeToDate = retDate
End Function
Private Function DateToSystemTime(dtDate As Date) As SYSTEMTIME
Dim stResult As SYSTEMTIME
stResult.wYear = DateTime.Year(dtDate)
stResult.wMonth = DateTime.Month(dtDate)
stResult.wDay = DateTime.Day(dtDate)
stResult.wDayOfWeek = DateTime.Weekday(dtDate)
stResult.wHour = DateTime.Hour(dtDate)
stResult.wMinute = DateTime.Minute(dtDate)
stResult.wSecond = DateTime.Second(dtDate)
stResult.wMilliseconds = 0
DateToSystemTime = stResult
End Function
Private Function DateToChrono(dtDate As Date) As Double
Dim dblResult As Double
Dim dtRefDate As Date
dtRefDate = “01/01/1970 00:00:00”
dblResult = DateTime.DateDiff(“s”, dtRefDate, dtDate)
dblResult = dblResult * 10000000 + 1.16444736E+17
DateToChrono = dblResult
End Function
Private Function ChronoToDate(dblChrono As Double) As Date
Dim dtResult As Date
Dim dtRefDate As Date
Dim lNbSec As Long
lNbSec = (dblChrono – 1.16444736E+17) / 10000000
dtRefDate = “01/01/1970 00:00:00”
dtResult = DateTime.DateAdd(“s”, lNbSec, dtRefDate)
ChronoToDate = dtResult
End Function
‘—————————————————————————————–
‘Public functions
Public Function UTCTimeToLocalTime(dtUTC As Date) As Date
Dim dtResult As Date
Dim lpTimeZone As TIME_ZONE_INFORMATION
Dim lpUniversalTime As SYSTEMTIME
Dim lpLocalTime As SYSTEMTIME
lpUniversalTime = DateToSystemTime(dtUTC)
GetTimeZoneInformation lpTimeZone
SystemTimeToTzSpecificLocalTime lpTimeZone, lpUniversalTime, lpLocalTime
dtResult = SystemTimeToDate(lpLocalTime)
UTCTimeToLocalTime = dtResult
End Function
Public Function LocalTimeToUTCTime(dtLocal As Date) As Date
Dim dtResult As Date
Dim lpTimeZone As TIME_ZONE_INFORMATION
Dim lpUniversalTime As SYSTEMTIME
Dim lpLocalTime As SYSTEMTIME
lpLocalTime = DateToSystemTime(dtLocal)
GetTimeZoneInformation lpTimeZone
TzSpecificLocalTimeToSystemTime lpTimeZone, lpLocalTime, lpUniversalTime
dtResult = SystemTimeToDate(lpUniversalTime)
LocalTimeToUTCTime = dtResult
End Function
Public Function UTCTimeToPcVueChrono(dtUTC As Date) As Double
Dim dblResult As Double
dblResult = DateToChrono(dtUTC)
UTCTimeToPcVueChrono = dblResult
End Function
Public Function LocalTimeToPcVueChrono(dtLocal As Date) As Double
Dim dblResult As Double
Dim dtUTC As Date
dtUTC = LocalTimeToUTCTime(dtLocal)
dblResult = DateToChrono(dtUTC)
LocalTimeToPcVueChrono = dblResult
End Function
Public Function PcVueChronoToUTCTime(dblChrono As Double) As Date
Dim dtResult As Date
dtResult = ChronoToDate(dblChrono)
PcVueChronoToUTCTime = dtResult
End Function
Public Function PcVueChronoToLocalTime(dblChrono As Double) As Date
Dim dtResult As Date
Dim dtUTC As Date
dtUTC = ChronoToDate(dblChrono)
dtResult = UTCTimeToLocalTime(dtUTC)
PcVueChronoToLocalTime = dtResult
End Function
Download attachments: mdChronoConvertion.zip
|
