> ********************* >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, lnAscCode, llIsNeg > STORE 0 TO m.lnRetval > llIsNeg = BITTEST(ASC(m.lcLongstr),7) > > FOR m.i = 0 TO 3 > m.lnAscCode = ASC(SUBSTR(m.lcLongstr,i+1,1)) > IF IsNeg && Negative value > ** Reverse bits > m.lnAscCode = BITXOR(m.lnAscCode,0xFF) > ENDIF > m.lnRetval = m.lnRetval + (m.lnAscCode * (2^(i*8))) > NEXT > RETURN IIF(llIsNeg,-(m.lnRetval+1),m.lnRetval) >>
>>***************************************************************************************** >>**** 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 #7864 >> **** 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) >> >> * 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)) >> >> * 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, lnNumber, lnAscCode >> >> STORE 0 TO m.lnNumber, m.lnRetval >> FOR m.i = 0 TO 24 STEP 8 >> m.lnAscCode = ASC(m.lcLongstr) >> >> *** For this portion of the code I am not sure at all >> *** I never be a good in binary algebra ;o) >> *** Strange, but this works >> *** If somebody has better Idea... how to convert an >> *** signed log to unsigned one. >> IF BITTEST(m.lnAscCode,7) && Negative value >> ** Reverse bits >> m.lnAscCode = BITXOR(m.lnAscCode,0xFF) >> *store the first complement >> m.lnNumber = 1 >> ENDIF >> >> m.lnRetval = m.lnRetval + (m.lnAscCode * (2^i)) >> m.lcLongstr = RIGHT(m.lcLongstr, LEN(m.lcLongstr) - 1) >> NEXT >> >>RETURN (lnRetval+m.lnNumber) * IIF(NOT EMPTY(m.lnNumber),-1,1) >> >> ********************** >>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 >>