Function FindTime ***************************************************************************************** **** Internet syncronization time base on article **** founded at http://www.programmersheaven.com/articles/userarticles/atomicsync.htm ***************************************************************************************** #define INTERNET_OPEN_TYPE_PRECONFIG 0x00 && use registry #define INTERNET_FLAG_RELOAD 0x80000000 && retrieve the original item #define BEGIN_UTC_TIME 0x69 #define LEN_UTC_TIME 0x11 #define TIME_ZONE_ID_UNKNOWN 0x00 #define TIME_ZONE_ID_STANDARD 0x01 #define TIME_ZONE_ID_DAYLIGHT 0x02 #DEFINE ID_INVALID -1 #DEFINE ID_UNKNOWN 0 #DEFINE ID_STANDARD 1 #DEFINE ID_DAYLIGHT 2 **** DLL Declarations DECLARE INTEGER InternetOpen IN wininet STRING lpszAgent, INTEGER dwAccessType, STRING lpszProxy, STRING lpszProxyBypass, INTEGER dwFlags DECLARE INTEGER InternetCloseHandle IN wininet INTEGER hInternet DECLARE INTEGER InternetOpenUrl IN wininet INTEGER hInternet, STRING lpszUrl, STRING lpszHeaders, INTEGER dwHeadersLength, INTEGER dwFlags, INTEGER dwContext DECLARE INTEGER InternetReadFile IN wininet INTEGER hFile, STRING @lpBuffer, INTEGER dwNumberOfBytesToRead, INTEGER @lpdwNumberOfBytesRead DECLARE LONG SetLocalTime IN win32api STRING @ DECLARE INTEGER GetLocalTime IN win32api STRING @ LOCAL m.hInternet, m.Context, m.hHttp, m.buff, m.NumberOfBytesRead, m.bRet LOCAL m.utcTimeBuff, m.mntbuff, m.nYear, m.nMonth, m.nDay, m.nHour, m.nMin, m.nSec m.hInternet = InternetOpen("BSAtomicEdu", INTERNET_OPEN_TYPE_PRECONFIG , NULL, NULL, 0) if m.hInternet == 0 MessageBox("Internet open error! Test your system and try again.") return ENDIF m.Context = 777 m.hHttp = InternetOpenUrl(m.hInternet, [http://tycho.usno.navy.mil/cgi-bin/timer.pl], NULL, -1, INTERNET_FLAG_RELOAD, Context) IF hHttp == 0 MessageBox("URL open error!") InternetCloseHandle(m.hInternet) return ENDIF m.buff = SPACE(1024) m.NumberOfBytesRead = 0 m.bRet = InternetReadFile(m.hHttp, @m.buff, 1024, @m.NumberOfBytesRead) InternetCloseHandle(m.hHttp) InternetCloseHandle(m.hInternet) IF m.bRet == 0 MessageBox( "URL reading error! Test internet connection and try again.") RETURN ENDIF MessageBox(m.buff) m.utcTimeBuff = SUBSTR(buff,BEGIN_UTC_TIME,LEN_UTC_TIME) m.mntbuff ="JANFEBMARAPRMAYJUNJULAUGSEPOCTNOVDEC" nYear = YEAR(DATE()) && :o)))) nMonth = INT(AT(UPPER(left(utcTimeBuff,3)),mntbuff)/3)+1 nDay = VAL(SUBSTR(utcTimeBuff,6,2)) nHour = VAL(SUBSTR(utcTimeBuff,10,2)) nMin = VAL(SUBSTR(utcTimeBuff,13,2)) nSec = VAL(SUBSTR(utcTimeBuff,16,2)) VFPSetDateTime(m.nYear, m.nMonth, m.nDay, m.nHour, m.nMin, m.nSec) CLEAR DLLS FUNCTION VFPSetDateTime(m.pYear, m.pMonth, m.pDay, m.pHour, m.pMinute, m.pSecond) ************************************************************************ **** Taken from www.levelextreme.com FAQ #<A HREF="/wconnect/wc.dll?LevelExtreme~2,84,14,7864" TARGET="_blank">7864</A> **** Created by Terence Tam - Hong Kong ************************************************************************ LOCAL oUniverslTime AS Custom, oLocalTime AS Custom, oNewTime AS Custom LOCAL m.lpcount, m.cBuff, m.sYear, m.sMonth, m.sWeekDay, m.sDay, m.sHour, m.sMinute, m.sSecond, m.sMinSecond LOCAL m.nYear, m.nMonth, m.nDay, m.nWeekDay, m.nHour, m.nMinute, m.nSecond, m.nMinSecond m.lpcount = PCOUNT() IF m.lpcount < 3 MESSAGEBOX("Usage: VFPSetDateTime(Year, Month, Day [[[, Hour ], Minute ], Second ])", ; 32, "Wrong Usage, Note: Only for 24 Hours Setting") RETURN ENDIF m.cBuff = SPACE(16) && Each Information (WORD) worth 2 bytes GetLocalTime(@cBuff) m.sYear = ALLTRIM(STR( ASC(SUBSTR(cBuff,1,1))+ASC(SUBSTR(cBuff,2,1))*256)) m.sMonth = ALLTRIM(STR( ASC(SUBSTR(cBuff,3,1))+ASC(SUBSTR(cBuff,4,1))*256)) m.sWeekDay = ALLTRIM(STR( ASC(SUBSTR(cBuff,5,1))+ASC(SUBSTR(cBuff,6,1))*256)) m.sDay = ALLTRIM(STR( ASC(SUBSTR(cBuff,7,1))+ASC(SUBSTR(cBuff,8,1))*256)) m.sHour = ALLTRIM(STR( ASC(SUBSTR(cBuff,9,1))+ASC(SUBSTR(cBuff,10,1))*256)) m.sMinute = ALLTRIM(STR( ASC(SUBSTR(cBuff,11,1))+ASC(SUBSTR(cBuff,12,1))*256)) m.sSecond = ALLTRIM(STR( ASC(SUBSTR(cBuff,13,1))+ASC(SUBSTR(cBuff,14,1))*256)) m.sMinSecond = ALLTRIM(STR( ASC(SUBSTR(cBuff,15,1))+ASC(SUBSTR(cBuff,16,1))*256)) m.nYear = pYear m.nMonth = pMonth m.nDay = pDay m.nWeekDay = DOW(CTOD(ALLTRIM(STR(nMonth)) + [/] + ALLTRIM(STR(nDay)) + [/] + ALLTRIM(STR(nYear)))) && MDY DO CASE CASE m.lpcount = 3 m.nHour = HOUR(DATETIME()) m.nMinute = MINUTE(DATETIME()) m.nSecond = SEC(DATETIME()) CASE m.lpcount = 4 m.nHour = pHour m.nMinute = MINUTE(DATETIME()) m.nSecond = SEC(DATETIME()) CASE m.lpcount = 5 m.nHour = pHour m.nMinute = pMinute m.nSecond = SEC(DATETIME()) CASE m.lpcount = 6 m.nHour = pHour m.nMinute = pMinute m.nSecond = pSecond ENDCASE m.nMinSecond = VAL(sMinSecond) ******************************* *** Changes made by me :o) oUniverslTime = CREATEOBJECT("Custom") oUniverslTime.AddProperty("Year" ,pYear) oUniverslTime.AddProperty("Month" ,pMonth) oUniverslTime.AddProperty("Day" ,pDay) oUniverslTime.AddProperty("Hour" , pHour) oUniverslTime.AddProperty("Minute" , pMinute) oUniverslTime.AddProperty("Seconds", pSecond) oLocalTime = CREATEOBJECT("Custom") oLocalTime.AddProperty("Year" , nYear) oLocalTime.AddProperty("Month" , nMonth) oLocalTime.AddProperty("Day" , nDay) oLocalTime.AddProperty("Hour" , nHour) oLocalTime.AddProperty("Minute" , nMinute ) oLocalTime.AddProperty("Seconds", nSecond ) oNewTime = LocalZoneTime(oUniverslTime, oLocalTime) nBuff = CHR(oNewTime.Year%256) + CHR(INT(oNewTime.Year/256)) +; CHR(oNewTime.Month%256) + CHR(INT(oNewTime.Month/256)) +; CHR(nWeekday%256) + CHR(INT(nWeekday/256)) +; CHR(oNewTime.Day%256) + CHR(INT(oNewTime.Day/256)) +; CHR(oNewTime.Hour%256) + CHR(INT(oNewTime.Hour/256)) +; CHR(oNewTime.Minute%256) + CHR(INT(oNewTime.Minute/256))+; CHR(oNewTime.Seconds%256) + CHR(INT(oNewTime.Seconds/256))+; CHR(nMinSecond%256) + CHR(INT(nMinSecond/256)) SetLocalTime(@nBuff) ENDPROC FUNCTION LocalZoneTime(oUniverslTime AS Collection , oLocalTime AS Collection) ************ ************ ************ ************ ************ ************ ** Taken from MSDN HOWTO: Obtain Time Zone Information in Visual FoxPro ** Article KB194576 ************ ************ ************ ************ ************ ************ * the definition for TIME_ZONE_INFORMATION is: * *typedef struct _TIME_ZONE_INFORMATION { // tzi * LONG Bias; * WCHAR StandardName[ 32 ]; * SYSTEMTIME StandardDate; * LONG StandardBias; * WCHAR DaylightName[ 32 ]; * SYSTEMTIME DaylightDate; * LONG DaylightBias; *} TIME_ZONE_INFORMATION; * buffer to receive TIME_ZONE_INFORMATION TZInfo = REPLICATE(CHR(0),172) DECLARE INTEGER GetTimeZoneInformation IN kernel32 STRING @TZInfo liRetCode = GetTimeZoneInformation(@TZInfo) DO CASE CASE liRetCode = ID_UNKNOWN =MESSAGEBOX ("TIME_ZONE_ID_UNKNOWN") RETURN oUniverslTime CASE liRetCode = ID_STANDARD =MESSAGEBOX ("TIME_ZONE_ID_STANDARD") CASE liRetCode = ID_DAYLIGHT =MESSAGEBOX ("TIME_ZONE_ID_DAYLIGHT") ENDCASE * now, parse the returned structure * Daylight savings time bias is a negative value * stored in 2s complement, so subtract 2^32 to obtain a decimal value liBias = StrToLong(SUBSTR(TZInfo, 1, 4)) - 2 ^ 32 * lcStandardName is a Unicode string - strip out chr(0)s for * US/English lcStandardName = SUBSTR(TZInfo, 5, 64) lcStandardName = STRTRAN(lcStandardName, CHR(0), "") * lcStandardDate is a SYSTEMTIME structure, defined as follows: * *typedef struct _SYSTEMTIME { // st * WORD wYear; * WORD wMonth; * WORD wDayOfWeek; * WORD wDay; * WORD wHour; * WORD wMinute; * WORD wSecond; * WORD wMilliseconds; *} SYSTEMTIME; * this SYSTEMTIME struct must be parsed again lcStandardDate = SUBSTR(TZInfo, 69, 16) lcSDYear = Str2Word(SUBSTR(lcStandardDate, 1, 2)) lcSDMonth = Str2Word(SUBSTR(lcStandardDate, 3, 2)) lcSDDayofWeek = Str2Word(SUBSTR(lcStandardDate, 5, 2)) lcSDDay = Str2Word(SUBSTR(lcStandardDate, 7, 2)) lcSDHour = Str2Word(SUBSTR(lcStandardDate, 9, 2)) lcSDMinute = Str2Word(SUBSTR(lcStandardDate, 11, 2)) lcSDSecond = Str2Word(SUBSTR(lcStandardDate, 13, 2)) lcSDMSec = Str2Word(SUBSTR(lcStandardDate, 15, 2)) liStandardBias = StrToLong(SUBSTR(TZInfo, 85, 4)) * lcDaylightname is also a Unicode string lcDaylightName = SUBSTR(TZInfo, 89, 64) lcDaylightName = STRTRAN(lcDaylightName, CHR(0), "") * this SYSTEMTIME struct must be parsed again, same as above lcDaylightDate = SUBSTR(TZInfo, 153, 16) lcDDYear = Str2Word(SUBSTR(lcDaylightDate, 1, 2)) lcDDMonth = Str2Word(SUBSTR(lcDaylightDate, 3, 2)) lcDDDayofWeek = Str2Word(SUBSTR(lcDaylightDate, 5, 2)) lcDDDay = Str2Word(SUBSTR(lcDaylightDate, 7, 2)) lcDDHour = Str2Word(SUBSTR(lcDaylightDate, 9, 2)) lcDDMinute = Str2Word(SUBSTR(lcDaylightDate, 11, 2)) lcDDSecond = Str2Word(SUBSTR(lcDaylightDate, 13, 2)) lcDDMSec = Str2Word(SUBSTR(lcDaylightDate, 15, 2)) * Daylight savings time bias is a negative value * stored in 2s complement, so subtract 2^32 to obtain a decimal value liDaylightBias = StrToLong(SUBSTR(TZInfo, 169, 4)) - 2 ^ 32 nZoneCorrection = liBias DO CASE CASE liRetCode == TIME_ZONE_ID_STANDARD nZoneCorrection = nZoneCorrection + liStandardBias CASE liRetCode== TIME_ZONE_ID_DAYLIGHT nZoneCorrection = nZoneCorrection + liDaylightBias ENDCASE nZoneCorrection = -nZoneCorrection nTotalMinutes = oUniverslTime.Hour * 60 + oUniverslTime.Minute + nZoneCorrection IF nTotalMinutes < 0 nTotalMinutes = nTotalMinutes + 24*60 ENDIF IF nTotalMinutes>24*60 nTotalMinutes = nTotalMinutes - 24*60 ENDIF oLocalTime.Year = oUniverslTime.Year oLocalTime.Month = oUniverslTime.Month oLocalTime.Day = oUniverslTime.Day oLocalTime.Hour = INT(nTotalMinutes /60) oLocalTime.Minute = nTotalMinutes - oLocalTime.Hour*60 oLocalTime.Seconds = oUniverslTime.Seconds RETURN oLocalTime ********************* FUNCTION StrToLong(m.lcLongstr) ********************* * Passed: 4-byte character string (lcLongstr) in low-high ASCII format * Returns: long integer value * Example: * m.longstr = "1111" * m.longval = strtolong(m.longstr) LOCAL i, lnRetval m.lnRetval = 0 FOR m.i = 0 TO 24 STEP 8 m.lnRetval = m.lnRetval + (ASC(m.lcLongstr) * (2^i)) m.lcLongstr = RIGHT(m.lcLongstr, LEN(m.lcLongstr) - 1) NEXT RETURN lnRetval ********************** FUNCTION Str2Word(m.wordstr) LOCAL m.i, m.retval m.retval = 0 FOR i = 0 TO 8 STEP 8 m.retval = m.retval + (ASC(m.wordstr) * (2^i)) m.wordstr = RIGHT(m.wordstr, LEN(m.wordstr) - 1) NEXT RETURN m.retval