;/ 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
Last edited by Droopy on Mon Jan 16, 2006 7:46 pm, edited 1 time in total.
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().
;/ 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
Last edited by chris319 on Sat Mar 18, 2006 2:46 pm, edited 1 time in total.
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?
;/ 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!
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.
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.
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.