Alternate Method to Set local Time from Server

LOCAL xx
xx = settime("W:\mydata\", .T.) && just get the server time
IF VARTYPE(xx) <> "L"
   lcMessage = "Workstation Time: "+transform(datetime())+chr(13)+chr(10)+;
               "TimeServer Time: "+transform(xx)
   MESSAGEBOX(lcMessage, 0+64, "Please Note")
ELSE	&& Must be Logical
   IF !XX AND !EMPTY(oData.gcTimeServer)
      lcMessage = "Workstation Time: "+transform(datetime())+chr(13)+chr(10)+;
                  "TimeServer Couldn't be Accessed"
      MESSAGEBOX(lcMessage, 0+64, "Please Note")
   ENDIF
ENDIF

************************
** Similar to set it **
xx = settime("\\exchange\") && set local based the server time

* Program....: SETTIME.PRG
* Author.....: ** Richard G Bean **
* Date.......: May 10, 2001
* Abstract...: Some code from KB Article Q249716
* Changes....:
* Assumes....: If DEFINE cUseNetRemoteTOD is .F., then
*                p_cServer_Name - Is directory on server where a temp file can be written
*              If DEFINE cUseNetRemoteTOD is .T., then
*                p_cServer_Name - Is actual server name
*
*              This could be changed to use a 3rd parameter for more flexibility
*
** Note: Returns .T. if local time changed
**       Returns .F. if any error or time not changed
**       Returns Server DateTime if no error and 2nd parameter is .T.

LPARAMETERS p_cServer_Name, p_lJustGetServerTime
LOCAL l_tWSCurrent, lpTimeSet, l_nRetVal, l_nLastError, l_cBuffer

#DEFINE cUseNetRemoteTOD .F. && change if know server is NT/W2K/2003
#DEFINE cAcceptableDiff  16 && Seconds - close enough - avoid the overhead

IF PCOUNT() < 2 OR VARTYPE(p_lJustGetServerTime) <> "L"
   p_lJustGetServerTime = .F.
ENDIF

IF EMPTY(p_cServer_Name) or VARTYPE(p_cServer_Name) <> "C"
   RETURN .F.
ENDIF

p_cServer_Name = ALLTRIM(p_cServer_Name)

LOCAL serverdatetime, tod_year, tod_month, tod_day, ;
      tod_hours, tod_mins, tod_secs

IF cUseNetRemoteTOD && GOOD but limited way of doing it <s>
   ** Kill leading "\\"
   IF LEFT(p_cServer_Name, 2) = "\\"
      p_cServer_Name = SUBSTR(p_cServer_Name, 3)
   ENDIF
   * NetRemoteTOD's first parameter is a pointer to a
   * Unicode string containing the server name.
   *
   * The second parameter is a pointer to a byte array
   * containing a pointer to a TIME_OF_DAY_INFO structure

   * The '@' preceding the second parameter ('integer @')
   * dereferences this pointer to the byte array. Later in the
   * program, the program uses RTLMoveMemory() to
   * dereference the pointer this byte array contains
   DECLARE INTEGER NetRemoteTOD IN netapi32 STRING @,  INTEGER @

   * Note that the source address ('inbuffer') is declared as an integer,
   * to be consistent with the second parameter in NetRemoteTOD above.
   DECLARE INTEGER RtlMoveMemory IN win32api ;
      STRING @outbuffer, ;
      INTEGER inbuffer, ;
      INTEGER bytes2copy

   * the TIME_OF_DAY_INFO structure
   * contains 11 DWORDs and 1 long, for
   * a total of 48 bytes, so tdbuffout is
   * initialized as:
   tdbuffout=REPLICATE(CHR(0), 48)
   tdbuffin = 0

   * the server name must be converted to Unicode
   * This API function behaves differently depending on
   * whether the target is an Win2000 machine or not -
   *
   * If Win2000, then the servername must be preceded by "\\";
   * otherwise, it must not.

   try_server_name = STRCONV(p_cServer_Name, 5)

   PRIVATE llresult, lcSvError
   lcSvError = ON("ERROR")
   llresult = .F.
   ON ERROR llresult = .T.

   rc = NetRemoteTOD(@try_server_name, @tdbuffin)

   ON ERROR &lcSvError
   IF llresult
      * Probably an Old version of netapi32.dll - no NetRemoteTOD entry point
      RETURN .F.
   ENDIF

   IF rc = 0
      * copy the contents pointed to by the address in tdbuffin to
      * tdbuffout
      =RtlMoveMemory(@tdbuffout, tdbuffin, 48)
   ELSE
      * call failed, so the target is possibly a Win2000 box;
      * Retry the function call, prepending "\\" to the server_name
      try_server_name = STRCONV("\\" + p_cServer_Name, 5)
      rc = NetRemoteTOD(@try_server_name, @tdbuffin)
      IF rc = 0
         * copy the contents pointed to by the address in tdbuffin to
         * tdbuffout
         =RtlMoveMemory(@tdbuffout, tdbuffin, 48)
      ELSE
   **      ? "NetRemoteTOD() call failed. Return code is: ", rc
         RETURN .F.
      ENDIF
   ENDIF

   * Pick out the appropriate parts of the TIME_OF_DAY_INFORMATION
   * buffer. This buffer will contain the UTC (Universal Coordinated
   * Time) of the server, and must be adjusted by TOD_TIMEZONE minutes
   * for the correct local time.

   * str2long() converts the DWORDS and LONGS from their string
   * representation back to numbers.
   tod_month = str2long(SUBSTR(tdbuffout, 37, 4))
   tod_day = str2long(SUBSTR(tdbuffout, 33, 4))
   tod_year = str2long(SUBSTR(tdbuffout, 41, 4))
   tod_hours = str2long(SUBSTR(tdbuffout, 9, 4))
   tod_mins = str2long(SUBSTR(tdbuffout, 13, 4))
   tod_secs = str2long(SUBSTR(tdbuffout, 17, 4))

   * Subtract this bias (times 60, to obtain seconds)
   * from the datetime value to obtain the
   * server's local time
   *
   * Alternately, to convert the server's local time to
   * the workstation's local time, use the Win32 API function
   * SystemTimeToTzSpecificLocalTime, available under
   * Windows NT only.
   tod_timezone = str2long(SUBSTR(tdbuffout, 25, 4)) * 60

   serverdatetime = DATETIME(tod_year, tod_month, tod_day, ;
      tod_hours, tod_mins, tod_secs)

   **? "UTC time of server is: ", serverdatetime
   **? "Server's local time is: ", serverdatetime - tod_timezone
   IF p_lJustGetServerTime
      RETURN (serverdatetime - tod_timezone)
   ENDIF
ELSE && Generic way of doing it

   LOCAL l_cTempFileName, l_nFileHndl, l_nFound
   
   l_cTempFileName = SYS(2015) && Unique Procedure Name
   l_cTempFileName = ADDBS(p_cServer_Name) + l_cTempFileName +".$$$"
   l_nFileHndl = FCREATE(l_cTempFileName)
   IF l_nFileHndl < 0     && Check for error opening file
      RETURN .F.
   ENDIF
   =FCLOSE(l_nFileHndl)     && Close file
   l_nFound = ADIR(l_aInfo, l_cTempFileName)
   IF l_nFound <> 1
      RETURN .F.
   ENDIF
   DELETE FILE (l_cTempFileName)

   tod_month = MONTH(l_aInfo[3])
   tod_day = DAY(l_aInfo[3])
   tod_year = YEAR(l_aInfo[3])
   tod_hours = INT(VAL(SUBSTR(l_aInfo[4], 1, 2)))
   tod_mins = INT(VAL(SUBSTR(l_aInfo[4], 4, 2)))
   tod_secs = INT(VAL(SUBSTR(l_aInfo[4], 7, 2)))

   serverdatetime = DATETIME(tod_year, tod_month, tod_day, ;
      tod_hours, tod_mins, tod_secs)

   IF p_lJustGetServerTime
      RETURN serverdatetime
   ENDIF
ENDIF

**?
**? "Current Local: ", datetime()

l_tWSCurrent = datetime()
IF ABS(serverdatetime - l_tWSCurrent) < cAcceptableDiff && close enough - avoid the overhead
   RETURN .F. && didn't Change
ENDIF

lpTimeSet = "" ;
      + word2str(tod_year);
      + word2str(tod_month);
      + word2str(1);
      + word2str(tod_day);
      + word2str(tod_Hours);
      + word2str(tod_Mins);
      + word2str(tod_Secs);
      + word2str(0)
       
IF cUseNetRemoteTOD
   Declare INTEGER SetSystemTime in kernel32 STRING
   l_nRetVal = SetSystemTime(lpTimeSet)
ELSE && Generic (but EPIC specific) way of doing it
   Declare INTEGER SetLocalTime in kernel32 STRING
   l_nRetVal = SetLocalTime(lpTimeSet)
ENDIF

IF l_nRetVal = 0 && Error
   DECLARE INTEGER GetLastError in Kernel32
   l_nLastError = GetLastError()
   **? l_nLastError
   Declare Integer FormatMessage in kernel32 Long, Long, Long, Long, String, Long, Long
   #DEFINE FORMAT_MESSAGE_FROM_SYSTEM  0x1000
   #DEFINE LANG_NEUTRAL 0x0
   
   l_cBuffer = replicate(chr(0), 201)
   = FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM, 0, l_nLastError, LANG_NEUTRAL, @l_cBuffer, 200, 0)
   l_cBuffer = ALLTRIM(STRTRAN(l_cBuffer, chr(0),""))
   messagebox(l_cBuffer, 0, "Please Note")
   RETURN .F.
ENDIF

* Use SendMessage to tell everybody that we've changed the system time.
DECLARE INTEGER SendMessage IN win32api ;
   INTEGER WindowHandle, ;
   INTEGER MESSAGE, ;
   STRING Param1, ;
   STRING Param2

* SendMessage constants.
#DEFINE HWND_BROADCAST 65535
#DEFINE WM_TIMECHANGE 30

* Send the message that the time has changed.
= SendMessage(HWND_BROADCAST, WM_TIMECHANGE, "", "")

**? "New Local: ", datetime()

RETURN .T.

*************************************************************
FUNCTION str2long
*************************************************************
* passed:  4-byte character string (m.longstr) in low-high ASCII format
* returns:  long integer value
* example:
*   m.longstr = "1111"
*   m.longval = str2long(m.longstr)

PARAMETERS m.longstr

PRIVATE i, m.retval

m.retval = 0
FOR i = 0 TO 24 STEP 8
   m.retval = m.retval + (ASC(m.longstr) * (2^i))
   m.longstr = RIGHT(m.longstr, LEN(m.longstr) - 1)
NEXT
RETURN INT(m.retval)

*************************************************************
FUNCTION word2str
*************************************************************
* passed:  integer value
* returns:  2-byte character string (m.longstr) in low-high ASCII format
* example:
*   m.wordval = 111
*   m.wordstr = word2str(m.wordval)

PARAMETERS m.wordval

PRIVATE i, m.retval

m.retval = ""
FOR i = 0 to 1
   m.retval = m.retval + CHR(m.wordval % 256)
   m.wordval = int(wordval / 256)
NEXT
RETURN m.retval

*!* EOP: SETTIME.PRG