We have Unix time in FB libraries and José Roca's WinFBX framework and other sources I should imagine. However, they all have one thing in common, an epoch of 1 January 1970. I wanted a user-defined epoch. Unix time generally has a resolution of one second, I wanted milliseconds. To that end I used the Windows APIs.
There are many uses for epoch time and, it seems to me, the number is only limited to our imagination. We have epoch in satellite-based time systems, for example.
The code relies heavily on two structures: SystemTime and FileTime. FileTime is calibrated to 100ns intervals but its resolution is that of SystemTime. 'Out of the box' SystemTime has a resolution of 15.625ms. If we changed the timer interval to 1ms, say, via timeBeginPeriod, for example, then FileTime's resolution would also be 1ms. However, FileTime can also be associated with the Performance Counter and here we use GetSystemTimePreciseAsFileTime which was introduced in Windows 8. The resolution is more than we need for milliseconds and will be clipped when we move from FileTime to SystemTime, but we can dispense with timeBeginPeriod. If you want to use the following code with an OS older than Windows 8 then use:-
Code: Select all
Declare Function SetTimerInterval Lib "winmm" Alias "timeBeginPeriod"(As Ulong=1) As Long
SetTimerInterval
I could check the host OS but I'm not going to get into that. If you want to distribute an exe using this code then use GetSystemTime().
The function EpochTimeToSystemTime() outputs according to DateFormat and TimeFormat in the 'Select/End Select' construct in EpochTimeToSystemTime(). These may be customized and a good place to see what we can do is to go to Control Panel>Region, with Windows 10 for sure, with drop down menus and an assortment of choices.
The code was tested using Notable events in Unix time and the function Main() covers them using, obviously, the epoch 1 January 1970; which can be changed in SystemTimeToEpochTime() and EpochTimeToSystemTime().
As a point of interest if you use the epoch 1 January 1900 then that will precede the oldest living person's date of birth so a date of birth epoch date can be calculated for any living person. With that epoch my date of birth epoch time is 1512518400000. I may change the epoch to 1 January 1920 making folk think that I am younger than I really am.
Final note: If anything untoward happens with SystemTimeToEpochTime() it will return zero like most APIs so check for a zero in your code; I haven't in the following code but then I know it works.
Code: Select all
'#Console on
#include once "windows.bi"
#include once "string.bi"
' Courtesy of Mr Swiss at the FreeBASIC forums
#Define IsFalse(e) ( Not CBool(e) )
#Define IsTrue(e) ( CBool(e) )
Union ulEpochtime
ft As FILETIME
ulDateTime as ulongint
End Union
Declare Function SystemTimeToEpochTime( Byval As SystemTime, ByVal As Long ) As UlongInt
Declare Function EpochTimeToSystemTime( ByVal As UlongInt, ByVal As Long, ByVal As Long, ByVal As Boolean ) As String
Declare Sub GetSystemTimeEx( ByRef As SystemTime )
Function Main () As Long
Dim As UlongInt EpochTime
Dim As ulEpochTime DateTime
Dim As Long i
' Test data from Notable events in Unix time ( https://en.wikipedia.org/wiki/Unix_time#Notable_events_in_Unix_time )
' The test data is in UTC so we use False for the second parameter of SystemTimeToEpochTime
' Note that the third parameter, 'WORD wDayOfWeek', is ignored by the following procedures
Dim As SystemTime TestTime = (1973, 10, 0, 17, 18, 36, 57, 0)
Print SystemTimeToEpochTime( TestTime, False )
TestTime = Type(2001, 9, 0, 9, 1, 46, 40, 0)
print SystemTimeToEpochTime( TestTime, False )
TestTime = Type(2009, 2, 0, 13, 23, 31, 30, 0)
Print SystemTimeToEpochTime( TestTime, False )
TestTime = Type(2033, 5, 0, 18, 3, 33, 20, 0)
Print SystemTimeToEpochTime( TestTime, False )
TestTime = Type(2038, 1, 0, 19, 3, 14, 8, 0)
Print SystemTimeToEpochTime( TestTime, False )
TestTime = Type(2065, 1, 0, 24, 5, 20, 0, 0)
Print SystemTimeToEpochTime( TestTime, False )
TestTime = Type(2106, 2, 0, 7, 6, 28, 15, 0)
Print SystemTimeToEpochTime( TestTime, False )
Print
' Get the current epoch time with high precision
Dim As SystemTime TimeNow
GetSystemTimeEx( TimeNow )
' Since we are using local time the second parameter is True
Epochtime = SystemTimeToEpochTime( TimeNow, True )
Print "Epoch time now: ";Epochtime
Print
' Output in local time
print "Milliseconds included" : Print
For i = 1 To 6
print EpochTimeToSystemTime( Epochtime, True, i, True)
Next
Print
Print "Milliseconds excluded" : Print
For i = 1 To 6
Print EpochTimeToSystemTime( Epochtime, True, i, False)
Next
Sleep
return 0
End Function
End Main()
Function SystemTimeToEpochTime( ByVal stGivenTime As SystemTime, ByVal Flag As Long ) As UlongInt
' Flag:
' If true then the given time is treated as local and converted to UTC stripping
' out local time and daylight savings otherwise it is treated as UTC
Dim As SystemTime stBaseTime, stUTCTime
Dim As FILETIME ftBaseTime, ftGivenTime
Dim As ulEpochTime DateTime
Dim as UlongInt GT, BT
' Change to whatever you want and in EpochTimeToSystemTime()
' This is Unix time and used by Microsoft
stBaseTime.wYear = 1970
stBaseTime.wMonth = 1
stBaseTime.wDay = 1
SystemTimeToFileTime @stBaseTime, @ftBaseTime
If IsTrue(Flag) Then
' Convert given time to UTC
TzSpecificLocalTimeToSystemTime ByVal 0, @stGivenTime, @stUTCTime
SystemTimeToFileTime @stUTCTime, @ftGivenTime
Else
' use given time as UTC
SystemTimeToFileTime @stGivenTime, @ftGivenTime
End If
DateTime.ft = ftGivenTime : GT = DateTime.ulDateTime
DateTime.ft = ftBaseTime : BT = DateTime.ulDateTime
If GT < BT Then
Function = 0
Else
Function = ( GT - BT )\10000 ' 10000000 = 10^9/100
End If
End Function
Sub GetSystemTimeEx( byref Result as SystemTime )
Dim ftFileTme As FILETIME
GetSystemTimePreciseAsFileTime ByVal VarPtr( ftFileTme )
FileTimeToSystemTime ByVal @ftFileTme, @Result
End Sub
Function EpochTimeToSystemTime( ByVal ulGivenEpochTime As UlongInt, ByVal Flag As Long, _
Byval FormatNum as Long, Byval ms As Boolean ) As String
' String return is Epoch time in readable Date/Time format
' Flag:
' If true then string return is local time and includes daylight
' savings according to PC's setup otherwise UTC.
' FormatNum - see 'Select/End Select' below
' ms - displays milliseconds if True and if TimeFormat <> ""
Dim As FILETIME ftBaseTime
dim as ulongint ulEpochTimetoSystemTime
Dim As SystemTime stBaseTime, stEpochTimetoSystemTime, stEpochTimeToLocalSystemTime, stDummyTime
Dim As ZString * 40 szFormat, szTemp
Dim As String sDateResult, sTimeResult
Dim As ulEpochTime DateTime
Dim As string DateFormat, TimeFormat
stBaseTime.wYear = 1970
stBaseTime.wMonth = 1
stBaseTime.wDay = 1
SystemTimeToFileTime @stBaseTime, @ftBaseTime
DateTime.ft = ftBaseTime
ulEpochTimetoSystemTime = DateTime.ulDateTime + ulGivenEpochTime*10000
DateTime.ulDateTime = ulEpochTimetoSystemTime
FileTimeToSystemTime @DateTime.ft, @stEpochTimetoSystemTime
If IsTrue(Flag) Then ' Output to local time and include daylight savings
SystemTimeToTzSpecificLocalTime ByVal 0, @stEpochTimetoSystemTime, @stEpochTimeToLocalSystemTime
stDummyTime = stEpochTimeToLocalSystemTime
Else ' output as UTC
stDummyTime = stEpochTimetoSystemTime
End If
Select Case As Const FormatNum
Case 1
DateFormat = "dddd',' d MMMM yyyy"
TimeFormat = "H':'mm':'ss"
Case 2
DateFormat = "dd'/'MM'/'yyyy"
TimeFormat = ""
Case 3
DateFormat = "d'/'M'/'yy"
TimeFormat = ""
Case 4
DateFormat = "dd'/'MM'/'yyyy"
TimeFormat = "HH':'mm"
Case 5
DateFormat = "d'/'M'/'yy"
TimeFormat = "H':'m"
Case 6
DateFormat = "dddd"
TimeFormat = ""
Case Else
DateFormat = "d'/'M'/'yy"
TimeFormat = ""
End Select
szFormat = DateFormat
GetDateFormat LOCALE_USER_DEFAULT, 0, @stDummyTime, @szFormat, @szTemp, SizeOf( szTemp )
sDateResult = szTemp
if TimeFormat <> "" Then
szFormat = TimeFormat
GetTimeFormat LOCALE_USER_DEFAULT, 0, @stDummyTime, @szFormat, @szTemp, SizeOf( szTemp )
sTimeResult = szTemp
End If
If TimeFormat <> "" Then
If IsTrue(ms) then
Function = sDateResult + " " + sTimeResult + ":" + format(stDummyTime.wMilliseconds, "000")
Else
Function = sDateResult + " " + sTimeResult
End If
Else
Function = sDateResult
End If
End Function