Functions for Internet DateTime (GMT,RFC822,ISO8601)

Share your advanced PureBasic knowledge/code with the community.
User avatar
Flype
Addict
Addict
Posts: 1542
Joined: Tue Jul 22, 2003 5:02 pm
Location: In a long distant galaxy

Functions for Internet DateTime (GMT,RFC822,ISO8601)

Post by Flype »

Code updated For 5.20+

Here are some useful procs for playing with RFC822 and ISO8601 datetime.

Code: Select all

;-
;- Functions for GMT, RFC822, ISO8601
;-

Enumeration -1 ; #TIME_ZONE_ID_
  #TIME_ZONE_ID_INVALID
  #TIME_ZONE_ID_UNKNOWN
  #TIME_ZONE_ID_STANDARD
  #TIME_ZONE_ID_DAYLIGHT
EndEnumeration

Procedure Bias()
  
  ; Retourne la différence de temps (en minutes) entre la date GMT et la date locale.
  ; Returns the time difference (in minutes) between the GMT date and the locale date.
  
  Protected a.TIME_ZONE_INFORMATION, lRes
  
  Select GetTimeZoneInformation_(a.TIME_ZONE_INFORMATION)
    Case #TIME_ZONE_ID_STANDARD
      If a\StandardDate\wMonth
        lRes = a\StandardBias
      EndIf
    Case #TIME_ZONE_ID_DAYLIGHT
      If a\DaylightDate\wMonth
        lRes = a\DaylightBias
      EndIf
  EndSelect
  
  lRes + a\Bias
  
  ProcedureReturn lRes
  
EndProcedure
Procedure.s TimeZone()
  
  ; Retourne la différence de temps (+/-0000) entre la date GMT et la date locale.
  ; Returns the time difference (+/-0000) between the GMT date and the locale date.
  
  Protected tz.s
  
  If Bias() > 0
    tz = "-"
  Else
    tz = "+"
  EndIf
  
  tz + RSet(Str(Abs(Bias())/0.6),4,"0")
  
  ProcedureReturn tz
  
EndProcedure

Procedure Gmt(date)
  
  ; Retourne la date spécifiée, avec la correction GMT.
  ; Returns the specified date, with the GMT correction.
  
  Protected lRes
  
  lRes = AddDate(date,#PB_Date_Minute,Bias())
  
  ProcedureReturn lRes
  
EndProcedure
Procedure LCID(lang.b,sublang.b)
  
  ; Retourne une valeur LCID utilisable avec GetDateFormat_() par ex.
  ; Returns a LCID value for use with GetDateFormat_() for example.
  
  Protected  lRes
  
  lRes = (#SORT_DEFAULT<<16) | ( (sublang<<10) | lang )
  
  ProcedureReturn lRes
  
EndProcedure

Procedure.s FormatDate_Win32(mask.s,date,lang,sublang)
  
  ; Retourne une date formatée par l'API Win32.
  ; Returns a formatted string of the specified date.
  
  Protected sRes.s, a.SYSTEMTIME
  
  a\wYear  = Year(date)
  a\wMonth = Month(date)
  a\wDay   = Day(date)
  
  sRes = Space(255)
  GetDateFormat_(LCID(lang,sublang),0,a,mask,sRes,255)
  
  ProcedureReturn sRes
  
EndProcedure
Procedure.s FormatDate_Rfc822(date,mode.b)
  
  ; Retourne la date spécifiée en respectant la norme RFC-822.
  ; Returns a RFC-822 string of the specified date.
  
  Protected  tz.s, sRes.s
  
  If mode
    tz = "GMT" : date = Gmt(date)
  Else
    tz = TimeZone()
  EndIf
  
  sRes = FormatDate_Win32("ddd, d MMM yyyy ",date,#LANG_ENGLISH,#SUBLANG_ENGLISH_UK)
  sRes + FormatDate("%hh:%ii:%ss ",date) + tz
  
  ProcedureReturn sRes
  
EndProcedure
Procedure.s FormatDate_Iso8601(date,mode.b)
  
  ; Retourne la date spécifiée en respectant la norme ISO-8601.
  ; Returns a ISO-8601 string of the specified date.
  
  Protected tz.s, sRes.s
  
  If mode
    tz = "Z" : date = Gmt(date)
  Else
    tz = TimeZone()
  EndIf
  
  sRes = FormatDate("%yyyy-%mm-%ddT%hh:%ii:%ss",date) + tz
  
  ProcedureReturn sRes
  
EndProcedure

Procedure ParseDate_Rfc822(rfc.s)
  
  ; Retourne la date interprétée depuis une date à la norme RFC-822.
  ; Returns a date from a RFC-822 string.
  
  Protected tz.s, sTmp.s, lRes, a.SYSTEMTIME
  
  If FindString(rfc,",",1) = 0
    rfc = "Mon, " + rfc
  EndIf
  
  For i=1 To 5
    sTmp + StringField(rfc,i," ") + " "
  Next
  
  If InternetTimeToSystemTime_(sTmp,a,0)
    
    tz = StringField(rfc,6," ")
    
    Select tz
      Case ""    : tz = "+0000"
      Case "UT"  : tz = "+0000"
      Case "GMT" : tz = "+0000"
      Case "EST" : tz = "-0500"
      Case "EDT" : tz = "-0400"
      Case "CST" : tz = "-0600"
      Case "CDT" : tz = "-0500"
      Case "MST" : tz = "-0700"
      Case "MDT" : tz = "-0600"
      Case "PST" : tz = "-0800"
      Case "PDT" : tz = "-0700"
      Case "A"   : tz = "-0100"
      Case "B"   : tz = "-0200"
      Case "C"   : tz = "-0300"
      Case "D"   : tz = "-0400"
      Case "E"   : tz = "-0500"
      Case "F"   : tz = "-0600"
      Case "G"   : tz = "-0700"
      Case "H"   : tz = "-0800"
      Case "I"   : tz = "-0900"
      Case "K"   : tz = "-1000"
      Case "L"   : tz = "-1100"
      Case "M"   : tz = "-1200"
      Case "N"   : tz = "+0100"
      Case "O"   : tz = "+0200"
      Case "P"   : tz = "+0300"
      Case "Q"   : tz = "+0400"
      Case "R"   : tz = "+0500"
      Case "S"   : tz = "+0600"
      Case "T"   : tz = "+0700"
      Case "U"   : tz = "+0800"
      Case "V"   : tz = "+0900"
      Case "W"   : tz = "+1000"
      Case "X"   : tz = "+1100"
      Case "Y"   : tz = "+1200"
    EndSelect
    
    lRes = Date(a\wYear,a\wMonth,a\wDay,a\wHour,a\wMinute,a\wSecond)
    lRes = AddDate(lRes,#PB_Date_Minute,-Val(tz)*0.6)
    lRes = AddDate(lRes,#PB_Date_Minute,-Bias())
    
  EndIf
  
  ProcedureReturn lRes
  
EndProcedure
Procedure ParseDate_Iso8601(iso.s)
  
  ; Retourne la date interprétée depuis une date à la norme ISO-8601.
  ; Returns a date from a ISO-8601
  
  Protected  tz.s, lRes
  
  tz = Mid(iso,20,Len(iso)-19)
  
  If tz = "Z"
    tz = "+0000"
  EndIf
  
  lRes = ParseDate("%yyyy-%mm-%ddT%hh:%ii:%ssZ",iso)
  lRes = AddDate(lRes,#PB_Date_Minute,-Val(tz)*0.6)
  lRes = AddDate(lRes,#PB_Date_Minute,-Bias())
  
  ProcedureReturn lRes
  
EndProcedure

;-

mask.s = "%dd/%mm/%yyyy %hh:%ii:%ss"
date = Date(2005,10,1,1,0,0)
rfc1.s = FormatDate_Rfc822(date,0)
rfc2.s = FormatDate_Rfc822(date,1)
iso1.s = FormatDate_Iso8601(date,0)
iso2.s = FormatDate_Iso8601(date,1)

Debug ""
Debug "TEST GMT"
Debug Bias()
Debug TimeZone()
Debug FormatDate(mask,date)
Debug FormatDate(mask,Gmt(date))

Debug ""
Debug "TEST RFC-822"
Debug rfc1
Debug rfc2
Debug FormatDate(mask,ParseDate_Rfc822(rfc1))
Debug FormatDate(mask,ParseDate_Rfc822(rfc2))

Debug ""
Debug "TEST ISO-8601"
Debug iso1
Debug iso2
Debug FormatDate(mask,ParseDate_Iso8601(iso1))
Debug FormatDate(mask,ParseDate_Iso8601(iso2)) 
No programming language is perfect. There is not even a single best language.
There are only languages well suited or perhaps poorly suited for particular purposes. Herbert Mayer