Public Function GetServerTime(ByVal strServer As String) As Date
'*******************************************
'Name: fGetServerTime [NT ONLY] (Function)
'Purpose: Returns Time of Day for NT Server
'Author: Dev Ashish
'Date: Monday, January 11, 1999
'Called by: Any
'Calls: NetRemoteTOD, RtlMoveMemory
'Inputs: Name of NT Server in \\ServerName format
'Returns: Time of day for the NT Server
'Modified by Brian Denning on 4/12/2002 to return the value
' in the correct format(not GMT) and as date format
'*******************************************
On Error GoTo ErrHandler
Dim tSvrTime As TIME_OF_DAY_INFO, lngRet As Long
Dim lngPtr As Long
Dim strout As String
Dim intHoursDiff As Integer
Dim intMinsDiff As Integer
Dim ThisHour As Integer
If Not Left$(strServer, 2) = "\\" Then _
Err.Raise vbObjectError + 5000
strServer = StrConv(strServer, vbUnicode)
lngRet = apiNetRemoteTOD(strServer, lngPtr)
If Not lngRet = 0 Then Err.Raise vbObjectError + 5001
Call sapiCopyMemory(tSvrTime, ByVal lngPtr, Len(tSvrTime))
With tSvrTime
intHoursDiff = .tod_timezone \ 60
intMinsDiff = .tod_timezone Mod 60
strout = .tod_month & "/" & .tod_day & "/" _
& .tod_year & " "
If .tod_hours > 12 Then
strout = strout & Format(.tod_hours - 12 - intHoursDiff, "00") _
& ":" & Format$(.tod_mins - intMinsDiff, "00") & ":" _
& Format$(.tod_secs, "00") & " PM"
'strOut = strOut & Format(.tod_hours - 0 - intHoursDiff, "00") _
& ":" & Format$(.tod_mins - intMinsDiff, "00") & ":" _
& Format$(.tod_secs, "00") & " PM"
Else
strout = strout & Format(.tod_hours - intHoursDiff, "00") _
& ":" & Format$(.tod_mins - intMinsDiff, "00") & ":" _
& Format$(.tod_secs, "00") & " AM"
'strOut = strOut & Format(.tod_hours + 6, "00") _
& ":" & Format$(.tod_mins - intMinsDiff, "00") & ":" _
& Format$(.tod_secs, "00") & " AM"
End If
End With
ThisHour = Split(Mid(Split(strout, "/")(2), 6), ":")(0)
If ThisHour < 0 Then
If Right(strout, 2) = "PM" Then
strout = DateAdd("h", ThisHour * 2, CDate(Replace(strout, "-", "")))
Else
strout = DateAdd("h", ThisHour * 2, CDate(Replace(strout, "-", "")))
End If
End If
GetServerTime = strout
ExitHere:
Exit Function
ErrHandler:
GetServerTime = 0
Resume ExitHere
End Function