Hora del servidor
Estas rutinas las envio Luis M. Guayán.
...con esta función puedes tomar ó sincronizar la fecha-hora de un
servidor:
*--------------------------------------------------------------
* FUNCTION NetDateTime(tcSrv, tlSet)
*--------------------------------------------------------------
* Retorna la fecha-hora de la PC remota "tcSrv"
* Si "tlSet" es .T. cambia la hora de la PC
* por la fecha-hora de la PC remota "tcSrv"
* PARAMETROS:
* tcSrv: Nombre de la PC remota
* tlSet: .T. - Si cambia la hora de la PC
* RETORNO:
* DateTime: La fecha-hora de la PC remota
* Numérico: 0 - Si se cambió la fecha-hora correctamente
* -1 - No se pudo cambiar la fecha-hora
* -2 - No se encontró la PC remota
* USO: ? NetDateTime("\\MiServidor", .F.)
* AUTOR: LMG
*--------------------------------------------------------------
FUNCTION NetDateTime(tcSrv, tlSet)
LOCAL lRet, lcStrDW, lnPtr, lcToD, lpTZI, ln, lnZT, ;
lnAno, lnMes, lnDDS, lnDia, lnHor, lnMin, lnSeg
DECLARE INTEGER NetRemoteTOD IN NETAPI32 ;
STRING @lcSvr, ;
INTEGER @lnPtr
DECLARE RtlMoveMemory IN WIN32API ;
STRING @lcToD, ;
INTEGER lnPtr, ;
INTEGER ln
DECLARE SetSystemTime IN WIN32API ;
STRING lcStrDW
DECLARE GetTimeZoneInformation IN KERNEL32 ;
STRING @lpTZI
tcSrv = STRCONV(STRCONV(tcSrv,1),5) + CHR(0)
lnPtr = 0
ln = NetRemoteTOD(@tcSrv, @lnPtr)
IF ln = 0
lcToD = REPLICATE(CHR(0), 48)
ln = RtlMoveMemory(@lcToD, lnPtr, 48)
lnAno = DW2N(SUBSTR(lcToD, 41, 4))
lnMes = DW2N(SUBSTR(lcToD, 37, 4))
lnDDS = DW2N(SUBSTR(lcToD, 45, 4))
lnDia = DW2N(SUBSTR(lcToD, 33, 4))
lnHor = DW2N(SUBSTR(lcToD, 09, 4))
lnMin = DW2N(SUBSTR(lcToD, 13, 4))
lnSeg = DW2N(SUBSTR(lcToD, 17, 4))
IF tlSet
lcStrDW = N2DW(lnAno) + N2DW(lnMes) + ;
N2DW(lnDDS) + N2DW(lnDia) + ;
N2DW(lnHor) + N2DW(lnMin) + ;
N2DW(lnSeg) + N2DW(0)
lRet = IIF(SetSystemTime(lcStrDW), 0, -1)
ELSE
lpTZI = SPACE(255)
ln = GetTimeZoneInformation(@lpTZI)
lnZT = DW2N(SUBSTR(lpTZI, 1, 2))
IF lnZT > 720
lnZT = (2^16) - lnZT
ELSE
lnZT = (-1) * lnZT
ENDIF
lRet = DATETIME(lnAno, lnMes, lnDia, ;
lnHor, lnMin, lnSeg) + lnZT * 60
ENDIF
ELSE
lRet = -2
ENDIF
RETURN lRet
ENDFUNC
* - - - - - - - - - - - - - - - - - - - - - - - -
* FUNCTION DW2N(tcDW)
* Usada por NetDateTime()
* - - - - - - - - - - - - - - - - - - - - - - - -
FUNCTION DW2N(tcDW)
RETURN ASC(SUBSTR(tcDW, 4, 1))*(256^3) + ;
ASC(SUBSTR(tcDW, 3, 1))*(256^2) + ;
ASC(SUBSTR(tcDW, 2, 1))*(256) + ;
ASC(SUBSTR(tcDW, 1, 1))
ENDFUNC
* - - - - - - - - - - - - - - - - - - - - - - - -
* FUNCTION N2DW(tnN)
* Usada por NetDateTime()
* - - - - - - - - - - - - - - - - - - - - - - - -
FUNCTION N2DW(tnN)
RETURN CHR(MOD(tnN, 256)) + CHR(INT(tnN/256))
ENDFUNC
*--------------------------------------------------------------
Pero... (siempre hay un pero), leyendo la Base de Conocimientos de
Microsoft, en el artículo Q249716
http://support.microsoft.com/support/kb/articles/Q249/7/16.ASP dice que la
función API NetRemoteTOD solo funciona con Windows NT y Windows 2000. En
dicho artículo hay un ejemplo para VFP6.
--
Luis María Guayán
Tucumán - Argentina
