1. Through the NET TIME method:
Private function synctime (byval servername as string) as boolean
Dim thehell As string
ON Error Goto Error_Synctime
????shell = "net time" & chr (34) & "//" & servername & chr (34) & "/ set / yes"
???? x = shell (theeshell)
???? synctime = TRUE
EXIT FUNCTION
Error_Synctime:
???? synctime = false
END FUNCTION
Private sub cmdset_click ()
???? fness (TXTSETTIME.TEXT)) THEN MSGBOX "Synchronous Time Success!"
End Sub
2. Method by MSSQL
Public function gettime () as date ?? 'Take the server time
???? DIM RS as new adoDb.recordset
???? on error Goto Err
???? set = "SELECT getDate () AS DD", CN, AdopenKeyset, AdlockOptimistic, AdcmdText
???? if xi r gettime = rs.fields (0) .value
???? ERR:
IF not rs is nothing then
???? if xi rstate <> adStateclosed then
???????? rs.close
???????? set = Nothing
???? Else
???????? set = Nothing
???? End IF
END IF
END FUNCTION
3. Implementation through the API
Option expedition
Private Declare Function NetRemotetoD lib "Netapi32.dll" (_
???? TSERVER AS ANY, PBUFFER AS Long AS Long
????
Private Type SystemTime
???? Wyear as integer
???? WMONTH AS INTEGER
???? WDAYOFWEEK AS INTEGER
???? wday as integer
???? WHOUR AS INTEGER
???? WMINUTE AS INTEGER
???? WSecond AS Integer
???? wmilliseconds as integer
End Type
PRIVATE TY TIME_ZONE_INFORMATION
???? bias as long
???? standardname (32) AS Integer
???? standarddate as systemtime
???? standardbias as long
???? daylightname (32) AS Integer
???? daylightdate as systemtime
??????????????????????????????????????
End Type
Private Declare Function GetTimeZoneInformation Lib "kernel32" (lpTimeZoneInformation As TIME_ZONE_INFORMATION) As LongPrivate Declare Function NetApiBufferFree Lib "Netapi32.dll" (ByVal lpBuffer As Long) As Long
'
PRIVATE TIME_OF_DAY_INFO
???? TOD_ELAPSEDT AS Long
???? Tod_msecs as long
???? Tod_Hours As long
???? Tod_Mins as long
???? Tod_Secs as long
???? Tod_hunds as long
???? Tod_timezone As Long
???? TOD_TINTERVAL AS Long
???? Tod_day as long
???? TOD_MONTH AS Long
???? Tod_Year as long
???? Tod_weekday as long
End Type
'
Private Declare Sub CopyMemory LIB "kernel32" Alias "RTLMoveMemory" (Destination As Any, Source As Any, BYVAL LENGTH AS "
Public Function GetRemotetoD (Byval StrserVer AS String) AS Date
???? Dim Result As Date
???? Dim Lret As Long
???? DIM TOD AS TIME_OF_DAY_INFO
???? DIM LPBUFF AS Long
???? DIM TSERVER () AS BYTE
???? TSERVER = STRSERVER & VBNULLCHAR
???? Lret = NetRemotetod (TSERVER (0), LPBUFF)
???? if lret = 0 THEN
???????? CopyMemory Tod, ByVal LPBUFF, LEN (TOD)
???????? NetapUfferfree lpbuff
???????? result = dateserial (Tod.tod_Year, Tod.tod_Month, Tod.tod_day) _ _ _
???????? TimeSerial (Tod.tod_HOURS, TOD.TOD_MINS - TOD.TOD_TIMEZONE, TOD.TOD_SECS)
???????? getremotetod = result
???? Else
???????? Err.raise Number: = VBObjectError 1001, _
???????? description: = "cannot get remote tod"
???? End IF
END FUNCTION
'To run the program, call it as follows.
Private submmand1_click ()
???? DIM D AS Date
???? d = getRemTetod ("// machine name")
???? msgbox d
End Sub
Computer World Developer Club
http://www.dev-club.com
