Server Date & Time 5

[BTawil]

Hello,
I'm developping a VB application that requiers automatic date and time stamping.
For security reasons, i want the stamp to be based on the server data and time rather than the machine's local date and time. is there a function that i can call to get the server date and time?

Thanks

 

[chiph]

I think you can get this info out of ActiveDirectory, but I'm not 100% sure. ActiveDirectory synchronizes all Windows 2000 machines clocks anyway, so the local PC's time will be pretty close to the server's time.

If you're using SQL Server, you can run this query to find out the time on the database server:
[tt]
SELECT GetDate()
[/tt]

Chip H.

 

[fenris]

If you have internet access with these machines, why not synch the local machines time with one of the many atomic clocks located on the internet.

You could also try the command:

net time \\serverName

Although this is a seperate program, it returns the time of the serverName.

Troy Williams B.Eng.
fenris@hotmail.com

 

[apkohn]

It is on an MS Access site, but I think it should work in normal VB also...
check out

http://www.mvps.org/access/api/api0039.htm

I have used this in the past, but made minor modifications to it. Rather than returning the time as a string, I returned it as a date type. Also, I found that there was a slight problem when dealing with timezones a lot ahead of GMT (I am GMT+10/11). I think I overcome this, by converting the GMT time to a date format, and then simply using DateAdd function to add the GMT offset.

Unfortunately I don't have access to the mods I did anymore (moved to a different company), but I remember it only took a short time, to fix it up properly.

 

[thevillageinn]

thanks for the link to the MVPS site...I forget how many helpful snippets of code there are there!

-Dan

 

[thevillageinn]

sorry to dig this back up, but I'm having some issues getting the time returned to match correctly to my actual time when using this code. I am -7/-8 GMT, and this code is returning negative times when it's late in the evening...I am having issues converting the returned string into a valid date/time because of the negatives. I must be attempting to convert the string at the wrong point in the code. Where do I go from here?

I would be happy to answer any questions that may help someone help me.

Thanks in advance-
-Dan

 

[bjd4jc]

This is what I did and I am in the Central Time Zone. I modified the same code that you got from that link:

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) = &quot;PM&quot; Then
            strout = DateAdd(&quot;h&quot;, ThisHour * 2, CDate(Replace(strout, &quot;-&quot;, &quot;&quot;)))
        Else
            strout = DateAdd(&quot;h&quot;, ThisHour * 2, CDate(Replace(strout, &quot;-&quot;, &quot;&quot;)))
        End If
    End If
    
  GetServerTime = strout
ExitHere:
  Exit Function
ErrHandler:
  GetServerTime = 0
  Resume ExitHere
End Function

 

[thevillageinn]

Brian,
Thank you for that info...your changes make quite a bit of sense.

I haven't had a chance to dig up an alternative function for "Split" for Access 97, but will work on it after lunch unless anyone knows of an alternative off the top of their heads.

Thanks again for your input!
-Dan

 

[bjd4jc]

Here is the split that I use in my access Applications. I wrote it myself. It doesn't have quite the capability that the VB one does. You would have to send it which element of the array you want. It doesn't return an array.

Public Function Split(Expression As String, Delimeter As String, Number As Integer)
    Dim Pos, Pos2 As Integer
    Dim LCV As Integer
    Dim Count As Integer
    
    Pos = 0
    Do While InStr(Pos + 1, Expression, Delimeter) <> 0
        Pos = InStr(Pos + 1, Expression, Delimeter)
        Count = Count + 1
    Loop
    
    Pos = 0
    For LCV = 1 To Count + 1 Step 1
        If LCV = Number Then
            Pos2 = InStr(Pos + 1, Expression, Delimeter)
            If Pos2 = 0 Then
                Split = Mid(Expression, Pos + 1)
            Else
                Split = Mid(Expression, Pos + 1, Pos2 - (Pos + 1))
            End If
        End If
        Pos = InStr(Pos + 1, Expression, Delimeter)
    Next
End Function

 

[bjd4jc]

Well, I thought, what the heck. So, I rewrote my split function to work just like the one in VB. Here it is:

Public Function Split(Expression As String, Delimeter As String) As Variant
    Dim Pos, Pos2 As Integer
    Dim LCV As Integer
    Dim Count As Integer
    Dim SplitReturn() As String
    
    Pos = 0
    Do While InStr(Pos + 1, Expression, Delimeter) <> 0
        Pos = InStr(Pos + 1, Expression, Delimeter)
        Count = Count + 1
    Loop
    
    ReDim SplitReturn(0 To Count)
    Pos = 0
    For LCV = 1 To Count + 1 Step 1
            Pos2 = InStr(Pos + 1, Expression, Delimeter)
            If Pos2 = 0 Then
                SplitReturn(LCV - 1) = Mid(Expression, Pos + 1)
            Else
                SplitReturn(LCV - 1) = Mid(Expression, Pos + 1, Pos2 - (Pos + 1))
            End If
        Pos = InStr(Pos + 1, Expression, Delimeter)
    Next
    
    Split = SplitReturn
End Function

 

[CajunCenturion]

Public Function MySplit(Expression As String, Delimeter As String) As Variant

Dim StartPos As Integer
Dim EndPos As Integer
Dim ArrSub As Integer
Dim Tokens() As String

ArrSub = -1
StartPos = 1
EndPos = InStr(StartPos, Expression, Delimeter)
Do While (EndPos > 0)
ArrSub = ArrSub + 1
ReDim Preserve Tokens(ArrSub)
Tokens(ArrSub) = Trim(Mid(Expression, StartPos, (EndPos - StartPos)))
StartPos = EndPos + 1
EndPos = InStr(StartPos, Expression, Delimeter)
Loop
ArrSub = ArrSub + 1
ReDim Preserve Tokens(ArrSub)
Tokens(ArrSub) = Trim(Mid(Expression, StartPos))
MySplit = Tokens

End Function
Good Luck
--------------
As a circle of light increases so does the circumference of darkness around it. - Albert Einstein

 

[thevillageinn]

Thanks once more for your assistance...your split function works quite well, and your re-write seems to be much easier to follow.

Now I'm stuck on the "Replace" function. I know that Mid could be used in Access, but it requires a start position...can the "-" be used as the start point?

Thanks again...maybe someday I'll be a bit more proficient.
-Dan

 

[bjd4jc]

Here is the replace function that I wrote too:

Public Function Replace(Expression As String, ReplaceWhat As String, ReplaceTo As String) As String

    Dim pos As Integer
    Dim LeftOfExpression As String
    Dim RightOfExpression As String
    
    pos = InStr(1, Expression, ReplaceWhat)
    
    If pos = 0 Then
        Replace = Expression
        Exit Function
    End If
    
    Do
    
        LeftOfExpression = Left(Expression, pos - 1)
        RightOfExpression = Mid(Expression, pos + Len(ReplaceWhat))
        Expression = LeftOfExpression + ReplaceTo + RightOfExpression
        pos = InStr(pos + Len(ReplaceTo), Expression, ReplaceWhat)
    Loop Until pos = 0
    
    Replace = Expression
        
End Function

 

[MichaelRed]

Public Function basSplit(StrIn As String, _
                         Optional DelimChar As String = " ") _
                         As Variant

    'to return an array of the tokens (Words) in a dellimited list of values
    'the delimiter may be set by the user.  The default value for the dilimiter
    'is a single space.  The Delimiter may be set to any string, however only the
    'first character of the string is used.

    'Michael Red, 9/25/00 for the Duvall Group, Columbia, MD
    'Usage & Example

    'MyArray = basSplit("Me, Myself, Thee, Thou, Though, Go, This is a test", ",")
    'For xx = 0 To UBound(MyArray): Print xx, MyArray(xx): Next xx
    '0      Me
    '1       Myself
    '2       Thee
    '3       Thou
    '4       Though
    '5       Go
    '6       This is a test


    Dim Idx As Integer
    Dim Dlm As Integer
    Dim PrvDlm As Integer
    Dim WdsDone As Boolean

    Dim WdAray() As String

    DelimChar = Left(DelimChar, 1)

    Idx = 0                         'Init WdAray Index
    PrvDlm = 0                      'Start w/ Prev pos of Delim Before String
    ReDim WdAray(Idx)               'Initalize array of Words to single element

    While Not WdsDone
        Dlm = InStr(PrvDlm + 1, StrIn, DelimChar)
        If (Dlm = 0) Then     'Can't find any more dellimiters.
            'Must be done.  Just add the remainder of the Input
            WdAray(Idx) = Right(StrIn, Len(StrIn) - (PrvDlm))
            WdsDone = True           'Tell'em were done here
         Else
            'Somewhere in the midst of all this, we jave found a "Real" word
            WdAray(Idx) = Mid(StrIn, PrvDlm + 1, ((Dlm - 1) - (PrvDlm - 1)) - 1)
            Idx = Idx + 1
            ReDim Preserve WdAray(Idx)
            PrvDlm = Dlm
        End If
    Wend

    If (WdAray(Idx) = "") Then
        ReDim Preserve WdAray(Idx - 1)      'Remove (Unused) last array element
    End If

    basSplit = WdAray

End Function

MichaelRed
m.red@att.net

There is never time to do it right but there is always time to do it over

 

[thevillageinn]

Many, many thanks to all who contributed! My procedure seems to be working, and providing accurate time, which I can format as Date/Time in my table for effective sorting.

Thanks again!
-Dan

 

[apkohn]

Its late, but I have just found the code that I use...

Public Function fGetServerTime(ByVal strServer As String) As Date
'Public Function fGetServerTime(ByVal strServer As String) As String
'*******************************************
'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:     Anthony Kohn
'Purpose:         To return a date type and to correct
'                 miscalculation when timezone is GMT+ hrs
'                 (eg Australia, GMT+10)
'*******************************************
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 intLocalHours As Integer
Dim intLocalMinutes As Integer
Dim intLocalDay As Integer
Dim intLocalMonth As Integer
Dim intLocalYear As Integer

Dim dateServerDate As Date

  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"
    'Else
    '  strOut = strOut & Format(.tod_hours - intHoursDiff, "00") _
    '    & ":" & Format$(.tod_mins - intMinsDiff, "00") & ":" _
    '   & Format$(.tod_secs, "00") & " AM"
    'End If
    
    dateServerDate = DateValue(.tod_day & "/" & .tod_month & "/" & .tod_year)
    dateServerDate = DateAdd("h", .tod_hours - intHoursDiff, dateServerDate)
    dateServerDate = DateAdd("n", .tod_mins - intMinsDiff, dateServerDate)
    dateServerDate = DateAdd("s", .tod_secs, dateServerDate)
  End With
  
  'fGetServerTime = strOut
  fGetServerTime = dateServerDate
ExitHere:
  Exit Function
ErrHandler:
  'fGetServerTime = vbNullString
  fGetServerTime = Date
  Resume ExitHere
End Function
'**************** Code End *****************

 

[apkohn]

Just to place a comment against my own code above, I would make a change.

Where I have the line
dateServerDate = DateValue(.tod_day & "/" & .tod_month & "/" & .tod_year)

I would swap that for a call to date serial. This would prevent any issues withh dd/mm/yy vs mm/dd/yy format.

So, the line should be
dateServerDate = DateSerial(.tod_year, .tod_month, .tod_day)