Page 1 of 1

NTP / SetDate / TimeZone

Posted: Mon Jan 16, 2006 12:37 am
by Droopy
This functions can Set Local Time / Get Time from a NTP Server / Get Time Zone information

Code: Select all

;/ Get Time from NTP Server / Set Local Time / Get Time Zone information
; Droopy 15/01/06 + Fweil for TimeZone functions
; PureBasic 3.94

ProcedureDLL.s GetTimeZoneName() ; Return the name of the Time Zone
  ;/ Author : Fweil
  
  GetTimeZoneInformation_(TimeZoneInfo.TIME_ZONE_INFORMATION)
  While TimeZoneInfo\StandardName[i] <>0 And i <= 32 
    sStandardName.s + Chr(TimeZoneInfo\StandardName[i]) 
    i + 1 
  Wend 
  ProcedureReturn sStandardName
EndProcedure

ProcedureDLL GetTimeZone() ; Hour to add to the UTC hour
  ;/ Author : Fweil
  GetTimeZoneInformation_(TimeZoneInfo.TIME_ZONE_INFORMATION)
  Retour=-TimeZoneInfo\bias/60
  ProcedureReturn Retour
EndProcedure

ProcedureDLL SetDate(Date) ; Set the System Date : Return 1 if success
  Heure.SYSTEMTIME
  Heure.SYSTEMTIME\wYear=Year(Date)
  Heure.SYSTEMTIME\wMonth=Month(Date)
  Heure.SYSTEMTIME\wDay=Day(Date)
  Heure.SYSTEMTIME\wDayOfWeek=DayOfWeek(Date)
  Heure.SYSTEMTIME\wHour=Hour(Date)
  Heure.SYSTEMTIME\wMinute=Minute(Date)
  Heure.SYSTEMTIME\wSecond=Second(Date)
   
  If SetSystemTime_(Heure)
    ProcedureReturn 1
  Else
    ProcedureReturn 0
  EndIf
EndProcedure

ProcedureDLL GetNTPTime(NTPServer.s,TimeOut) ; Ask a NTP Server and return the Date as PureBasic format / 0 if it could not be joined
  ; Server = time.ien.it / time.nist.gov / ntp1.fau.de
  
  InitNetwork()
  CnxionId= OpenNetworkConnection(NTPServer,37)
  
  If CnxionId
    
    ;/ Wait until the Server Send Datas 
    While NetworkClientEvent(CnxionId)=0 
      Delay(1) 
      T+1 
      If T>TimeOut
        ProcedureReturn 0 
      EndIf 
    Wend 
    
    ;/ Wait until the Server Send Datas
    While NetworkClientEvent(CnxionId)=0
      Delay(1)
    Wend
    
    ;/ Get four Bytes
    Buffer.s=Space(4)
    ReceiveNetworkData(CnxionId,Buffer,4)
    CloseNetworkConnection(CnxionId)
    
    ;/ Calcule the Date as PureBasic Format ( UTC )
    NTPTime=Asc(Left(Buffer,1))*16777216 + Asc(Mid(Buffer,2,1))*65536 + Asc(Mid(Buffer,3,1))*256 + Asc(Right(Buffer,1)) - 2840140800
    NTPTime=AddDate(NTPTime,#PB_Date_Year,20) ; Add 20 years
    
    ProcedureReturn NTPTime
  Else
    ProcedureReturn 0
  EndIf
EndProcedure

ProcedureDLL GetNTPTime2(NTPServer.s) ; Default TimeOut = 120ms
  ProcedureReturn GetNTPTime(NTPServer.s,120)
EndProcedure

;/ Test
NTPTime=GetNTPTime2("time.ien.it")

If NTPTime
  ;/ Set the Computer Time as NTP Time
  SetDate(NTPTime)
  
  ;/ Show information about Hour
  Temp.s="UTC Time : "+FormatDate(" %dd/%mm/%yy %hh:%ii:%ss",NTPTime)+#CR$
  Temp+"Zone : "+GetTimeZoneName()+#CR$
  Temp+"Shift : "+Str(GetTimeZone())+" hour(s)"+#CR$
  Temp+"Local Time as US format : "+FormatDate(" %mm/%dd/%yy %hh:%ii:%ss",NTPTime+GetTimeZone()*60*60)+#CR$
  Temp+"Local Time as French format : "+FormatDate(" %dd/%mm/%yy %hh:%ii:%ss",NTPTime+GetTimeZone()*60*60)+#CR$
  MessageRequester("UTC et NTP",Temp)
EndIf

Posted: Mon Jan 16, 2006 6:08 pm
by Tranquil
Nice code.

Wouldn't it be better to check a timeout in the message pooling loop?

Code: Select all

;/ Wait until the Server Send Datas
    While NetworkClientEvent(CnxionId)=0
      Delay(1)
      TimeOut + 1
      If TimeOut>120
        ProcedureReturn 0
      EndIf
    Wend
Just for the case the server has some internal errors and does not response.

Anyway, works fine. thanks for shareing.

Posted: Mon Jan 16, 2006 7:48 pm
by Droopy
Thanks Tranquil :D , TimeOut (default 120ms ) added as optional parameters .

Posted: Sat Mar 18, 2006 1:08 pm
by chris319
Updated for version 4.

The program will now update the time repeatedly at periodic intervals set in the Delay() statement (next to last line). The message requester display would have to be removed for non-interactive operation.

The program now checks for a valid result from the call to InitNetwork().

Code: Select all

;/ Get Time from NTP Server / Set Local Time / Get Time Zone information
; Droopy 15/01/06 + Fweil for TimeZone functions
; PureBasic 3.94
; Updated by chris319 for PureBasic version 4

ProcedureDLL.s GetTimeZoneName() ; Return the name of the Time Zone
  ;/ Author : Fweil
 
  GetTimeZoneInformation_(TimeZoneInfo.TIME_ZONE_INFORMATION)
  While TimeZoneInfo\StandardName[i] <>0 And i <= 32
    sStandardName.s + Chr(TimeZoneInfo\StandardName[i])
    i + 1
  Wend
  ProcedureReturn sStandardName
EndProcedure

ProcedureDLL GetTimeZone() ; Hour to add to the UTC hour
  ;/ Author : Fweil
  GetTimeZoneInformation_(TimeZoneInfo.TIME_ZONE_INFORMATION)
  Retour=-TimeZoneInfo\bias/60
  ProcedureReturn Retour
EndProcedure

ProcedureDLL SetDate(Date) ; Set the System Date : Return 1 if success
  Heure.SYSTEMTIME
  Heure.SYSTEMTIME\wYear=Year(Date)
  Heure.SYSTEMTIME\wMonth=Month(Date)
  Heure.SYSTEMTIME\wDay=Day(Date)
  Heure.SYSTEMTIME\wDayOfWeek=DayOfWeek(Date)
  Heure.SYSTEMTIME\wHour=Hour(Date)
  Heure.SYSTEMTIME\wMinute=Minute(Date)
  Heure.SYSTEMTIME\wSecond=Second(Date)
   
  If SetSystemTime_(Heure)
    ProcedureReturn 1
  Else
    ProcedureReturn 0
  EndIf
EndProcedure

ProcedureDLL GetNTPTime(NTPServer.s, TimeOut) ; Ask a NTP Server and return the Date as PureBasic format / 0 if it could not be joined
  ; Server = time.ien.it / time.nist.gov / ntp1.fau.de
 
  
  CnxionId = OpenNetworkConnection(NTPServer,37)
 
  If CnxionId
   
    ;/ Wait until the Server Send Datas
    While NetworkClientEvent(CnxionId)=0
      Delay(1)
      T + 1
      If T > TimeOut
        ProcedureReturn 0
      EndIf
    Wend
   
    ;/ Wait until the Server Send Datas
    While NetworkClientEvent(CnxionId)=0
      Delay(1)
    Wend
   
    ;/ Get four Bytes
    Buffer.s=Space(4)
    ReceiveNetworkData(CnxionId, @Buffer, 4)

    CloseNetworkConnection(CnxionId)
 
    ;/ Calcule the Date as PureBasic Format ( UTC )
    NTPTime=Asc(Left(Buffer,1))*16777216 + Asc(Mid(Buffer,2,1))*65536 + Asc(Mid(Buffer,3,1))*256 + Asc(Right(Buffer,1)) - 2840140800
    NTPTime=AddDate(NTPTime,#PB_Date_Year,20) ; Add 20 years
   
    ProcedureReturn NTPTime

  Else
    ProcedureReturn 0
  EndIf

EndProcedure

ProcedureDLL GetNTPTime2(NTPServer.s) ; Default TimeOut = 120ms
  ProcedureReturn GetNTPTime(NTPServer.s,120)
EndProcedure


net_init = InitNetwork()
If net_init = 0
  MessageRequester("Error", "Unable to initialize network.")
  End
EndIf

fetch_time:
;/ Test

NTPTime = GetNTPTime2("time.ien.it")

If NTPTime
  ;/ Set the Computer Time as NTP Time
  SetDate(NTPTime)
 
  ;/ Show information about Hour
  Temp.s = "UTC Time : " + FormatDate(" %dd/%mm/%yy, %hh:%ii:%ss",NTPTime) + #CR$
  Temp + "Zone : "+GetTimeZoneName() + #CR$
  Temp + "Shift : "+Str(GetTimeZone())+" hour(s)" + #CR$

  ;US FORMAT
  Temp+"Local Time as US format : " + FormatDate(" %mm/%dd/%yy, %hh:%ii:%ss", NTPTime + GetTimeZone() * 3600) + #CR$
  
  ;FRENCH FORMAT
  Temp+"Local Time as French format : " + FormatDate(" %dd/%mm/%yy, %hh:%ii:%ss", NTPTime + GetTimeZone() * 3600) + #CR$

  MessageRequester("UTC et NTP", Temp)

EndIf

Delay(60000)

Goto fetch_time

Posted: Sat Mar 18, 2006 1:31 pm
by Droopy
Cool :D

Posted: Sat Mar 18, 2006 2:49 pm
by chris319
Droopy wrote:Cool :D
Note: The code was edited after it was originally posted. If you have the version that loops then you have the latest one.

Posted: Sun Mar 19, 2006 2:51 am
by chris319
Here is a snazzied-up version of this program. It fetches the time every hour, but I don't know how to get it to shut down properly! Perhaps this is a job for a multi-threading expert?

Code: Select all

;/ Get Time from NTP Server / Set Local Time / Get Time Zone information
; Droopy 15/01/06 + Fweil for TimeZone functions
; PureBasic 3.94
; Updated by chris319 for PureBasic version 4


;CHOOSE A TIME SERVER: time.ien.it / time.nist.gov / ntp1.fau.de
Global time_server.s = "time.ien.it"


ProcedureDLL.s GetTimeZoneName() ; Return the name of the Time Zone
  ;/ Author : Fweil
 
  GetTimeZoneInformation_(TimeZoneInfo.TIME_ZONE_INFORMATION)
  While TimeZoneInfo\StandardName[i] <>0 And i <= 32
    sStandardName.s + Chr(TimeZoneInfo\StandardName[i])
    i + 1
  Wend
  ProcedureReturn sStandardName
EndProcedure

ProcedureDLL GetTimeZone() ; Hour to add to the UTC hour
  ;/ Author : Fweil
  GetTimeZoneInformation_(TimeZoneInfo.TIME_ZONE_INFORMATION)
  Retour=-TimeZoneInfo\bias/60
  ProcedureReturn Retour
EndProcedure

ProcedureDLL SetDate(Date) ; Set the System Date : Return 1 if success
  Heure.SYSTEMTIME
  Heure.SYSTEMTIME\wYear=Year(Date)
  Heure.SYSTEMTIME\wMonth=Month(Date)
  Heure.SYSTEMTIME\wDay=Day(Date)
  Heure.SYSTEMTIME\wDayOfWeek=DayOfWeek(Date)
  Heure.SYSTEMTIME\wHour=Hour(Date)
  Heure.SYSTEMTIME\wMinute=Minute(Date)
  Heure.SYSTEMTIME\wSecond=Second(Date)
   
  If SetSystemTime_(Heure)
    ProcedureReturn 1
  Else
    ProcedureReturn 0
  EndIf
EndProcedure

ProcedureDLL GetNTPTime(NTPServer.s, TimeOut) ; Ask a NTP Server and return the Date as PureBasic format / 0 if it could not be joined
  CnxionId = OpenNetworkConnection(NTPServer,37)
 
  If CnxionId
   
    ;/ Wait until the Server Sends Data
    While NetworkClientEvent(CnxionId) = 0
      Delay(1)
      T + 1
      If T > TimeOut
        ProcedureReturn 0
      EndIf
    Wend
   
    ;/ Get four Bytes
    Buffer.s{4}
    ReceiveNetworkData(CnxionId, @Buffer, 4)

    CloseNetworkConnection(CnxionId)
 
    ;/ Calcule the Date as PureBasic Format ( UTC )
    NTPTime = Asc(Left(Buffer,1))*16777216 + Asc(Mid(Buffer,2,1))*65536 + Asc(Mid(Buffer,3,1))*256 + Asc(Right(Buffer,1)) - 2840140800

    NTPTime + 1 ;OPTIONAL CORRECTION SECOND TO COMPENSATE FOR NETWORK LAG

    NTPTime = AddDate(NTPTime, #PB_Date_Year, 20) ; Add 20 years
   
    ProcedureReturn NTPTime

  Else
    ProcedureReturn 0
  EndIf

EndProcedure

ProcedureDLL GetNTPTime2(NTPServer.s) ; Default TimeOut = 120ms
  ProcedureReturn GetNTPTime(NTPServer.s,120)
EndProcedure


If OpenWindow(0, 50, 100, 450, 30, "Network Time", #PB_Window_SystemMenu) And CreateGadgetList(WindowID(0)) 
    ;win_open = 1
Else
    Debug("Unable to open window.")
    End
EndIf

TextGadget(0, 5, 5, 440, 18, "", #PB_Text_Center|#PB_Text_Border)

net_init = InitNetwork()
If net_init = 0
  MessageRequester("Error", "Unable to initialize network.")
  End
EndIf

get_time:

NTPTime = GetNTPTime2(time_server)

If NTPTime
  ;/ Set the Computer Time as NTP Time
  SetDate(NTPTime)
 
  ;/ Show information about Hour
  Temp.s = "UTC Time: " + FormatDate(" %dd/%mm/%yy, %hh:%ii:%ss",NTPTime)

  ;Temp + "Zone : " + GetTimeZoneName() + #CR$
  Temp + "   Time zone: " + Str(GetTimeZone()) + " hour(s)"

  ;US FORMAT
  Temp + "   Local Time: " + FormatDate(" %mm/%dd/%yy, %hh:%ii:%ss", NTPTime + GetTimeZone() * 3600)
  
  ;FRENCH FORMAT
  ;Temp + "  Local Time: " + FormatDate(" %dd/%mm/%yy, %hh:%ii:%ss", NTPTime + GetTimeZone() * 3600) + #CR$

  SetGadgetText(0, Temp)

EndIf

While WindowEvent() : Wend

Delay(3600000) ;FETCH TIME EVERY HOUR

Goto get_time

;I DON'T KNOW HOW TO GET THIS PROGRAM TO SHUT DOWN PROPERLY!

Posted: Mon May 01, 2006 11:29 am
by Edmund
Hi,
i have some trouble since this morning with the NTP Prog. Since around 03:00 i'm getting allway's the same time out of the prog.. Looks like thre is only one Byte instead of four, any idea.


Regards
Edmund

Posted: Mon May 01, 2006 3:10 pm
by chris319
Try a different time server?

Posted: Mon May 01, 2006 3:45 pm
by Edmund
I tried with 3 different servers, same result

03:36:40

:(

Meanwhile i found an workaround to fix my problem. i'll get the time from our Server.

btw: i used the NTP to get the stations in line for

http://www.blitzortung.org

Posted: Wed Jul 09, 2008 8:29 am
by MyTrial
Hello Droopy
sorry for my info but I do not understand the time calculating. Why do you substract 2840140800 (from where is this term?) and add 20 years!? NTP uses seconds since 1900, so you can calculate readable like the following.

Code: Select all

    ; --- calcule the date as PureBasic format (UTC)
    NTPTime = Asc(Left(Buffer,1)) * 16777216 
    NTPTime + Asc(Mid(Buffer,2,1)) * 65536 
    NTPTime + Asc(Mid(Buffer,3,1)) * 256
    NTPTime + Asc(Right(Buffer,1))
    ; --- seconds between 1900-01-01 and 1970-01-01 = 2208988800
    NTPTime - (70 * 365 + 17) * 86400
Sigi

Posted: Wed Jul 09, 2008 10:40 am
by MyTrial
Info for all reading this thread.

The sample in this thread (sorry Droopy) does not use ntp! It uses the older time protocol on port 37 in tcp which was build for tcp and udp (RFC 868). The ntp protocol is using port 123 only with udp (RFC 958).

So the thread name "NTP ..." is a hard irritation and you can not use worldwide ntp servers.

I get the udp not running with purebasic because there is no way to set or get the local port with an udp connection - I found nothing. Otherwise I would put a little sample to this thread.