I have created a timestamp to track employee times in an excel spreadsheet.
I have everything protected and all they do is click on a button to display
the timestamp in the field chosen.

It works great, however, I realized something yesterday that I did not think
of before. One way they can manipulate their time is to change their system
time from Windows and timestamp a time that is incorrect.

Does anyone know a way around this? Is there a way to timestamp from a
server time or something like that? Please let me know.

Thanks.

I found this code at VB-Helper.com which uses a macro to set the system time
by retrieving the correct Atomic time from the NIST site. When they click
the button to clock-in or -out, you can have this code retrieve the current
NIST time first.

Private Sub Command1_Click() 'Main button to set the system
' time
On Error GoTo ErrHandler

Label3.Caption = "System Time has Not been Set Yet"

SetIt = 1 'Used to only set time if the time from the
' time server is valid and reportedly accurate

If Winsock1.State < sckClosing Then 'Sometimes the
' Winsock gets delayed in the closing state, so
' make sure it is closed before trying again
If Winsock1.State = sckClosed Then 'If closed, ok to
' open, else close it
Timer1.Interval = 5000 'Start 5 second count to
' 'time' server
Timer1.Enabled = True
Screen.MousePointer = vbHourglass
Winsock1.LocalPort = 0 'Must be set to 0
Winsock1.RemoteHost = Trim$(Text1.Text) 'Address
' of NIST server
Winsock1.RemotePort = 13 '13, 37 or 123 'Use 13!
Winsock1.Protocol = 0 '1-UDP '0-TCP 'USE TCP!
Winsock1.Connect 'This is what goes out and gets
' the time
Else
Winsock1.Close
Screen.MousePointer = vbNormal
Timer1.Interval = 0
Timer1.Enabled = False
End If
Else
Winsock1.Close
Screen.MousePointer = vbNormal
Timer1.Interval = 0
Timer1.Enabled = False
End If

Exit Sub
ErrHandler:
SetIt = 0
Screen.MousePointer = vbNormal
Timer1.Interval = 0
Timer1.Enabled = False
MsgBox "The Winsock Connection is Unavailable."
Winsock1.Close
End Sub



'The server returns data similar to the following:
'
' 52949 03-11-06 16:23:43 00 0 0 650.2 UTC(NIST) *
'The following code parses this data, uses it to initialize a SYSTIME
structure, and then uses
'the SetSystemTime API function to set the system's time.



Private Sub Winsock1_DataArrival(ByVal bytesTotal As Long) _
'Fires when data is received from server
Dim datDate As Date 'formatted date
Dim strData As String 'time string from net time server
Dim JSys As SYSTEMTIME
Dim RetVal As Integer
Dim Ct As Integer

On Error GoTo ErrHandler

Winsock1.GetData strData, vbString 'get string from
' server
datDate = FormatDateTime(strData) 'go format the new
' string

If msAdj < 0 Then 'if msadj = 0 then do not set an
' offset
datDate = DateAdd("s", -1, datDate) 'only if msadj
' < 0, subtract 1 sec from new time so addition
' of msadj is positive
End If

Label1.Caption = "Before " & Now 'time before adjustment

If SetIt = 1 Then 'If all is ok, set system time

'Initialize SYSTIME with new data
JSys.wYear = Year(datDate)
JSys.wMonth = Month(datDate)
JSys.wDayOfWeek = 0 'DayOfWeek(datDate)'Not used
JSys.wHour = Hour(datDate)
JSys.wMinute = Minute(datDate)
JSys.wSecond = Second(datDate)
JSys.wDay = Day(datDate)

If msAdj = 0 Then
JSys.wMilliseconds = 0 'No millisec offset
Else
JSys.wMilliseconds = ((10000 - msAdj) / 10) 'must
' be positive
End If

'Set system time with new data
Do Until RetVal < 0 Or Ct 9 'Make up to 10
' attempts to set the time
RetVal = SetSystemTime(JSys)
Ct = Ct + 1
Loop

Label2.Caption = "After " & Now 'time after
' adjustment

If RetVal < 0 Then
Label3.Caption = "System Time was Set " & _
"Successfully"
Else
Label3.Caption = "There was an Error in Setting " & _
"Time"
End If

'Display time string that was sent from server
Text2.Text = strData
End If

SetIt = 0
Winsock1.Close
Screen.MousePointer = vbNormal
Timer1.Interval = 0
Timer1.Enabled = False

Exit Sub
ErrHandler:
SetIt = 0
Winsock1.Close
Screen.MousePointer = vbNormal
Timer1.Interval = 0
Timer1.Enabled = False
End Sub


--
Please remember to indicate when the post is answered so others can benefit
from it later.


"Chris" wrote:

I have created a timestamp to track employee times in an excel spreadsheet.
I have everything protected and all they do is click on a button to display
the timestamp in the field chosen.

It works great, however, I realized something yesterday that I did not think
of before. One way they can manipulate their time is to change their system
time from Windows and timestamp a time that is incorrect.

Does anyone know a way around this? Is there a way to timestamp from a
server time or something like that? Please let me know.

Thanks.

I'm getting a run-time 424 error.

It says "Object required".

When I go to debug, it highlights the Screen.MoustPointer = vbNormal line
down below.

ErrHandler:
SetIt = 0
Screen.MousePointer = vbNormal
Timer1.Interval = 0
Timer1.Enabled = False
MsgBox "The Winsock Connection is Unavailable."
Winsock1.Close

Thanks.

"Queso" wrote:

I found this code at VB-Helper.com which uses a macro to set the system time
by retrieving the correct Atomic time from the NIST site. When they click
the button to clock-in or -out, you can have this code retrieve the current
NIST time first.

Private Sub Command1_Click() 'Main button to set the system
' time
On Error GoTo ErrHandler

Label3.Caption = "System Time has Not been Set Yet"

SetIt = 1 'Used to only set time if the time from the
' time server is valid and reportedly accurate

If Winsock1.State < sckClosing Then 'Sometimes the
' Winsock gets delayed in the closing state, so
' make sure it is closed before trying again
If Winsock1.State = sckClosed Then 'If closed, ok to
' open, else close it
Timer1.Interval = 5000 'Start 5 second count to
' 'time' server
Timer1.Enabled = True
Screen.MousePointer = vbHourglass
Winsock1.LocalPort = 0 'Must be set to 0
Winsock1.RemoteHost = Trim$(Text1.Text) 'Address
' of NIST server
Winsock1.RemotePort = 13 '13, 37 or 123 'Use 13!
Winsock1.Protocol = 0 '1-UDP '0-TCP 'USE TCP!
Winsock1.Connect 'This is what goes out and gets
' the time
Else
Winsock1.Close
Screen.MousePointer = vbNormal
Timer1.Interval = 0
Timer1.Enabled = False
End If
Else
Winsock1.Close
Screen.MousePointer = vbNormal
Timer1.Interval = 0
Timer1.Enabled = False
End If

Exit Sub
ErrHandler:
SetIt = 0
Screen.MousePointer = vbNormal
Timer1.Interval = 0
Timer1.Enabled = False
MsgBox "The Winsock Connection is Unavailable."
Winsock1.Close
End Sub



'The server returns data similar to the following:
'
' 52949 03-11-06 16:23:43 00 0 0 650.2 UTC(NIST) *
'The following code parses this data, uses it to initialize a SYSTIME
structure, and then uses
'the SetSystemTime API function to set the system's time.



Private Sub Winsock1_DataArrival(ByVal bytesTotal As Long) _
'Fires when data is received from server
Dim datDate As Date 'formatted date
Dim strData As String 'time string from net time server
Dim JSys As SYSTEMTIME
Dim RetVal As Integer
Dim Ct As Integer

On Error GoTo ErrHandler

Winsock1.GetData strData, vbString 'get string from
' server
datDate = FormatDateTime(strData) 'go format the new
' string

If msAdj < 0 Then 'if msadj = 0 then do not set an
' offset
datDate = DateAdd("s", -1, datDate) 'only if msadj
' < 0, subtract 1 sec from new time so addition
' of msadj is positive
End If

Label1.Caption = "Before " & Now 'time before adjustment

If SetIt = 1 Then 'If all is ok, set system time

'Initialize SYSTIME with new data
JSys.wYear = Year(datDate)
JSys.wMonth = Month(datDate)
JSys.wDayOfWeek = 0 'DayOfWeek(datDate)'Not used
JSys.wHour = Hour(datDate)
JSys.wMinute = Minute(datDate)
JSys.wSecond = Second(datDate)
JSys.wDay = Day(datDate)

If msAdj = 0 Then
JSys.wMilliseconds = 0 'No millisec offset
Else
JSys.wMilliseconds = ((10000 - msAdj) / 10) 'must
' be positive
End If

'Set system time with new data
Do Until RetVal < 0 Or Ct 9 'Make up to 10
' attempts to set the time
RetVal = SetSystemTime(JSys)
Ct = Ct + 1
Loop

Label2.Caption = "After " & Now 'time after
' adjustment

If RetVal < 0 Then
Label3.Caption = "System Time was Set " & _
"Successfully"
Else
Label3.Caption = "There was an Error in Setting " & _
"Time"
End If

'Display time string that was sent from server
Text2.Text = strData
End If

SetIt = 0
Winsock1.Close
Screen.MousePointer = vbNormal
Timer1.Interval = 0
Timer1.Enabled = False

Exit Sub
ErrHandler:
SetIt = 0
Winsock1.Close
Screen.MousePointer = vbNormal
Timer1.Interval = 0
Timer1.Enabled = False
End Sub


--
Please remember to indicate when the post is answered so others can benefit
from it later.


"Chris" wrote:

I have created a timestamp to track employee times in an excel spreadsheet.
I have everything protected and all they do is click on a button to display
the timestamp in the field chosen.

It works great, however, I realized something yesterday that I did not think
of before. One way they can manipulate their time is to change their system
time from Windows and timestamp a time that is incorrect.

Does anyone know a way around this? Is there a way to timestamp from a
server time or something like that? Please let me know.

Thanks.

Sorry, just found that code on that site and thought I'd point you to it. I
honestly can't troubleshoot it.
--
Please remember to indicate when the post is answered so others can benefit
from it later.


"Chris" wrote:

I'm getting a run-time 424 error.

It says "Object required".

When I go to debug, it highlights the Screen.MoustPointer = vbNormal line
down below.

ErrHandler:
SetIt = 0
Screen.MousePointer = vbNormal
Timer1.Interval = 0
Timer1.Enabled = False
MsgBox "The Winsock Connection is Unavailable."
Winsock1.Close

Thanks.

"Queso" wrote:

I found this code at VB-Helper.com which uses a macro to set the system time
by retrieving the correct Atomic time from the NIST site. When they click
the button to clock-in or -out, you can have this code retrieve the current
NIST time first.

Private Sub Command1_Click() 'Main button to set the system
' time
On Error GoTo ErrHandler

Label3.Caption = "System Time has Not been Set Yet"

SetIt = 1 'Used to only set time if the time from the
' time server is valid and reportedly accurate

If Winsock1.State < sckClosing Then 'Sometimes the
' Winsock gets delayed in the closing state, so
' make sure it is closed before trying again
If Winsock1.State = sckClosed Then 'If closed, ok to
' open, else close it
Timer1.Interval = 5000 'Start 5 second count to
' 'time' server
Timer1.Enabled = True
Screen.MousePointer = vbHourglass
Winsock1.LocalPort = 0 'Must be set to 0
Winsock1.RemoteHost = Trim$(Text1.Text) 'Address
' of NIST server
Winsock1.RemotePort = 13 '13, 37 or 123 'Use 13!
Winsock1.Protocol = 0 '1-UDP '0-TCP 'USE TCP!
Winsock1.Connect 'This is what goes out and gets
' the time
Else
Winsock1.Close
Screen.MousePointer = vbNormal
Timer1.Interval = 0
Timer1.Enabled = False
End If
Else
Winsock1.Close
Screen.MousePointer = vbNormal
Timer1.Interval = 0
Timer1.Enabled = False
End If

Exit Sub
ErrHandler:
SetIt = 0
Screen.MousePointer = vbNormal
Timer1.Interval = 0
Timer1.Enabled = False
MsgBox "The Winsock Connection is Unavailable."
Winsock1.Close
End Sub



'The server returns data similar to the following:
'
' 52949 03-11-06 16:23:43 00 0 0 650.2 UTC(NIST) *
'The following code parses this data, uses it to initialize a SYSTIME
structure, and then uses
'the SetSystemTime API function to set the system's time.



Private Sub Winsock1_DataArrival(ByVal bytesTotal As Long) _
'Fires when data is received from server
Dim datDate As Date 'formatted date
Dim strData As String 'time string from net time server
Dim JSys As SYSTEMTIME
Dim RetVal As Integer
Dim Ct As Integer

On Error GoTo ErrHandler

Winsock1.GetData strData, vbString 'get string from
' server
datDate = FormatDateTime(strData) 'go format the new
' string

If msAdj < 0 Then 'if msadj = 0 then do not set an
' offset
datDate = DateAdd("s", -1, datDate) 'only if msadj
' < 0, subtract 1 sec from new time so addition
' of msadj is positive
End If

Label1.Caption = "Before " & Now 'time before adjustment

If SetIt = 1 Then 'If all is ok, set system time

'Initialize SYSTIME with new data
JSys.wYear = Year(datDate)
JSys.wMonth = Month(datDate)
JSys.wDayOfWeek = 0 'DayOfWeek(datDate)'Not used
JSys.wHour = Hour(datDate)
JSys.wMinute = Minute(datDate)
JSys.wSecond = Second(datDate)
JSys.wDay = Day(datDate)

If msAdj = 0 Then
JSys.wMilliseconds = 0 'No millisec offset
Else
JSys.wMilliseconds = ((10000 - msAdj) / 10) 'must
' be positive
End If

'Set system time with new data
Do Until RetVal < 0 Or Ct 9 'Make up to 10
' attempts to set the time
RetVal = SetSystemTime(JSys)
Ct = Ct + 1
Loop

Label2.Caption = "After " & Now 'time after
' adjustment

If RetVal < 0 Then
Label3.Caption = "System Time was Set " & _
"Successfully"
Else
Label3.Caption = "There was an Error in Setting " & _
"Time"
End If

'Display time string that was sent from server
Text2.Text = strData
End If

SetIt = 0
Winsock1.Close
Screen.MousePointer = vbNormal
Timer1.Interval = 0
Timer1.Enabled = False

Exit Sub
ErrHandler:
SetIt = 0
Winsock1.Close
Screen.MousePointer = vbNormal
Timer1.Interval = 0
Timer1.Enabled = False
End Sub


--
Please remember to indicate when the post is answered so others can benefit
from it later.


"Chris" wrote:

I have created a timestamp to track employee times in an excel spreadsheet.
I have everything protected and all they do is click on a button to display
the timestamp in the field chosen.

It works great, however, I realized something yesterday that I did not think
of before. One way they can manipulate their time is to change their system
time from Windows and timestamp a time that is incorrect.

Does anyone know a way around this? Is there a way to timestamp from a
server time or something like that? Please let me know.

Thanks.