急！请高手帮忙解决如何从ftp服务器上获取该服务器的日期、时间。

Question

'系统对时程序（直接实现客户端和服务器的校时）
Public Function AdjustSystemTime(cn As ADODB.Connection) As Boolean
    Dim lastADOSQL As String
    Dim lastADORst As New ADODB.Recordset
    Dim serverTime As Date
    
    On Error GoTo Error_AdjustSystemTime
    
    lastADOSQL = "Select GETDATE()"
    lastADORst.Open  lastADOSQL,cn  
           serverTime = lastADORst.Fields(0).Value
       lastADORst.Close
     
    Date = Format(serverTime, "yyyy-mm-dd")
    Time = Format(serverTime, "hh:nn:ss")
    Set lastADORst = Nothing
    AdjustSystemTime = True
    Exit Function
    
Error_AdjustSystemTime:
    Set lastADORst = Nothing
    AdjustSystemTime = False
End Function

Answer 1

楼上的朋友，你函数中用了参数cn As ADODB.Connection的对象，你的该对象要连接ftp服务器上的数据库。能不能不用连接数据库用其他的方法。

Answer 2

写一个文件到服务器上，这个文件的时间就是服务器的当前时间
然后用dir可以取得这个文件的时间
比较麻烦。如果是自己的服务器的话考虑在服务器上加装时间服务，这样就方便了。

Answer 3

up:
   能不能用其他方法，另外加装时间服务后如何用vb获取ftp服务器的时间。

Answer 4

Option ExplicitPrivate Type FILETIME
        dwLowDateTime As Long
        dwHighDateTime As Long
End TypePrivate 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_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 TypePrivate Const MAX_LENGTH As Long = 260Private Declare Function GetTempPath Lib "kernel32" Alias "GetTempPathA" (ByVal nBufferLength As Long, ByVal lpBuffer As String) As Long
Private Declare Function GetTempFileName Lib "kernel32" Alias "GetTempFileNameA" (ByVal lpszPath As String, ByVal lpPrefixString As String, ByVal wUnique As Long, ByVal lpTempFileName As String) As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (hpvDest As Any, hpvSource As Any, ByVal cbCopy As Long)
Private Declare Function FileTimeToSystemTime Lib "kernel32" (lpFileTime As FILETIME, lpSystemTime As SYSTEMTIME) As Long
Private Declare Function FileTimeToLocalFileTime Lib "kernel32" (lpFileTime As FILETIME, lpLocalFileTime As FILETIME) As Long
Private Declare Function SystemTimeToFileTime Lib "kernel32" (lpSystemTime As SYSTEMTIME, lpFileTime As FILETIME) As Long
Private Declare Function NetRemoteTOD Lib "Netapi32.dll" (yServer As Any, pBuffer As Long) As Long
Private Declare Function NetApiBufferFree Lib "Netapi32.dll" (ByVal lpBuffer As Long) As LongPrivate Sub Command1_Click()
    Debug.Print fun_GetServerTime("Scorpio")
End SubPublic Function fun_GetServerTime(Optional ByVal strSvr As String = "") As String
    On Error GoTo hError
    Dim todOut As TIME_OF_DAY_INFO
    Dim tmSystem As SYSTEMTIME
    Dim tmLocal As FILETIME
    Dim tmFileTime As FILETIME
    Dim byteArr(1 To 48) As Byte    'because len(todout)=48
    Dim todIn As Long   'a point to get server time
    Dim lRet As Long
    Dim strTrySvr As String
    Dim strTempFile As String
    Dim intFileNum As Integer
    Dim strReturn As String    fun_GetServerTime = ""
    todIn = 0
    If strSvr = "" Then
        lRet = NetRemoteTOD(0, todIn)
        If lRet <> 0 Then Exit Function 'error
        Call CopyMemory(byteArr(1), ByVal todIn, 48)
    Else
        strSvr = UCase(strSvr)
        strTrySvr = StrConv(strSvr, vbUnicode)
        lRet = NetRemoteTOD(ByVal strTrySvr, todIn)
        If lRet = 0 Then
            Call CopyMemory(byteArr(1), ByVal todIn, 48)
        Else    'if win200 server must be : "\\" + servername
            If Left$(strSvr, 2) = "\\" Then Exit Function
            strTrySvr = "\\" & strSvr
            strTrySvr = StrConv(strTrySvr, vbUnicode)
            lRet = NetRemoteTOD(ByVal strTrySvr, todIn)
            If lRet <> 0 Then Exit Function 'error
            Call CopyMemory(byteArr(1), ByVal todIn, 48)
        End If
    End If
    If todIn <> 0 Then NetApiBufferFree (todIn)
    strTempFile = fun_GetTempPathA()
    strTempFile = fun_CreateTempFileA(strTempFile, "tod")
    If Len(strTempFile) = 0 Then Exit Function
    intFileNum = FreeFile
    Open strTempFile For Binary As #intFileNum
        Put #intFileNum, , byteArr
    Close #intFileNum
    intFileNum = FreeFile
    Open strTempFile For Binary As #intFileNum
        Get #intFileNum, , todOut
    Close #intFileNum
    Kill strTempFile
    tmSystem.wDay = todOut.tod_day
    tmSystem.wDayOfWeek = todOut.tod_weekday
    tmSystem.wHour = todOut.tod_hours
    tmSystem.wMinute = todOut.tod_mins
    tmSystem.wMonth = todOut.tod_month
    tmSystem.wSecond = todOut.tod_secs
    tmSystem.wYear = todOut.tod_year
    lRet = SystemTimeToFileTime(tmSystem, tmFileTime)
    If lRet = 0 Then Exit Function  'error
    lRet = FileTimeToLocalFileTime(tmFileTime, tmLocal)
    If lRet = 0 Then Exit Function  'error
    lRet = FileTimeToSystemTime(tmLocal, tmSystem)
    If lRet = 0 Then Exit Function  'error
    strReturn = tmSystem.wYear & "-" & tmSystem.wMonth & "-" & tmSystem.wDay & " " & _
                tmSystem.wHour & ":" & tmSystem.wMinute & ":" & tmSystem.wSecond
    fun_GetServerTime = Format$(strReturn, "YYYY年MM月DD日 HH:MM:SS")
    Exit Function
hError:
    fun_GetServerTime = ""
End Function
'创建一个临时文件
Public Function fun_CreateTempFileA(ByVal strPath As String, ByVal strFileFix As String) As String
    On Error GoTo hError
    Dim strTempFile As String
    Dim lRet As Long
    If Dir(strPath, vbDirectory) = "" Then Exit Function
    strFileFix = Trim(strFileFix)
    If Len(strFileFix) > 3 Then
        strFileFix = Left$(strFileFix, 3)
    ElseIf Len(strFileFix) < 3 Then
        Exit Function
    End If
    strTempFile = String(MAX_LENGTH, vbNullChar)
    lRet = GetTempFileName(strPath, strFileFix, 0, strTempFile)
    If lRet = 0 Then Exit Function
    strTempFile = Left$(strTempFile, InStr(1, strTempFile, vbNullChar) - 1)
    fun_CreateTempFileA = strTempFile
    Exit Function
hError:
    fun_CreateTempFileA = ""
End Function
'获取系统的临时目录
Public Function fun_GetTempPathA() As String
    On Error GoTo hError
    Dim strTempFileDir As String
    Dim lRet As Long
    Const MAX_PATH As Long = 100
    strTempFileDir = String(MAX_PATH, vbNullChar)
    lRet = GetTempPath(MAX_PATH, strTempFileDir)
    If lRet = 0 Then Exit Function  'error
    strTempFileDir = Left$(strTempFileDir, InStr(1, strTempFileDir, vbNullChar) - 1)
    fun_GetTempPathA = strTempFileDir
    Exit Function
hError:
    fun_GetTempPathA = ""
End Function

Answer 5

up:
   ip地址在同一个段的用NetRemoteTOD可以成功返回，但是访问的ftp服务器是经过了路由器，其ip地址与访问ftp服务器的计算机不是相同的段。用NetRemoteTOD始终不能成功返回。