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

, 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

Posted: Sat Mar 18, 2006 2:49 pm
by chris319
Droopy wrote:Cool

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.