DateQ to msecond in +/-292277025 year

[gurj]

DateQ to msecond in +/-292277025 year
after use toDateQ,add overflow sense

Code: Select all

;DateQ to msecond in +/-292277025 year
;http://www.purebasic.fr/english/viewtopic.php?f=12&t=68808
;********* if not use ":" and not test ,true is 204 lines codes*********

;   DateQ.q: -9223372036854775808 To +9223372036854775807
;Dates:-292277025.5.16 16:47:4.192 To 292277025.8.18 7:12:55.807

;                                   -1 + 1ms = 0 :
; -0001.12.31_23:59:59.999 + 1ms = 0001.01.01_00:00:00.000
; -0001.12.31 is sunday, 0001.01.01 is monday

; 0-86400000 -> -1.12.31 0:0:0.0
;             0-1 -> -1.12.31 23:59:59.999
;                0 -> 1.1.1 0:0:0.0
;            0+1 -> 1.1.1 0:0:0.1
;0+86400000 -> 1.1.2 0:0:0.0

; -0001.12.31_00:00:00.000 - 1ms = -0001.12.30_23:59:59.999
; -0001.01.01_23:59:59.999 + 1ms = -0001.01.02_00:00:00.000
; *******Remarks:-0004 year and 0004 year is 2 leap year,but differ 7 years,because not use 0 year
; gurj: http://ataorj.ys168.com , 2017.08.26
;after use toDateQ,add overflow sense

Global.l yday,month,day
Procedure MonAndDay(Array Numbers.l(1))
 For i = 11 To 0 Step -1
  If yday>Numbers(i):month = i+1:day=yday-Numbers(i):Break:EndIf
 Next;*******[1-12][1-28/29/30/31]
EndProcedure

Dim normal.l(11):Dim leap.l(11):Dim mday.l(12)
Restore normal
For a=1 To 11
 Read.l normal(a)
Next
Restore leap
For a=1 To 11
 Read.l leap(a)
Next
For a=1 To 12
 Read.l mday(a)
Next

d1ms=24*60*60000;86400000
y400days=400*365+97;365.2425;146097
y400ms.q=y400days*d1ms;12622780800000
y100days=100*365+24   ;36524
y100ms.q=y100days*d1ms;3155673600000
y4days=4*365+1        ;1461
y4ms.q=y4days*d1ms    ;126230400000
                      ;y1days=365
y1ms.q=365*d1ms       ;31536000000

d7ms=7*d1ms;604800000

;-{test, all ok:
OpenWindow(0, 0, 0, 440, 332, "DateQ to msecond in +/-292277025 year", #PB_Window_SystemMenu | #PB_Window_MinimizeGadget | #PB_Window_ScreenCentered)
LoadFont(0,"System", 12, #PB_Font_Bold):SetGadgetFont(#PB_Default, FontID(0))
StringGadget(0, 165, 5, 270, 100,"", #ES_MULTILINE|#PB_String_ReadOnly)
StringGadget(13, 5, 5, 155, 100, "-0004 year and 0004 year is 2 leap year,but differ 7 years,because not use 0 year",#ES_MULTILINE|#PB_String_ReadOnly|#ESB_DISABLE_LEFT|#ESB_DISABLE_RIGHT)
SetGadgetColor(13,#PB_Gadget_BackColor,$77FAFA)
StringGadget(1, 165, 110, 195, 25, "");ComboBoxGadget's Editable has bug,so use StringGadget here
ComboBoxGadget(9, 165, 135, 195, 25)
ButtonGadget(2, 360, 110, 75, 25, "DateQto")

;FrameGadget(12, 5, 165, 430, 2, "", #PB_Frame_Flat)

out.s=FormatDate("%yyyy.%mm.%dd", #PB_Compiler_Date)
StringGadget(15, 5, 172, 155, 100,~"http://ataorj.ys168.com\r\n"+out ,#ES_MULTILINE|#PB_String_ReadOnly)
StringGadget(14, 165, 172, 270, 100,"", #ES_MULTILINE|#PB_String_ReadOnly)
StringGadget(3, 135, 277, 225, 25, "")
ButtonGadget(4, 360, 277, 75, 25, "toDateQ")
ComboBoxGadget(11, 135, 302, 225, 25)

ComboBoxGadget(5, 5, 110, 80, 25)
AddGadgetItem(5,-1,"1ms")
AddGadgetItem(5,-1,"1sec")
AddGadgetItem(5,-1,"1min")
AddGadgetItem(5,-1,"1hour")
AddGadgetItem(5,-1,"1day")
AddGadgetItem(5,-1,"1mon")
AddGadgetItem(5,-1,"1year")
AddGadgetItem(5,-1,"4year")
AddGadgetItem(5,-1,"100year")
AddGadgetItem(5,-1,"400year")
AddGadgetItem(5,-1,"1970.1.1")
Dim t.q(10):t(0)=1
t(1)=1000
t(2)=60000
t(3)=3600000
t(4)=86400000
t(5)=2592000000
t(6)=31536000000
t(7)=126230400000
t(8)=3155673600000
t(9)=12622780800000
t(10)=62135596800000

ButtonGadget(7, 85, 110, 40, 23, "+>")
ButtonGadget(8, 125, 110, 40, 23, "->")

AddGadgetItem(9,-1,"")
AddGadgetItem(9,-1,"-9223372036854775808")
AddGadgetItem(9,-1,"9223372036854775807")
AddGadgetItem(9,-1,"-9223372005318666666")
;********1970.1.1:
d1970.q=5*y400ms-7*y4ms-3*y1ms-d1ms;62135596800000,days=719163
;********Date()*1000+d1970:
dd=Date():AddGadgetItem(9,-1,Str(dd*1000+d1970))
AddGadgetItem(9,-1,"-"+d1ms)
AddGadgetItem(9,-1,"0")
AddGadgetItem(9,-1,""+d1ms)
SetGadgetState(9,4):SetGadgetText(1,GetGadgetText(9))
AddGadgetItem(11,-1,"")
AddGadgetItem(11,-1,"-292277025.5.16 16:47:4.192")
AddGadgetItem(11,-1,"292277025.8.18 7:12:55.807")
out.s=FormatDate("%yyyy.%mm.%dd %hh:%ii:%ss", dd)
AddGadgetItem(11,-1,out+".0")
AddGadgetItem(11,-1,"-292277024.5.15 16:48:53.334")
AddGadgetItem(11,-1,"-1.12.31 23:59:59.999")
AddGadgetItem(11,-1,"-1.12.31 0:0:0.0")
AddGadgetItem(11,-1,"-1.12.30 0:0:0.000")
AddGadgetItem(11,-1,"1.1.1 0:0:0.0")
AddGadgetItem(11,-1,"1.1.2 0:0:0.0")
AddGadgetItem(11,-1,"1970.1.1")
AddGadgetItem(11,-1,"1999.12.31 23:59:59.999")
AddGadgetItem(11,-1,"2000.1.1")
AddGadgetItem(11,-1,"2100.12.25 0:0:0")
AddGadgetItem(11,-1,"9999.12.25 0:0:0")
AddGadgetItem(11,-1,"0.2.31 55:66:77.-90")
AddGadgetItem(11,-1,"-292277025.5.16 16:47:4.191")
AddGadgetItem(11,-1,"292277025.8.18 7:12:55.809")

Goto start
Repeat:ev=WaitWindowEvent():Select ev
  Case #PB_Event_Gadget:eg=EventGadget()
   Select eg
    Case 2: :start: :DateQ.q=Val(GetGadgetText(1)):Gosub DateQto
     out.s=abs.s+year+"."+month+"."+day+" "+hour+":"+min+":"+sec+"."+ms+
           ~"\r\nDateQ="+DateQ+~"\r\ndays="+abs.s+days.q+
           ~"\r\nWDay="+wday+" YDay="+yday+" LeapYear="+m2day
     SetGadgetText(0,out)
    Case 5:g5t=GetGadgetState(5)
    Case 7:SetGadgetText(1,Str(Val(GetGadgetText(1))+t(g5t)))
    Case 8:SetGadgetText(1,Str(Val(GetGadgetText(1))-t(g5t)))
    Case 9,11:SetGadgetText(eg-8,GetGadgetText(eg))
    Case 4:dat0.s=GetGadgetText(3)
     
     date0.s=ReplaceString(dat0," ",".")
     date0=ReplaceString(date0,":",".")
     a=1
     year=Val(StringField(date0,a,".")):a+1
     month=Val(StringField(date0,a,".")):a+1
     day=Val(StringField(date0,a,".")):a+1
     hour=Val(StringField(date0,a,".")):a+1
     min=Val(StringField(date0,a,".")):a+1
     sec=Val(StringField(date0,a,".")):a+1
     ms=Val(StringField(date0,a,".")):a+1
     Gosub toDateQ
     If (abs="-" And DateQ>-1) Or (abs="" And DateQ<0):out="overflow!":Else
      If n1=1:out="updated:":Else:out="":EndIf
     out+date0+~"\r\nDateQ="+DateQ+~"\r\ndays="+abs.s+days.q+
         ~"\r\nWDay="+wday+" YDay="+yday+" LeapYear="+m2day:EndIf
     SetGadgetText(14,out)
   EndSelect
   
  Case #PB_Event_CloseWindow:Break
EndSelect:ForEver
;test}
End
DateQto: :tem.q=DateQ
If DateQ.q<0:tem+1:tem=-tem
 FirstOfWeekDay=0:abs.s="-"
 Else:FirstOfWeekDay=1:abs="":EndIf;*******[0-1][-,]
days.q=tem/d1ms
wday=(days+FirstOfWeekDay)%7              ;*******+wday
days+1                                    ;*******[-106751991168,106751991168]

y.q=tem/y400ms
year=y*400
days_.q=y*y400days
tem.q=tem%y400ms
y=tem/y100ms:If y=4:y=3:EndIf
year+y*100
days_+y*y100days
tem=tem-y*y100ms
y=tem/y4ms
year+y*4
days_+y*y4days
tem=tem%y4ms
y=tem/y1ms:If y=4:y=3:EndIf
year+y+1;*******[-292277025_292277025]
days_+y*365
tem=tem-y*y1ms
If year%400=0:m2day=1:ElseIf year%100=0:m2day=0
ElseIf year%4=0:m2day=1:Else:m2day=0:EndIf;*******[0,1]

If abs="-":wday=(7-wday)%7;*******-wday
tem=(365+m2day)*d1ms-1-tem:EndIf
yday=tem/d1ms+1:tem=tem%d1ms
;*******yday=1_365/366

If m2day=0:MonAndDay(normal()):Else:MonAndDay(leap()):EndIf
hour=tem/3600000:tem%3600000:min=tem/60000:tem%60000:sec=tem/1000:ms=tem%1000
;*******[1-23][0-59][0-59][0-999]
Return

toDateQ: :n1=0
If year<0:If year<-292277025:year=292277025:n1=1
  Else:year=-year:EndIf:abs.s="-":Else:abs="":EndIf;*******[-,]
If year>292277025:year=292277025:n1=1:ElseIf year=0:year=1:n1=1:EndIf;year*******
date0=abs+year+"."
If year%400=0:m2day=1:ElseIf year%100=0:m2day=0
ElseIf year%4=0:m2day=1:Else:m2day=0:EndIf;*******[0,1]
tem=year-1
DateQ=tem/400*y400ms
tem%400
DateQ+tem/100*y100ms
tem%100
DateQ+tem/4*y4ms
tem%4
DateQ+tem*y1ms
If month<1:month=1:n1=1:ElseIf month>12:month=12:n1=1:EndIf;*******
date0+month+".":mday(2)=28+m2day
If day<1:day=1:n1=1:ElseIf day>mday(month):day=mday(month):n1=1:EndIf;*******
date0+day+" "
If m2day=0:yday=normal(month-1)+day:Else:yday=leap(month-1)+day:EndIf
;yday=YearDay,*******

c.q=(yday-1)*d1ms
If hour>23:hour=23:n1=1:ElseIf hour<0:hour=0:n1=1:EndIf;*******
If min>59:min=59:n1=1:ElseIf min<0:min=0:n1=1:EndIf    ;*******
If sec>59:sec=59:n1=1:ElseIf sec<0:sec=0:n1=1:EndIf    ;*******
If ms>999:ms=999:n1=1:ElseIf ms<0:ms=0:n1=1:EndIf      ;*******
date0+hour+":"+min+":"+sec+"."+ms
c+ms+sec*1000+min*60000+hour*3600000
If abs="-":c=(365+m2day)*d1ms-c:DateQ=-DateQ-c
 days=-(DateQ+1)/d1ms
 Else:DateQ+c:days=DateQ/d1ms:EndIf;DateQ*******

days+1;days*******
Gosub WeekDay
Return

WeekDay:
If DateQ<0:tem=-(DateQ+1):FirstOfWeekDay=0
 Else:tem=DateQ:FirstOfWeekDay=1:EndIf
wday=tem%d7ms/d1ms
wday=(wday+FirstOfWeekDay)%7
If DateQ<0:wday=(7-wday)%7:EndIf
Return

DataSection
 normal:
 Data.l 31,59,90,120,151,181,212,243,273,304,334;,365 normal year
 leap:
 Data.l 31,60,91,121,152,182,213,244,274,305,335;,366 leap year
 mday:
 Data.l 31,28,31,30,31,30,31,31,30,31,30,31  ;28\29
EndDataSection

[RSBasic]

Hello gurj,

your code doesn't work with x64:

Code: Select all

 Read leap(a)

[ERROR] Read data error: no more data.

[gurj]

debug:

Code: Select all

2017.07.22 21:05:33
2017.7.22 21:5:33
WeekDay=6 YearDay=203 LeapYear=0
days=736532 DateQ=63636354333
-----------
-292277024627.1.26 8:29:53
WeekDay=4 YearDay=26 LeapYear=0
days=-106751991166987 DateQ=-9223372036854775807
-----------
292277024627.12.6 15:30:7
WeekDay=4 YearDay=340 LeapYear=0
days=106751991167301 DateQ=9223372036854775807
-----------
2000.1.2 0:0:0
WeekDay=0 YearDay=2 LeapYear=1
days=730121 DateQ=63082368000
-----------
2001.1.1 0:0:0
WeekDay=1 YearDay=1 LeapYear=0
days=730486 DateQ=63113904000
-----------
2002.1.1 0:0:0
WeekDay=2 YearDay=1 LeapYear=0
days=730851 DateQ=63145440000
-----------
2005.1.1 0:0:0
WeekDay=6 YearDay=1 LeapYear=0
days=731947 DateQ=63240134400
-----------
2101.1.1 0:0:0
WeekDay=6 YearDay=1 LeapYear=0
days=767010 DateQ=66269577600
-----------
-1.12.29 23:59:59
WeekDay=5 YearDay=363 LeapYear=0
days=-363 DateQ=-172801
-----------
-1.12.30 23:59:59
WeekDay=6 YearDay=364 LeapYear=0
days=-364 DateQ=-86401
-----------
-1.12.31 23:59:59
WeekDay=0 YearDay=365 LeapYear=0
days=-365 DateQ=-1
-----------
1.1.1 0:0:0
WeekDay=1 YearDay=1 LeapYear=0
days=1 DateQ=0
-----------
1.1.2 0:0:0
WeekDay=2 YearDay=2 LeapYear=0
days=2 DateQ=86400
-----------
1.1.3 0:0:0
WeekDay=3 YearDay=3 LeapYear=0
days=3 DateQ=172800
-----------

==================
@RSBasic:my is winxp X86, pb5.6, code is utf8
Read leap(a) doesn't work with x64 ? I known't why,sorry...

try this:

Code: Select all

; DateQ in +/-292277024627 year
;http://www.purebasic.fr/english/viewtopic.php?f=12&t=68808

; DateQ.q: -9223372036854775807[or 8] To +9223372036854775807
;      Dates:-292277024627.1.26 8:29:53 To 292277024627.12.6 15:30:7

;                            -1 + 1sec = 0 :
; -0001.12.31_23:59:59 + 1sec = 0001.01.01_00:00:00
; -0001.12.31 is sunday, 0001.01.01 is monday

; -0001.12.31_00:00:00 - 1sec = -0001.12.30_23:59:59
; -0001.01.01_23:59:59 + 1sec = -0001.01.02_00:00:00
; gurj: http://ataorj.ys168.com

Global.l yday,month,day
Procedure MonAndDay(Array Numbers.l(1), Length)
 For i = Length To 0 Step -1
  If yday>Numbers(i):month = i+1:day=yday-Numbers(i):Break:EndIf
 Next;*******[1-12][1-28/29/30/31]
EndProcedure

 normal.s="31,59,90,120,151,181,212,243,273,304,334"  ;,365 normal year
 leap.s="31,60,91,121,152,182,213,244,274,305,335"  ;,366 leap year

Dim normal.l(11):Dim leap.l(11)
For a=1 To 11
 normal(a)=Val(StringField(normal,a,","))
Next
For a=1 To 11
 leap(a)=Val(StringField(leap,a,","))
Next

d1secs=24*60*60
y400days=400*365+97;365.2425
y400secs.q=y400days*d1secs
y100days=100*365+24
y100secs.q=y100days*d1secs
y4days=4*365+1
y4secs=y4days*d1secs
;y1days=365
y1secs=365*d1secs

;-{test, all ok:
dd=Date():Debug FormatDate("%yyyy.%mm.%dd %hh:%ii:%ss", dd)
Date.q=2000/400*y400secs
DateQ.q=dd-Date(2001,1,1,0,0,0)+Date
Gosub Date_
DateQ=-9223372036854775808
Gosub Date_
DateQ=9223372036854775807
Gosub Date_
DateQ=Date-y1secs
Gosub Date_
DateQ=Date
Gosub Date_
DateQ=Date+y1secs
Gosub Date_
DateQ=Date+y4secs
Gosub Date_
DateQ=Date+y100secs
Gosub Date_
DateQ=-1-d1secs-d1secs
Gosub Date_
DateQ=-1-d1secs
Gosub Date_
DateQ=-1
Gosub Date_
DateQ=0
Gosub Date_
DateQ=d1secs
Gosub Date_
DateQ=d1secs+d1secs
Gosub Date_
;test}

End
Date_:
If DateQ<0:If DateQ=-9223372036854775808:DateQ=9223372036854775807
  Else:DateQ=Abs(DateQ):EndIf:FirstDayOfWeek=0:abs.s{1}="-"
 Else:FirstDayOfWeek=1:abs="":EndIf;*******[0,1][-,]
y.q=DateQ/y400secs
year.q=y*400
days.q=y*y400days
tem.q=DateQ%y400secs
y=tem/y100secs
year+y*100
days+y*y100days
tem=tem%y100secs
y=tem/y4secs
year+y*4
days+y*y4days
tem=tem%y4secs
y=tem/y1secs
year+y+1;*******[-292277024627_292277024627]
days+y*365
If year%400=0:m2day=1:ElseIf year%100=0:m2day=0
ElseIf year%4=0:m2day=1:Else:m2day=0:EndIf;*******[0,1]

tem=tem%y1secs:tem0=tem:days0.q=days
yday=tem/d1secs
days+yday
wday=(days+FirstDayOfWeek)%7 ;*******+wday
If abs="-":tem=(365+m2day)*d1secs-tem0
 wday=(7-wday)%7;*******-wday
 yday=tem/d1secs
days=days0+yday:EndIf 
yday+1                ;*******yday=1_366
days+1                ;*******days=-106751991166987_106751991167301
time=tem%d1secs

If m2day=0:MonAndDay(normal(),11):Else:MonAndDay(leap(),11):EndIf
hour=time/3600:time%3600:min=time/60:sec=time%60
;*******[1-23][0-59][0-59]

Debug abs+year+"."+month+"."+day+" "+hour+":"+min+":"+sec+
      ~"\nWeekDay="+wday+" YearDay="+yday+" LeapYear="+m2day+
      ~"\ndays="+abs+days+" DateQ="+abs+DateQ+~"\n-----------"
Return

; Structure DateQInfo
;  DateQ.q
;   yday.w    ; offset 0    : days since Jan 1 [1-365/366]
;   year.w    ; offset 2    : year [in +/-292277024627,Not 0]   
;   month.b   ; offset 4    : months [1-12]
;   day.b     ; offset 5    : day of the month [1-28/29/30/31]
;   hour.b    ; offset 6    : hours [0-23]
;   min.b     ; offset 7    : minutes [0-59]
;   sec.b     ; offset 8    : seconds [0-59]
;   wday.b    ; offset 9    : days since Sunday [0-6]
;   m2day.b  ;0=normal year,1=leap year
;   abs.s{1}
;   days.q
; EndStructure

[Demivec]

@RSBasic:my is winxp X86, pb5.6, code is utf8
Read leap(a) doesn't work with x64 ? I known't why,sorry...

The Read command should have the data type specified. If it is not specified it defaults to the integer type. This would read an 8 byte value on x64 and a 4 byte value on x86.

To correct it specify the Read type that matches the type used in the Data statements (i.e. '.l').

Replace the former statement with

Code: Select all

Read.l leap(a)

and the other read statement with

Code: Select all

Read.l normal(a)

[gurj]

thanks Demivec !
this ? :
line15 Global yday.q,month.b,day.b
to
Global yday.l,month.l,day.l

line16 Procedure MonAndDay(Array Numbers(1), Length)
to
Procedure MonAndDay(Array Numbers.l(1), Length)

line22 Dim normal(11):Dim leap(11)
to
Dim normal.l(11):Dim leap.l(11)

[gurj]

line25 and 29: Read
to
Read.l

[gurj]

old total is "DateQ in +/-292277024627 year",but has wrong.
now updated to "DateQ to msecond in +/-292277025 year".

[gurj]

update,after use toDateQ,add overflow sense

[gurj]

update,in toDateQ days a wrong.

[gurj]

updated,ok,no wrong.