Time on Server

[UncleCake]

Hi,

I built a time clock program for our employees and I used the time on the computer for the time in and outs. The problem is that they are changing the time on the computer and then timing in. I knew this was possible, I just didn't think that they were smart enough to do it.

Therefore, can I get the time from a server on our network where they can't change the time?

-UncleCake

 

[gmmastros]

Never underestimate the ingenuity of deceptive people!

What database are you using to store the info? Instead of sending the time in to database, you can probably get the database to do it for you.

Ex with SQL Server...

Create Procedure StartTimeIn
  @EmployeeId Integer
As
Insert Into EmployeeTime(EmployeeId, StartTime)
Values (@EmployeeId, GetDate())

The GetDate() function returns the servers date and time. If you are using Access, there is probably a similar method.

You could also use the Net Time command. To see it...

Click Start -> run
CMD

Type:
Net Time \\Servername

You could shell out, with a redirect to a file, then open the file and parse the time.

-George

Strong and bitter words indicate a weak cause. - Fortune cookie wisdom

 

[gmmastros]

It just occurred to me!

You could add another field to your database for server time. Then, let the app go as is, but change the stored procedure to update the Server Time field based on the server's time.

Then, you could write some management reports for the variance in times.

Ex.

EmployeeId, TimeIn, TimeOut, ServerTimeIn, ServerTimeOut.

Update the TimeIn and TimeOut based on the users clock, and update ServerTimeIn and ServerTimeOut based on the server's clock.

If you show these values to the user, then show them the TimeIn and TimeOut values.

At the end of a week or 2, you could run a report where the absolute value of the time difference between TimeIn and ServerTimeIn is greater than 10 Minutes.

This report should tell you who is changing their system clocks before logging in.

Of course, they'll say, "I got here at 9:00 AM, but I forgot to punch in until 9:30. I didn't want to get in trouble, so I set the clock on my computer before logging in." I'm not sure how you will handle this, but at least you'll know who's doing it.

-George

Strong and bitter words indicate a weak cause. - Fortune cookie wisdom

 

[UncleCake]

George,

Thanks for the suggestions, but I am using a Pervasive database. What I do now is just inset the time, in or out, in the Pervasive database and then I create the reports from another UI. I do not have access to put a ServerTime stamp in as a field like I could do in Access or SQL Server, which is why I was wondering if I could just get the time from another server on our network.

 

[gmmastros]

In that case, here's some code to get the server's time. I think you'll want to use the ShellAndWait function from this thread thread222-951760.

I have an example for you. There is a form with a text box and a button. Here's the code.

Private Sub Command1_Click()
    
    Dim iFile As Integer
    Dim cTemp As String
    Dim arTemp() As String
    
    Shell "cmd /c net time \\" & Text1.Text & " > """ & App.Path & "\ServerTime.txt"""
    
    iFile = FreeFile
    Open App.Path & "\ServerTime.txt" For Input As #iFile
    Line Input #iFile, cTemp
    Close #iFile
    
    arTemp = Split(cTemp, " ")
        
    cTemp = arTemp(UBound(arTemp) - 1) & " " & arTemp(UBound(arTemp))
    Call MsgBox(cTemp)
    
End Sub

Like I mention before, replace the shell command with the ShellAndWait function.

-George

Strong and bitter words indicate a weak cause. - Fortune cookie wisdom

 

[Creepers]

There are several API's to calls. I will just send you the entire class.

Private Const NWCC_NAME_FORMAT_BIND = 2
Private Const NWCC_OPEN_LICENSED = 1
Private Const NWCC_TRAN_TYPE_WILD = &H8000

Private Declare Function NWCallsInit Lib "calwin32" (reserved1 As Byte, reserved2 As Byte) As Long
Private Declare Function NWCCOpenConnByName Lib "clxwin32" (ByVal startConnHandle As Long, ByVal name As String, ByVal nameFormat As Long, ByVal openState As Long, ByVal tranType As Long, pConnHandle As Long) As Long
Private Declare Function NWGetFileServerDateAndTime Lib "calwin32" (ByVal conn As Long, dateTimeBuffer As Byte) As Long
Private Declare Function NWCCCloseConn Lib "clxwin32" (ByVal connHandle As Long) As Long

Private sServerName As String

Private sServerTime As String
Private sDayOfWeek As String
Private sDate As String

Private Enum Months
JANUARY = 1
FEBRUARY = 2
MARCH = 3
APRIL = 4
MAY = 5
JUNE = 6
JULY = 7
AUGUST = 8
SEPTEMBER = 9
OCTOBER = 10
NOVEMBER = 11
DECEMBER = 12
End Enum

Private retCode As Long
Private connHandle As Long
Private buffer(6) As Byte

Public Property Get GetDayOfWeek() As String
GetDayOfWeek = sDayOfWeek
End Property

Public Property Get GetDate() As String
GetDate = sDate
End Property

Public Property Get GetTime() As String
GetTime = sServerTime
End Property

Public Property Let ServerName(sSrvrName As String)
sServerName = sSrvrName
End Property

Private Sub Class_Initialize()
retCode = NWCallsInit(0, 0)
If retCode <> 0 Then
MsgBox "Error:" + Str$(retCode) + "- NWCallsInit() cannot initialize !", vbCritical
End If
End Sub

Public Sub GetDateAndTime()

Dim sYear As String
Dim sMonth As String
Dim sDayOfMonth As String
Const YEAR_OFFSET As Integer = 1900


' NWGetFileServerDateAndTime
'=======================================
' Byte Value Range =
'=======================================
' 0 Year 80 through 179, (80-99 = 1980-1999) (100-179 = 2000-2079)
' 1 Month 1 through 12
' 2 Day 1 through 31
' 3 Hour 0 through 23 (0 = 12 midnight; 23 = 11 PM)
' 4 Minute 0 through 59
' 5 Second 0 through 59
' 6 Day of Week 0 through 6, 0=Sunday


retCode = NWCCOpenConnByName(0, sServerName, NWCC_NAME_FORMAT_BIND, NWCC_OPEN_LICENSED, NWCC_TRAN_TYPE_WILD, connHandle)

If connHandle <> -1 Then
retCode = NWGetFileServerDateAndTime(connHandle, buffer(0))
If retCode = 0 Then ' Zero equals success

sYear = Str$(buffer(0)) ' 80 - 99 = 1980 - 1999, 100 - 179 = 2000 - 2079

sMonth = Str$(buffer(1)) ' 1 - 12
'sMonth = GetAbbreviatedMonth(sMonth)

sDayOfMonth = Str$(buffer(2)) ' 1 - 31
sDayOfMonth = Replace(sDayOfMonth, " ", vbNullString)

sDayOfWeek = Format$(Int(Str$(buffer(6)) + 1)) ' 0 - 6, 0 = Sunday
sDayOfWeek = GetDayVerbiage(sDayOfWeek)

'sDate = sDayOfMonth & "-" & sMonth & "-" & Format$(Int(YEAR_OFFSET + Int(sYear)))
sDate = LTrim(sMonth & "/" & sDayOfMonth & "/" & Format$(Int(YEAR_OFFSET + Int(sYear))))

sServerTime = CDate(Str$(buffer(3)) & ":" & Str$(buffer(4)) & ":" & Str$(buffer(5)))
Else
sDate = "Error"
sServerTime = "Error"
sDayOfWeek = "Error"
End If
End If
End Sub

Private Function GetAbbreviatedMonth(sMonth As String) As String
Const JANUARY As String = "JAN"
Const FEBRUARY As String = "FEB"
Const MARCH As String = "MAR"
Const APRIL As String = "APR"
Const MAY As String = "MAY"
Const JUNE As String = "JUN"
Const JULY As String = "JUL"
Const AUGUST As String = "AUG"
Const SEPTEMBER As String = "SEP"
Const OCTOBER As String = "OCT"
Const NOVEMBER As String = "NOV"
Const DECEMBER As String = "DEV"



On Error GoTo GetAbbreviatedMonthErrHandler
sMonth = Replace$(sMonth, " ", vbNullString)
Select Case Int(sMonth)

Case Months.JANUARY
GetAbbreviatedMonth = JANUARY

Case Months.FEBRUARY
GetAbbreviatedMonth = FEBRUARY

Case Months.MARCH
GetAbbreviatedMonth = MARCH

Case Months.APRIL
GetAbbreviatedMonth = APRIL

Case Months.MAY
GetAbbreviatedMonth = MAY

Case Months.JUNE
GetAbbreviatedMonth = JUNE

Case Months.JULY
GetAbbreviatedMonth = JULY

Case Months.AUGUST
GetAbbreviatedMonth = AUGUST

Case Months.SEPTEMBER
GetAbbreviatedMonth = SEPTEMBER

Case Months.OCTOBER
GetAbbreviatedMonth = OCTOBER

Case Months.NOVEMBER
GetAbbreviatedMonth = NOVEMBER

Case Months.DECEMBER
GetAbbreviatedMonth = DECEMBER

Case Else
GetAbbreviatedMonth = "Error"

End Select

GetAbbreviatedMonthExitPoint:
On Error Resume Next
Exit Function

GetAbbreviatedMonthErrHandler:
GetAbbreviatedMonth = vbNullString
Select Case Err.Number

Case Else
MsgBox "An error occured in GetAbbreviatedMonth"

End Select


Resume GetAbbreviatedMonthExitPoint

End Function

Private Function GetDayVerbiage(sDay As String) As String
Const SUNDAY As String = "Sunday"
Const MONDAY As String = "Monday"
Const TUESDAY As String = "Tuesday"
Const WEDNESDAY As String = "Wednesday"
Const THURSDAY As String = "Thursday"
Const FRIDAY As String = "Friday"
Const SATURDAY As String = "Saturday"


Select Case Int(sDay)
Case vbSunday
GetDayVerbiage = SUNDAY

Case vbMonday
GetDayVerbiage = MONDAY

Case vbTuesday
GetDayVerbiage = TUESDAY

Case vbWednesday
GetDayVerbiage = WEDNESDAY

Case vbThursday
GetDayVerbiage = THURSDAY

Case vbFriday
GetDayVerbiage = FRIDAY

Case vbSaturday
GetDayVerbiage = SATURDAY

Case Else
GetDayVerbiage = "Error"

End Select
End Function

Private Sub Class_Terminate()

If connHandle <> -1 Then
retCode = NWCCCloseConn(connHandle)
End If
End Sub

 

[chiph]

Also see faq222-1065

Chip H.


____________________________________________________________________
If you want to get the best response to a question, please read FAQ222-2244 first

 

[dilettante]

Lots of ways one might skin this cat.

If you have a Windows server you trust to have the current time though you can just use the NetRemoteTOD() API call:

frmTOD.frm

Option Explicit

'Fetch and display Net Remote Time Of Day from a
'remote Windows system.  Supply a UNC hostname
'(or a DNS name), or empty string for the local
'host's time and date.
'
'Form has 3 controls:
'
'   txtServer   TextBox
'   cmdGetTime  CommandButton
'   lblTime     Label

Private Const NERR_SUCCESS As Long = 0

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 Function NetApiBufferFree Lib "netapi32" _
  (ByVal lpBuffer As Long) As Long

Private Declare Function NetRemoteTOD Lib "netapi32" _
  (UncServerName As Byte, _
   BufferPtr As Long) As Long

Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" _
  (pTo As Any, _
   uFrom As Any, _
   ByVal lSize As Long)

Private Function GetTOD(ByVal Server As String) As Date
    Dim bytServer() As Byte
    Dim lngBufPtr As Long
    Dim todReturned As TIME_OF_DAY_INFO
    
    bytServer = Trim$(Server) & vbNullChar
    If NetRemoteTOD(bytServer(0), lngBufPtr) = NERR_SUCCESS Then
        CopyMemory todReturned, ByVal lngBufPtr, LenB(todReturned)
        NetApiBufferFree lngBufPtr
        With todReturned
            GetTOD = DateAdd("n", _
                             -.tod_timezone, _
                             DateSerial(.tod_year, .tod_month, .tod_day) _
                           + TimeSerial(.tod_hours, .tod_mins, .tod_secs))
        End With
    Else
        Err.Raise vbObjectError + 2000, _
                  "GetTOD", _
                  "Failed to obtain server time"
    End If
End Function

Private Sub cmdGetTime_Click()
    Dim dtServerTime As Date
    
    On Error Resume Next
    dtServerTime = GetTOD(txtServer.Text)
    If Err.Number <> 0 Then
        lblTime.Caption = Err.Description
    Else
        lblTime.Caption = CStr(dtServerTime)
    End If
    On Error GoTo 0
    txtServer.SetFocus
End Sub

I tested it on Windows XP and it even returns the time from Windows 95 machines on my network just fine. I haven't tried running this sample program on Windows 95 though yet.

 

[dilettante]

I suppose I should add that in most cases you'll want to use a UNC name like "\\SomeServer" rather than a DNS name.

 

[dilettante]

Also...

Nope, this doesn't work on a Windows 9x client. See INFO: Windows 95 Support for Net Function Calls.

 

[dglienna]

Just use the

NET TIME \\server /SET

and then enter the time into the DB.
It will update the time on the pc.

-David
2006 Microsoft Valueable Professional (MVP)