Sandra
09 de Noviembre del 2005

Necesito saber como obtener la fecha y hora del servidor desde un formulario

tux20
09 de Noviembre del 2005

existen dos formas una es con net time y eso lo almacenas en un text y luego lo lees o la otra usando estas instrucciones.

ldHora= ServerTime("\server")
WriteLocalTime(ldHora)
CLEAR EVENTS
READ events
*========================
FUNCTION ReadLocalTime()
*========================
* Lee mediante API el GetLocalTime
* Retorno: DATETIME o .NULL. si existe error
* Autor: LMG - 1998.09.14
*========================
LOCAL lcAuxi, ltDateTime, ;
lcSetDate, lcSetHours, lcSetCentury, ;
lcSetSysformats, lcSetMark

lcSetSysformats = SET("SYSFORMATS")
lcSetCentury = SET("CENTURY")
lcSetDate = SET("DATE")
lcSetHours = SET("HOURS")
lcSetMark = SET("MARK")

SET SYSFORMATS OFF
SET CENTURY ON
SET DATE YMD
SET HOURS TO 24
SET MARK TO "/"

DECLARE GetLocalTime IN win32api ;
STRING @lcAuxi

lcAuxi=SPAC(32)

IF GetLocalTime(@lcAuxi)
ltDateTime = CTOT( _256to10(SUBS(lcAuxi,1,2), 4) + "/" + ;
_256to10(SUBS(lcAuxi,3,2), 2) + "/" + ;
_256to10(SUBS(lcAuxi,7,2), 2) + " " + ;
_256to10(SUBS(lcAuxi,9,2), 2) + ":" + ;
_256to10(SUBS(lcAuxi,11,2), 2) + ":" + ;
_256to10(SUBS(lcAuxi,13,2), 2) )
ELSE
ltDateTime = .NULL.
ENDIF

SET MARK TO &lcSetMark
SET HOURS TO &lcSetHours
SET DATE &lcSetDate
SET CENTURY &lcSetCentury
SET SYSFORMATS &lcSetSysformats

RETURN ltDateTime
ENDFUNC

*========================
FUNCTION WriteLocalTime(ltDateTime)
*========================
* Escribe mediante API el GetLocalTime
* Parametro: Debe pasarse una variable del tipo DateTime
* Retorno: .T. si pudo cambiar fecha y hora
* .F. envio un parámetro no válido o error
* Autor: LMG - 1998.09.14
*========================
IF TYPE("ltDateTime") # "T"
RETURN .F.
ENDIF

LOCAL lcCadena

lcCadena = _10to256(YEAR(ltDateTime),2) + ;
_10to256(MONTH(ltDateTime),2) + ;
_10to256(DOW(ltDateTime),2) + ;
_10to256(DAY(ltDateTime),2) + ;
_10to256(HOUR(ltDateTime),2) + ;
_10to256(MINUTE(ltDateTime),2) + ;
_10to256(SEC(ltDateTime),2) + ;
_10to256(000,2) + SPAC(24)

DECLARE SetLocalTime IN win32api ;
STRING lcCadena

RETURN SetLocalTime(lcCadena)
ENDFUNC

*========================
FUNCTION _256to10(lcPar, lnCant)
*========================
* Toma un par de caracteres en base 256 y lo
* convierte en "lnCant" caracteres en base 10
* Usada por: ReadLocalTime()
* Autor: LMG - 1998.09.14
*========================
RETURN PADL(ALLTRIM(STR(ASC(SUBSTR(lcPar,2)) * 256 + ;
ASC(SUBSTR(lcPar,1)))), lnCant, "0")
ENDFUNC

*========================
FUNCTION _10to256(lnNumero, lnCant)
*========================
* Toma número en base 10 y lo convierte
* en "lnCant" caracteres en base 256
* Usada por: WriteLocalTime()
* Autor: LMG - 1998.09.14
*========================
LOCAL lcRetorno, lnAscii

lcRetorno=''
DO WHILE lnNumero >= 256
lnAscii=MOD(lnNumero,256)
lcRetorno=lcRetorno + CHR(lnAscii)
lnNumero=INT(lnNumero / 256)
ENDDO
lnAscii=lnNumero
lcRetorno=lcRetorno + CHR(lnAscii)
RETURN PADR(lcRetorno, lnCant, CHR(0))
ENDFUNC
*========================
*----------------------------------------------------
* FUNCTION ServerTime(tcServerName, tlUtcTime)
* Retorna la hora del servidor pasado como parametro
* PARAMETROS:
* tcServerName = Nombre del servidor
* tlUtcTime = .T. FH UTC - .F. FH Local
* RETORNO: FechaHora ó .Null. si hubo error
* USO: ? ServerTime("\MiServidor")
*----------------------------------------------------
FUNCTION ServerTime(tcServerName, tlUtcTime)
IF PARAMETERS() < 2
tlUtcTime = .F.
ENDIF
DECLARE INTEGER NetRemoteTOD IN netapi32 ;
STRING @, INTEGER @
DECLARE INTEGER RtlMoveMemory IN win32api ;
STRING @outbuffer, ;
INTEGER inbuffer, ;
INTEGER bytes2copy
tdbuffout = REPLICATE(CHR(0), 48)
tdbuffin = 0
lcTryServerName = STRCONV(tcServerName, 5)
rc = NetRemoteTOD(@lcTryServerName, @tdbuffin)
IF rc = 0
=RtlMoveMemory(@tdbuffout, tdbuffin, 48)
ELSE
lcTryServerName = STRCONV("\" + tcServerName, 5)
rc = NetRemoteTOD(@lcTryServerName, @tdbuffin)
IF rc = 0
=RtlMoveMemory(@tdbuffout, tdbuffin, 48)
ELSE
*-- Error con NetRemoteTOD()
RETURN .Null.
ENDIF
ENDIF
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))
tod_timezone = str2long(SUBSTR(tdbuffout, 25, 4)) * 60
serverdatetime = DATETIME(tod_year, tod_month, tod_day, ;
tod_hours, tod_mins, tod_secs)
IF tlUtcTime
tdServerTime = serverdatetime
ELSE
tdServerTime = serverdatetime - tod_timezone
ENDIF
RETURN tdServerTime
ENDFUNC

*----------------------------------------------------
FUNCTION str2long(tcLongStr)
LOCAL ln, lnRetVal
lnRetVal = 0
FOR ln = 0 TO 24 STEP 8
lnRetVal = lnRetVal + (ASC(tcLongStr) * (2^ln))
tcLongStr = RIGHT(tcLongStr, LEN(tcLongStr) - 1)
ENDFOR
RETURN lnRetVal
ENDFUNC
*----------------------------------------------------