如何获取server端的日期。

Public adoCN As New ADODB.Connection       '定义数据库的连接存放数据和代码Public SqlCommand As New ADODB.Command     '定义 SQL 命令Dim adoDateTime As New ADODB.Recordset     '获取 NT-SERVER 时间'***********************************************************************
'*  功能：与 SQL SERVER 数据库建立连接并取出服务器时间
'***********************************************************************
Public Function OpenConnection() As String '打开数据库
    On Error GoTo SQLConErr
    With adoCN
        .CursorLocation = adUseClient
        .Provider = "sqloledb"
        .Properties("Data Source").Value = cNtServerName
        .Properties("Initial Catalog").Value = cDatabaseName
        .Properties("User ID") = cSQLUserName
        .Properties("Password") = cSQLPassword
        .Properties("prompt") = adPromptNever
        .ConnectionTimeout = 15  ‘可以改这个时间
        .Open

        If .State = adStateOpen Then
            adoDateTime.Open "select getdate()", adoCN, adOpenStatic, adLockOptimistic
            cServerDate = Format(adoDateTime(0), "yyyy-mm-dd")
            cServertime = Mid(adoDateTime(0), 10)
        Else
            MsgBox "数据库连接失败，请找系统管理员进行检查！", 16, cProgramName
            End
        End If
    End With

    SqlCommand.ActiveConnection = adoCN
    SqlCommand.CommandType = adCmdText
    Exit Function
SQLConErr:
    Select Case Err.Number
        Case -2147467259
            MsgBox "找不到指定的SQL Server服务器或者数据库不存在，请重新设置！", vbExclamation
            F_SetSystem.Show 1
        Case -2147217843
            MsgBox "指定的SQL Server数据库用户不存在或口令错误，请重新设置！", vbExclamation
            F_SetSystem.Show 1
        Case Else
            MsgBox "数据环境连接失败，请找系统管理员进行检查！", 16, cProgramName
    End Select
    OpenConnection
End Function

如果服务器装有sql server，可以用
select getdate()得到日期

'取数据服务器当前时间
Public Function GetCurDate() As String
On Error Resume Next
    Dim rs As New ADODB.Recordset

    rs.Open "select GetDate() from sysobjects", cn, adOpenKeyset, adLockReadOnly
    If IsNull(rs.Fields(0).Value) Then
        GetCurDate = Format$(Date, "yyyy/mm/dd hh:mm")
    Else
        GetCurDate = Format$(rs.Fields(0).Value, "yyyy/mm/dd hh:mm")
    End If

    rs.Close
    Set rs = Nothing
End Function那个SQL语句中的表你可以换成你数据库中存在的表名.

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 TypePrivate 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 TypePrivate 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 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'要运行该程序，通过如下方式调用。
Private Sub Command1_Click()
    Dim d As Date
    d = getRemoteTOD("\\机器名称")
    MsgBox d
End Sub

或者
strSql="SELECT GETDATE() AS dCurDate FROM YourTable"rs.open strSql,cn,1,3msgbox rs("dCurDate")

agree with gxcc
如果不用sql server，则只能用api。但是跟操作系统版本有关。
不知道怎么使用类似net time \\computername方式来得到服务器时间。关心中。

纠正：agree with lxcc(虫莲) :)

也可以考虑用 winsock，与server连接后通过服务程序返回它的时间

调试易

如何获取server端的日期。

解决方案 »