Plateforme Level Extreme
Abonnement
Profil corporatif
Produits & Services
Support
Légal
English
About DTS
Message
De
11/08/2006 06:46:05
Cetin Basoz
Engineerica Inc.
Izmir, Turquie
 
Information générale
Forum:
Visual FoxPro
Catégorie:
Autre
Titre:
Divers
Thread ID:
01144754
Message ID:
01144765
Vues:
10
>I can find Time Zone for any country. But, i wanna find to exactly date for future. For example; which day is Daylight Saving Time for summer on 2007 or 2008 ? I know march-april for summer time, and september-october for winter time. But how can i calculate exactly date in the future for DTS ?
>
>Thnx all.

You can combine SetSystemTime and GetTimeZoneInfo. Below class is for specific purpose but anyway there is GetTimeZoneInformation usage in it:
Define Class CheckDayLight As Custom
	lUsingDayLight = .F.
	tAddOneHour = {}
	tSubtractOneHour = {}
	cAddOneHour = Ttoc({},1) && Datetime in fixed 14 char format
	cSubtractOneHour = Ttoc({},1)

	Procedure Init
		* buffer to receive TIME_ZONE_INFORMATION
		TZInfo = Space(172)
		Declare Integer GetTimeZoneInformation In kernel32 String @TZInfo
		liRetCode = GetTimeZoneInformation(@TZInfo)
		* Daylight savings time bias might be a negative value
		* stored in 2s complement
		* so subtract 2^32 if high bit is set
		With This
			liDaylightBias = .str2num(Substr(TZInfo, 169, 4))
			liDaylightBias = Iif(Bittest(liDaylightBias,31), liDaylightBias - 2^32, liDaylightBias)
			.lUsingDayLight = ( liDaylightBias # 0 )
			If .lUsingDayLight
				.tSubtractOneHour = This.ParseDate(Substr(TZInfo, 69, 16),liDaylightBias) && Parse standart time date
				.tAddOneHour      = This.ParseDate(Substr(TZInfo, 153, 16),-liDaylightBias) && Parse Daylight time date
				.cSubtractOneHour = Ttoc(This.tSubtractOneHour,1)
				.cAddOneHour      = Ttoc(This.tAddOneHour,1)
			Endif
		Endwith
	Endproc

	Procedure ParseDate
		Lparameters tcSystemTime, tnAddBias
		Local lnMonth, lnWeek, lnHour, lnMinute, lnSecond, ldDate
		With This
			lnMonth  = .str2num(Substr(tcSystemTime,  3, 2))
			lnWeek   = .str2num(Substr(tcSystemTime,  7, 2))
			lnHour   = .str2num(Substr(tcSystemTime,  9, 2))
			lnMinute = .str2num(Substr(tcSystemTime, 11, 2))
			lnSecond = .str2num(Substr(tcSystemTime, 13, 2))
			ldDate   = .GetNthDay(lnMonth, lnWeek, Year(Date()), 1) && Get lnWeek Sunday of nearest future date
			Return Dtot(ldDate)+lnHour*60*60+lnMinute*60+lnSecond+tnAddBias*60
		Endwith
	Endproc

	Procedure GetNthDay
		Lparameters tnMonth, tnWeek, tnYear, tnDOW
		Local ldFDOM,ldFirstDay,ldDate
		ldFDOM = Date(tnYear,tnMonth, 1)
		ldFirstDay = ldFDOM-Dow(ldFDOM,tnDOW)+8
		ldDate = ldFirstDay+(tnWeek-1)*7
		Return Iif(ldDate < Date(), ;
			this.GetNthDay(tnMonth, tnWeek, tnYear+1,tnDOW),;
			IIF(Month(ldDate)=tnMonth,ldDate,ldDate-7))
	Endproc

	Procedure str2num
		Lparameters m.tcStr
		Local ix, m.lnRetVal
		m.lnRetVal = 0
		For ix = 1 To Len(m.tcStr)
			m.lnRetVal = m.lnRetVal + Asc(Substr(m.tcStr,ix)) * (256^(ix-1))
		Next
		Return m.lnRetVal
	Endproc
Enddefine
To change the system time tempoarrily you could use:
ltNow = Datetime()
? 'Now',Datetime()
SetSystemDate({^2002/1/3})
? 'Set to',Datetime()
SetSystemDate(m.ltNow)
? 'Set back to',Datetime()


Function SetSystemDate
  Lparameters tdDate
  Declare Integer SetLocalTime In win32api String @ lpTime
  Declare Integer GetLocalTime In win32api String @ lpTime
  Local lpCurrent, lcNewTime
  lpCurrent = Space(40)
  GetLocalTime(@lpCurrent) && save current

  lcNewTime = Num2Word(Year(m.tdDate))+;
    Num2Word(Month(m.tdDate))+;
    Num2Word(Dow(m.tdDate))+;
    Num2Word(Day(m.tdDate))+;
    Substr(m.lpCurrent,9)

  SetLocalTime(@lcNewTime)
  SetLocalTime(@lcNewTime)
EndFunc

Function Num2Word
  Lparameters tnDecimal
  Return Chr(m.tnDecimal%256)+Chr(Int(m.tnDecimal/256))
EndFunc
PS: SetLocalTime() is intentionally called twice. That takes care of DST.
Cetin
Çetin Basöz

The way to Go
Flutter - For mobile, web and desktop.
World's most advanced open source relational database.
.Net for foxheads - Blog (main)
FoxSharp - Blog (mirror)
Welcome to FoxyClasses

LinqPad - C#,VB,F#,SQL,eSQL ... scratchpad
Précédent
Suivant
Répondre
Fil
Voir

Click here to load this message in the networking platform