请教！如何使客户端的时间与服务器的同步？

sxgaobo

如何使客户端的时间与服务器的同步啊！？

wu8313

把如下代码复制到 标准模块中，保存。
Option Compare Database

Option Explicit
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 Type TIME_ZONE_INFORMATION
  Bias             As Long
  StandardName(32) As Integer
  StandardDate     As SYSTEMTIME
  StandardBias     As Long
  DaylightName(32) As Integer
  DaylightDate     As SYSTEMTIME
  DaylightBias     As Long
End Type

Private Declare Function GetTimeZoneInformation Lib "kernel32" ( _
                         lpTimeZoneInformation As TIME_ZONE_INFORMATION) As Long
Private Declare Function NetApiBufferFree Lib "Netapi32.dll" (ByVal lpBuffer As Long) As Long

Private Type 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 Long)

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)
     NetApiBufferFree 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:="获取服务器时间失败,请确认服务器地址是否正确!"
               
  End If
End Function

===================
然后，ctrl + G 打开代码窗口，输入 ?getRemoteTOD("127.0.0.1")
然后，回车就可以看到执行结果，显示本地机器的时间和日期。

sxgaobo

谢谢wu8313 元老！
再请教下，这是获取到了服务器的时间，如何用代码将本机的时间修改为服务器的时间啊？

wu8313

分为几个步骤：
1、'模块功用:取得远程服务器的日期与时间
'--------------------------------------------
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 Type TIME_ZONE_INFORMATION
  Bias             As Long
  StandardName(32) As Integer
  StandardDate     As SYSTEMTIME
  StandardBias     As Long
  DaylightName(32) As Integer
  DaylightDate     As SYSTEMTIME
  DaylightBias     As Long
End Type

Private Declare Function GetTimeZoneInformation Lib "kernel32" ( _
                         lpTimeZoneInformation As TIME_ZONE_INFORMATION) As Long
Private Declare Function NetApiBufferFree Lib "Netapi32.dll" (ByVal lpBuffer As Long) As Long

Private Type 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 Long)

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)
     NetApiBufferFree 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:="获取服务器时间失败,请确认服务器地址是否正确!"
               
  End If
  
  'ctrl + G 打开代码窗口，输入 ?getRemoteTOD("127.0.0.1") _
  然后，回车就可以看到执行结果，显示本地机器的时间和日期。
End Function
2、'模块功用:切割 已经获取到的远程服务器日期和时间，获取 年/月/日，小时:分钟:秒
'by wu8313 / 2009-07-02
'------------------------------------------------------
Public mydatetime As String
Public mydate, mytime As String         '日期 时间
Public yy, mon, dd As Integer    '年 月 日
Public hh, min, ss As Integer    '小时 分钟 秒

Public Sub get_mydate_time()   '以空格为界，分别截取 日期和时间

   ' mydatetime的值 由外部函数获取 函数 getRemoteTOD 在 窗体 frm_synchronization 中获取
   
    Dim i As Integer
   
      For i = 1 To Len(mydatetime)
      
        If Asc(Mid(mydatetime, i, 1)) = 32 Then '以空格为界 asc(" ")=32
           
           mydate = Left(mydatetime, i - 1)
           mytime = Right(mydatetime, Len(mydatetime) - i)
           Debug.Print mydate: Debug.Print mytime
         
        End If
        
      Next

End Sub
Public Sub yy_mm_dd()   '以中划线为界，分别截取 年 月 日
Dim temp As String

      For i1 = 1 To Len(mydate) '获得年
      
        If Asc(Mid(mydate, i1, 1)) = 45 Then '以中划线为界 asc("-")=45
           yy = CInt(Left(mydate, i1 - 1))
           temp = Right(mydate, Len(mydate) - i1)
           Debug.Print "yy=" & yy
           Exit For
        End If
        
      Next i1
      
      
      For i2 = 1 To Len(temp) '获得月
      
        If Asc(Mid(temp, i2, 1)) = 45 Then '以中划线为界
           mon = CInt(Left(temp, i2 - 1))
           temp = Right(temp, Len(temp) - i2)
           Debug.Print "mon=" & mon
           Exit For
        End If
        
      Next i2
      
      
     '接下来，temp=dd 直接获取到了日
     dd = CInt(temp)
     Debug.Print "dd=" & dd

End Sub

Public Sub hh_min_ss()   '以冒号为界，分别截取 小时 分钟 秒
Dim temp As String

      For i1 = 1 To Len(mytime) '获得小时
        If Asc(Mid(mytime, i1, 1)) = 58 Then '以中划线为界 asc(":")=58
        
           hh = CInt(Left(mytime, i1 - 1))
           temp = Right(mytime, Len(mytime) - i1)
           Debug.Print "hh=" & hh
           Exit For
        End If
      Next i1
      
      For i2 = 1 To Len(temp) '获得分钟
        If Asc(Mid(temp, i2, 1)) = 58 Then '以中划线为界 asc(":")=58
        
           min = CInt(Left(temp, i2 - 1))
           temp = Right(temp, Len(temp) - i2)
           Debug.Print "min=" & min
           Exit For
         
        End If
      Next i2

     '接下来，temp=ss 直接获取到了秒
     ss = CInt(temp)
     Debug.Print "ss=" & ss
End Sub


3、
'模块功用:使得本地日期与时间和服务器同步
'-------------------------------------------
Private Declare Function SetSystemTime Lib "kernel32" (lpSystemTime As SYSTEMTIME) 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
Public Sub set_local_datetime()
    Dim sysTime As SYSTEMTIME
    With sysTime
        .wYear = yy
        .wMonth = mon
        .wDay = dd
        .wHour = hh - 8    '小时注意要减去时区（8小时）
        .wMinute = min
        .wSecond = ss
    End With
   
    SetSystemTime sysTime
   
End Sub

ACMAIN_CHM

最简单的方法，直接用
shell "net time \\serverNameOrIP /set"