Prikazi cijelu temu 20.11.2018 23:05
zxz Van mreze
Administrator
Registrovan od:03.02.2009
Lokacija:Tuzla


Predmet:Re: Baza za kontrolu pristupa!
Uf ja ovo bio zaboravio.
Izvinjavam se.
Evo kod:
PreuzmiIzvorni kôd (Visual Basic):
  1. Function Pokreni()
  2. KUpis 1
  3. End Function
  4. Function KUpis(UserId As Integer)
  5. Dim SQL(2) As String
  6. Dim Rs(2) As DAO.Recordset
  7. Dim Db As DAO.Database
  8. Dim Dat(3) As Date
  9. Dim Id(2) As Integer
  10. Dim DatStr(3) As String
  11. Dim Upisani As String
  12. Dim Zagrada As String
  13.  
  14. Call Tabela
  15. Set Db = CurrentDb
  16. SQL(0) = "SELECT * FROM UlazIzlaz"
  17. Set Rs(0) = Db.OpenRecordset(SQL(0))
  18. SQL(1) = "SELECT UserId, CheckTime FROM CHECKINOUT WHERE UserId=" & UserId & " AND CheckType='i' ORDER BY CheckTime"
  19. Set Rs(1) = Db.OpenRecordset(SQL(1))
  20.  
  21. Do While Not Rs(1).EOF
  22. Dat(1) = Rs(1)!CheckTime
  23. Id(1) = Rs(1)!UserId
  24. If Err.Number = 3021 Then
  25. Id(2) = 0
  26. Err.Clear
  27. On Error GoTo 0
  28. End If
  29.  
  30. If Dat(0) < Dat(1) Then
  31. Dat(0) = Dat(1) + TimeValue("00:05:00")
  32. Dat(3) = Dat(1) + 1
  33. DatStr(1) = "#" & Format(Dat(1), "mm-dd-yy HH:mm") & "#"
  34. DatStr(3) = "#" & Format(Dat(3), "mm-dd-yy HH:mm") & "#"
  35.  
  36. SQL(2) = "SELECT UserId, CheckTime FROM CHECKINOUT WHERE  CheckType='o' " & Upisani & Zagrada & " AND (CheckTime Between " & DatStr(1) & " AND " & DatStr(3) & ") ORDER BY CheckTime"
  37. Set Rs(2) = Db.OpenRecordset(SQL(2))
  38. Forms!F.T = SQL(2)
  39. Rs(0).AddNew
  40.     If Rs(2).RecordCount > 0 Then
  41.     Dat(2) = Rs(2)!CheckTime
  42.     DatStr(0) = "#" & Format(Dat(2), "mm-dd-yy HH:mm:ss") & "#"
  43.         If Upisani <> "" Then
  44.         Upisani = Upisani & "," & DatStr(0)
  45.         Else
  46.         Upisani = "and CheckTime Not in (" & DatStr(0)
  47.         Zagrada = ")"
  48.         End If
  49.     Rs(0)!Izlaz = Dat(2)
  50.     Rs(2).Close
  51.     End If
  52. Rs(0)!UserId = Id(1)
  53. Rs(0)!Ulaz = Dat(1)
  54. Rs(0).Update
  55. End If
  56. Rs(1).MoveNext
  57. Loop
  58.  
  59. Rs(1).Close
  60. Rs(0).Close
  61. Set Db = Nothing
  62. End Function
  63. Function Tabela()
  64. Dim Db As DAO.Database
  65. Dim tdf As DAO.TableDef
  66.  
  67. Set Db = CurrentDb()
  68.  
  69. For Each tdf In Db.TableDefs
  70. If tdf.Name = "UlazIzlaz" Then
  71. DoCmd.DeleteObject acTable, tdf.Name
  72. Exit For
  73. End If
  74. Next tdf
  75.         Db.Execute "CREATE TABLE UlazIzlaz " _
  76.             & "(id counter, UserID Number,ulaz DateTime,izlaz DateTime);"
  77. End Function
Podrska samo putem foruma, jer samo tako i ostali imaju koristi od toga.