Minimum PB v6.00 (Beta 5) because oleaut32
Code: Select all
;-TOP
; Comment : OLE Automation DateTime
; Author : mk-soft
; Version : v1.02.1
; Create : 27.02.2022
; Update : 07.03.2022
; OS : Windows
; Compiler : Purebasic v6.00
; *********************************************************
Import ""
SystemTimeToTzSpecificLocalTime(lpTimeZoneInformation, lpUniversalTime, lpLocaleTime)
TzSpecificLocalTimeToSystemTime(lpTimeZoneInformation, lpLocaleTime, lpUniversalTime)
VarWeekdayName(iWeekday, fAbbrev, iFirstDay, dwFlags, *pbstrOut)
VarMonthName(iMonth, fAbbrev, dwFlags, *pbstrOut)
VarBstrFromDate(dateIn.d, lcid, dwFlags, *pbstrOut)
VarFormatDateTime(*pvarIn.Variant, iNamedFormat, dwFlags, *pbstrOut)
EndImport
; Flags for GetStringFromDate
#VAR_TIMEVALUEONLY = ($00000001)
#VAR_DATEVALUEONLY = ($00000002)
#VAR_VALIDDATE = ($00000004)
#VAR_CALENDAR_HIJRI = ($00000008)
#VAR_LOCALBOOL = ($00000010)
#VAR_FORMAT_NOSUBSTITUTE = ($00000020)
#VAR_FOURDIGITYEARS = ($00000040)
#VAR_CALENDAR_THAI = ($00000080)
#VAR_CALENDAR_GREGORIAN = ($00000100)
; Contants for GetStringFormatDate
Enumeration
#GENERAL_DATE
#LONG_DATE
#SHORT_DATE
#LONG_TIME
#SHORT_TIME
EndEnumeration
; ---------------------------------------------------------
Procedure.d SetDate(Year, Month, Day, Hour, Minute, Second)
Protected time.SYSTEMTIME, vTime.d
With time
\wYear = Year
\wMonth = Month
\wDay = Day
\wHour = Hour
\wMinute = Minute
\wSecond = Second
EndWith
SystemTimeToVariantTime_(@time, @vTime)
ProcedureReturn vTime
EndProcedure
Procedure.d GetDate(UTC=#False)
Protected time.SYSTEMTIME, vTime.d
If UTC
GetSystemTime_(@time)
Else
GetLocalTime_(@time)
EndIf
SystemTimeToVariantTime_(@time, @vTime)
ProcedureReturn vTime
EndProcedure
Procedure.d GetUTCDateToLocalDate(Date.d)
Protected timeUTC.SYSTEMTIME, timeLocal.SYSTEMTIME, vTime.d
VariantTimeToSystemTime_(Date, @timeUTC)
SystemTimeToTzSpecificLocalTime(0, @timeUTC, @timeLocal)
SystemTimeToVariantTime_(@timeLocal, @vTime)
ProcedureReturn vTime
EndProcedure
Procedure.d GetLocalDateToUTCDate(Date.d)
Protected timeUTC.SYSTEMTIME, timeLocal.SYSTEMTIME, vTime.d
VariantTimeToSystemTime_(Date, @timeLocal)
TzSpecificLocalTimeToSystemTime(0, @timeLocal, @timeUTC)
SystemTimeToVariantTime_(@timeUTC, @vTime)
ProcedureReturn vTime
EndProcedure
Procedure GetYear(Date.d)
Protected time.SYSTEMTIME
VariantTimeToSystemTime_(Date, @time)
ProcedureReturn time\wYear
EndProcedure
Procedure GetMonth(Date.d)
Protected time.SYSTEMTIME
VariantTimeToSystemTime_(Date, @time)
ProcedureReturn time\wMonth
EndProcedure
Procedure GetDay(Date.d)
Protected time.SYSTEMTIME
VariantTimeToSystemTime_(Date, @time)
ProcedureReturn time\wDay
EndProcedure
Procedure GetHour(Date.d)
Protected time.SYSTEMTIME
VariantTimeToSystemTime_(Date, @time)
ProcedureReturn time\wHour
EndProcedure
Procedure GetMinute(Date.d)
Protected time.SYSTEMTIME
VariantTimeToSystemTime_(Date, @time)
ProcedureReturn time\wMinute
EndProcedure
Procedure GetSecond(Date.d)
Protected time.SYSTEMTIME
VariantTimeToSystemTime_(Date, @time)
ProcedureReturn time\wSecond
EndProcedure
Procedure GetDayOfWeek(Date.d)
Protected time.SYSTEMTIME
VariantTimeToSystemTime_(Date, @time)
ProcedureReturn time\wDayOfWeek
EndProcedure
Procedure.d AddDateValue(Date.d, Type, Value)
Protected r1.d
Select Type
Case #PB_Date_Day
r1 = Date + Value
Case #PB_Date_Hour
r1 = Date + (Value / 24.0)
Case #PB_Date_Minute
r1 = Date + (Value / 1440.0)
Case #PB_Date_Second
r1 = Date + (Value / 86400.0)
EndSelect
ProcedureReturn r1
EndProcedure
Procedure.d DiffDateValue(Date1.d, Date2.d, Type)
Protected r1.d
Select Type
Case #PB_Date_Day
r1 = (Date1 - Date2)
Case #PB_Date_Hour
r1 = (Date1 - Date2) * 24.0
Case #PB_Date_Minute
r1 = (Date1 - Date2) * 1440.0
Case #PB_Date_Second
r1 = (Date1 - Date2) * 86400.0
EndSelect
ProcedureReturn r1
EndProcedure
; ---------------------------------------------------------
Procedure.s GetNameOfWeek(Day, Short = 0)
Protected s1.s, r1, *bstr
If day <= 6
Day + 1
Else
day = 1
EndIf
r1 = VarWeekdayName(Day, Short, 1, 0, @*bstr)
If r1 = #S_OK
s1 = PeekS(*bstr)
SysFreeString_(*bstr)
Else
Debug r1
EndIf
ProcedureReturn s1
EndProcedure
Procedure.s GetNameOfMonth(Month, Short = 0)
Protected s1.s, r1, *bstr
r1 = VarMonthName(Month, Short, 0, @*bstr)
If r1 = #S_OK
s1 = PeekS(*bstr)
SysFreeString_(*bstr)
Else
Debug r1
EndIf
ProcedureReturn s1
EndProcedure
; ---------------------------------------------------------
Procedure.s GetStringFromDate(Date.d, Flags = 0)
Protected s1.s, r1, *bstr
r1 = VarBstrFromDate(Date, #LOCALE_USER_DEFAULT, Flags, @*bstr)
If r1 = #S_OK
s1 = PeekS(*bstr)
SysFreeString_(*bstr)
EndIf
ProcedureReturn s1
EndProcedure
Procedure.s GetStringFormatDate(Date.d, Format = 0, Flags = 0)
Protected s1.s, r1, var.variant, *bstr
var\vt = #VT_DATE
var\date = Date
r1 = VarFormatDateTime(@var, Format, Flags, @*bstr)
If r1 = #S_OK
s1 = PeekS(*bstr)
SysFreeString_(*bstr)
EndIf
ProcedureReturn s1
EndProcedure
Procedure.s GetSQLDateFromDate(Date.d)
Protected s1.s, r1, time.SYSTEMTIME
r1 = VariantTimeToSystemTime_(Date, @time)
If r1
With time
s1 = "'" + RSet(Str(\wYear), 4, "0")
s1 + "." + RSet(Str(\wMonth), 2, "0")
s1 + "." + RSet(Str(\wDay), 2, "0")
s1 + " " + RSet(Str(\wHour), 2, "0")
s1 + ":" + RSet(Str(\wMinute), 2, "0")
s1 + ":" + RSet(Str(\wSecond), 2, "0")
s1 + ".000'"
EndWith
EndIf
ProcedureReturn s1
EndProcedure
; *********************************************************
CompilerIf #PB_Compiler_IsMainFile
;-Test
Debug "----"
For i = 0 To 6
Debug GetNameOfWeek(i)
Next
Debug "----"
For i = 1 To 12
Debug GetNameOfMonth(i,1)
Next
Debug "----"
d1.d = GetDate()
d2.d = GetDate(#True)
Debug GetStringFromDate(d1)
Debug GetStringFromDate(d2)
Debug Round(DiffDateValue(d1, d2, #PB_Date_Second), #PB_Round_Nearest)
Debug "----"
Debug GetStringFormatDate(d1, #LONG_DATE)
Debug GetStringFormatDate(d1, #SHORT_DATE)
Debug GetStringFormatDate(d1, #LONG_TIME)
Debug GetStringFormatDate(d1, #SHORT_TIME)
d2.d = SetDate(2022, 2, 27, 12, 0, 0)
Debug "----"
Debug GetSQLDateFromDate(d1)
Debug GetSQLDateFromDate(d2)
CompilerEndIf
