RE:COMO OBTENER LA HORA DE UN SERVIDOR REMOTO
* tcserver es el nombre del servidor con el
* que sincronizamos (ej. \PC1)
parameter v_retorno
v_sys = sys(5)
*v_sys = "Y:media" &&prueba
if upper(left(v_sys,2)) # "C:" && equipo local
if at("\",v_sys) = 1 && equipo de red con \
v_nomred = subs(v_sys,1,at("",v_sys,3)-1)
v_equipo = fecha(v_nomred)
else && equipo de red mapeado
run/N2 net use > mapred.txt
copy file mapred.txt to c:mapred.txt
erase mapred.txt
v_nomred = filetostr("c:mapred.txt")
v_nomred1 = allt(subs(v_nomred,at(left(v_sys,2),v_nomred)+3))
v_nomred2 = subs(v_nomred1,1,at("",v_nomred1,3)-1)
v_equipo = fecha(v_nomred2)
endif
else
v_equipo = dtoc(date())
endif
return v_equipo
function fecha
lparameter tcserver
*/ declaramos las funciones a utilizar
declare integer NetRemoteTOD in netapi32 STRING@, INTEGER@
declare RtlMoveMemory IN WIN32API as CopyMemory STRING@, INTEGER, INTEGER
declare integer SetSystemTime in kernel32 STRING@
* conversión a UNICODE
lcserver = strconv(strconv(tcserver,1),5)+chr(0)
lnptr = 0
lctimeofday = replicate(chr(0),48)
lcsystemtime = space(0)
*/ tomamos la hora
nres = NetRemoteTOD(@lcserver,@lnptr)
local lnyear, lnmonth, lndayofweek, lnday,;
lnhour, lnminute, lnsecond, lnmillsecond
if nres = 0 then
=CopyMemory(@lctimeofday,@lnptr, 48)
lnyear = DWordtoNum(substr(lctimeofday,41,4))
lnmonth = DWordtoNum(substr(lctimeofday,37,4))
lndayofweek = DWordtoNum(substr(lctimeofday,45,4))
lnday = DWordtoNum(substr(lctimeofday,33,4))
lnhour = DWordtoNum(substr(lctimeofday,9,4))
lnminute = DWordtoNum(substr(lctimeofday,13,4))
lnsecond = DWordtoNum(substr(lctimeofday,17,4))
*!* lcsystemtime = NumtoWord(lnyear)+ NumtoWord(lnmonth)+;
*!* NumtoWord(lndayofweek)+ NumtoWord(lnday) + ;
*!* NumtoWord(lnhour)+ NumtoWord(lnminute)+;
*!* NumtoWord(lnsecond)+ NumtoWord(0)
lcsystemdate = ctod(allt(str(lnday))+"/"+allt(str(lnmonth))+"/"+allt(str(lnyear)))
*/ colocamos la hora en el equipo local
*!*nres = SetSystemTime(@lcsystemtime) && sincroniza fecha y hora
*!*return nres # 0 && con fecha y hora del servidor
clear dlls
return lcsystemdate
else
messagebox("El Equipo: <"+tcserver+"> donde esta el programa"+chr(13)+ ;
"está apagado o no hay conexión",16,"College XXI")
clear dlls
return allt(str(nres))
endif
return
***************************
function DwordToNum
lparameter tcDWORD
local ln0,ln1,ln2,ln3
ln0=asc(subs(tcDWORD,1,1))
ln1=asc(subs(tcDWORD,2,1)) * (256)
ln2=asc(subs(tcDWORD,3,1)) * (256^2)
ln3=asc(subs(tcDWORD,4,1)) * (256^3)
return ln3 + ln2 + ln1 + ln0
**************************
function NumtoWord
lparameter tnNum
lcresult = chr(0)+chr(0)
if tnNum < (2^15 - 1) then
lcresult = chr(mod(tnNum,256))+chr(int(tnNum/256))
else
* no es un número válido
endif
return lcresult
