frmcheck.frm

一套比较齐全的企业人事考勤系统~~有源代码

VERSION 5.00
Begin VB.Form FrmCheck 
   BorderStyle     =   3  'Fixed Dialog
   Caption         =   "考勤窗口"
   ClientHeight    =   4800
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   4830
   Icon            =   "FrmCheck.frx":0000
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   4800
   ScaleWidth      =   4830
   ShowInTaskbar   =   0   'False
   StartUpPosition =   3  '窗口缺省
   Begin VB.Frame Frame1 
      Caption         =   "员工信息："
      Height          =   4215
      Left            =   240
      TabIndex        =   0
      Top             =   240
      Width           =   4335
      Begin VB.Timer Timer1 
         Left            =   4200
         Top             =   4200
      End
      Begin VB.TextBox Text1 
         Height          =   270
         Index           =   0
         Left            =   1440
         MaxLength       =   8
         TabIndex        =   1
         Top             =   480
         Width           =   2535
      End
      Begin VB.TextBox Text1 
         Enabled         =   0   'False
         Height          =   270
         Index           =   3
         Left            =   1440
         MaxLength       =   8
         TabIndex        =   4
         Top             =   1800
         Width           =   2535
      End
      Begin VB.TextBox Text1 
         Enabled         =   0   'False
         Height          =   270
         Index           =   2
         Left            =   1440
         MaxLength       =   8
         TabIndex        =   3
         Top             =   1320
         Width           =   2535
      End
      Begin VB.TextBox Text1 
         Enabled         =   0   'False
         Height          =   270
         Index           =   1
         Left            =   1440
         MaxLength       =   8
         TabIndex        =   2
         Top             =   960
         Width           =   2535
      End
      Begin VB.Label Label1 
         Alignment       =   2  'Center
         AutoSize        =   -1  'True
         Caption         =   "正常"
         BeginProperty Font 
            Name            =   "宋体"
            Size            =   26.25
            Charset         =   134
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   525
         Left            =   1635
         TabIndex        =   9
         Top             =   2640
         Width           =   1050
      End
      Begin VB.Label Label2 
         Caption         =   "离开时间："
         Height          =   255
         Index           =   3
         Left            =   360
         TabIndex        =   8
         Top             =   1920
         Width           =   975
      End
      Begin VB.Label Label2 
         Caption         =   "进入时间："
         Height          =   255
         Index           =   2
         Left            =   360
         TabIndex        =   7
         Top             =   1440
         Width           =   975
      End
      Begin VB.Label Label2 
         Caption         =   "姓    名："
         Height          =   255
         Index           =   1
         Left            =   360
         TabIndex        =   6
         Top             =   960
         Width           =   975
      End
      Begin VB.Label Label2 
         Caption         =   "编    号："
         Height          =   255
         Index           =   0
         Left            =   360
         TabIndex        =   5
         Top             =   480
         Width           =   975
      End
   End
End
Attribute VB_Name = "FrmCheck"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim Setup_DB, Basic_DB, Check_DB As Database
Dim Setup_TB, Basic_TB, Check_TB As TableDef
Dim Check_RS As Recordset
Dim Work_time(3), Rest_time(3), T_Type As String
Dim T_Rest, T_I As Integer
Dim Work_T As Boolean 'T:工作 F:休息
Private Sub Form_Load()
Set Setup_DB = OpenDatabase(App.Path + "\setup.mdb")
Set Setup_RS = Setup_DB.OpenRecordset("参数设定")
T_Type = Setup_RS.Fields(0)
Work_time(1) = Setup_RS.Fields(1) & ":" & Setup_RS.Fields(2)
Work_time(2) = Setup_RS.Fields(5) & ":" & Setup_RS.Fields(6)
Work_time(3) = Setup_RS.Fields(9) & ":" & Setup_RS.Fields(10)
Rest_time(1) = Setup_RS.Fields(3) & ":" & Setup_RS.Fields(4)
Rest_time(2) = Setup_RS.Fields(7) & ":" & Setup_RS.Fields(8)
Rest_time(3) = Setup_RS.Fields(11) & ":" & Setup_RS.Fields(12)
If Setup_RS.Fields(14) = "-" Then
   Setup_RS.Edit
   Setup_RS.Fields(14) = Date
   Setup_RS.Fields(15) = "1"
   T_Rest = 1
   Setup_RS.Update
End If
T_Rest = (CInt(Setup_RS.Fields(15)) + DateDiff("y", CDate(Setup_RS.Fields(14)), Now)) Mod 4

If Dir(App.Path + "\data\check.mdb") = "" Then
   Set Check_DB = CreateDatabase(App.Path + "\data\check.mdb", dbLangGeneral)
   Set Check_TB = Check_DB.CreateTableDef("考勤总记录表")
   
   Set MyField = Check_TB.CreateField("记录日期", dbText, 25)
   Check_TB.Fields.Append MyField
   Check_DB.TableDefs.Append Check_TB
   Check_DB.Close
   
   GoTo New1
   
Else
   Set Check_DB = OpenDatabase(App.Path + "\data\Check.mdb")
   Set Check_RS = Check_DB.OpenRecordset("考勤总记录表")
   Check_RS.MoveFirst
   Do While Check_RS.EOF = False
      If Year(Check_RS.Fields(0)) = Year(Now) Then
         Exit Do
      End If
      Check_RS.MoveNext
   Loop
   If Check_RS.EOF Then GoTo New1
   Check_RS.MoveFirst
   Do While Check_RS.EOF = False
      If Year(Check_RS.Fields(0)) = Year(Now) And Month(Check_RS.Fields(0)) = Month(Now) Then
         Exit Do
      End If
      Check_RS.MoveNext
   Loop
   If Check_RS.EOF Then GoTo New2
   Check_RS.MoveFirst
   Do While Check_RS.EOF = False
      If Year(Check_RS.Fields(0)) = Year(Now) And Month(Check_RS.Fields(0)) = Month(Now) Then
         Exit Do
      End If
      Check_RS.MoveNext
   Loop
   If Check_RS.EOF Then GoTo New2
   Check_RS.MoveFirst
   Do While Check_RS.EOF = False
      If Year(Check_RS.Fields(0)) = Year(Now) And Month(Check_RS.Fields(0)) = Month(Now) And Day(Check_RS.Fields(0)) = Day(Now) Then
         Exit Do
      End If
      Check_RS.MoveNext
   Loop
   If Check_RS.EOF Then
      Set Check_DB = OpenDatabase(App.Path + "\data\" + CStr(Year(Now)) + "\" + CStr(Month(Now)) + ".mdb")
      GoTo New3
   End If
   Exit Sub
End If

'对记录文件夹初始化
New1: MkDir (App.Path + "\data\" + CStr(Year(Now)))
New2: Set Check_DB = CreateDatabase(App.Path + "\data\" + CStr(Year(Now)) + "\" + CStr(Month(Now)) + ".mdb", dbLangGeneral)
New3: Set Check_TB = Check_DB.CreateTableDef(CStr(Day(Now)))
   
      Set MyField = Check_TB.CreateField("编号", dbText, 25)
      Check_TB.Fields.Append MyField
      Set MyField = Check_TB.CreateField("姓名", dbText, 25)
      Check_TB.Fields.Append MyField
      Set MyField = Check_TB.CreateField("是否进入", dbBoolean)
      Check_TB.Fields.Append MyField
      Set MyField = Check_TB.CreateField("进入时间", dbText, 25)
      Check_TB.Fields.Append MyField
      Set MyField = Check_TB.CreateField("离开时间", dbText, 25)
      Check_TB.Fields.Append MyField
      Set MyField = Check_TB.CreateField("状态", dbText, 25)
      Check_TB.Fields.Append MyField
      Set MyField = Check_TB.CreateField("班次", dbText, 5)
      Check_TB.Fields.Append MyField
      Check_DB.TableDefs.Append Check_TB
      Check_DB.Close
    
      Set Check_DB = OpenDatabase(App.Path + "\data\Check.mdb")
      Set Check_RS = Check_DB.OpenRecordset("考勤总记录表")
      Check_RS.AddNew
      Check_RS.Fields(0) = Date
      Check_RS.Update
      Check_RS.Close
      Check_DB.Close
End Sub

Private Sub Form_Unload(Cancel As Integer)
FrmMain.Show
Me.Hide
FrmMain.ListTools
End Sub

Private Sub Text1_KeyDown(Index As Integer, KeyCode As Integer, Shift As Integer)
If Index = 0 And KeyCode = 13 Then ListData
End Sub
Private Sub ListData()
If Hour(Now) < Hour(Work_time(1)) Or (Hour(Now) = Hour(Work_time(1)) And Minute(Now) < Minute(Work_time(1))) Then
   Work_T = False
Else
   If Hour(Now) < Hour(Rest_time(1)) Or (Hour(Now) = Hour(Rest_time(1)) And Minute(Now) < Minute(Rest_time(1))) Then
      Work_T = True
   Else
      If Hour(Now) < Hour(Work_time(2)) Or (Hour(Now) = Hour(Work_time(2)) And Minute(Now) < Minute(Work_time(2))) Then
         Work_T = False
      Else
         If Hour(Now) < Hour(Rest_time(2)) Or (Hour(Now) = Hour(Rest_time(2)) And Minute(Now) < Minute(Rest_time(2))) Then
            Work_T = True
         Else
            If Hour(Now) < Hour(Work_time(3)) Or (Hour(Now) = Hour(Work_time(3)) And Minute(Now) < Minute(Work_time(3))) Then
               Work_T = False
            Else
               If Hour(Now) < Hour(Rest_time(3)) Or (Hour(Now) = Hour(Rest_time(3)) And Minute(Now) < Minute(Rest_time(3))) Then
                  Work_T = True
               Else
                  Work_T = False
               End If
            End If
         End If
      End If
    End If
End If

Set Check_DB = OpenDatabase(App.Path + "\data\" + CStr(Year(Now)) + "\" + CStr(Month(Now)) + ".mdb")
Set Check_RS = Check_DB.OpenRecordset(CStr(Day(Now)))
If Not Check_RS.EOF Then
   Check_RS.MoveFirst
   Do While Check_RS.EOF = False
      If Check_RS.Fields(0) = Text1(0).Text Then
         Check_RS.Edit
         Text1(1).Text = Check_RS.Fields(1)
         If Check_RS.Fields(2) Then
            Check_RS.Fields(2) = False
            Check_RS.Fields(4) = Time()
            Text1(2).Text = Check_RS.Fields(3)
            Text1(3).Text = Time()
            If Not Work_T Then
               If Check_RS.Fields(5) <> "正常" Then Label1.Caption = Check_RS.Fields(5)
            Else
               If Check_RS.Fields(5) <> "正常" Then
                  Label1.Caption = "迟到早退"
                  Check_RS.Fields(5) = "迟到早退"
               Else
                  Label1.Caption = "早退"
                  Check_RS.Fields(5) = "早退"
               End If
            End If
         Else
            Check_RS.Fields(2) = True
            Check_RS.Fields(3) = Time()
            Check_RS.Fields(4) = "-"
            Text1(2).Text = Time()
            Text1(3).Text = "--:--:--"
            If Not Work_T Then
               Label1.Caption = "正常"
               Check_RS.Fields(5) = "正常"
            Else
               Label1.Caption = "迟到"
               Check_RS.Fields(5) = "迟到"
            End If
          End If
          Check_RS.Update
          Exit Sub
     End If
     Check_RS.MoveNext
   Loop
End If

Set Basic_DB = OpenDatabase(App.Path + "\Basic.mdb")
Set Basic_RS = Basic_DB.OpenRecordset("基本信息")

Basic_RS.MoveFirst
Do While Basic_RS.EOF = False
   If Basic_RS.Fields(1) = Text1(0).Text Then
      Check_RS.AddNew
      Check_RS.Fields(0) = Basic_RS.Fields(1)
      Check_RS.Fields(1) = Basic_RS.Fields(2)
      Check_RS.Fields(2) = True
      Check_RS.Fields(3) = Time()
      Check_RS.Fields(4) = "-"
      Text1(1).Text = Basic_RS.Fields(2)
      Text1(2).Text = Time()
      Text1(3).Text = "--:--:--"
      If T_Type = 1 Then
         If Not Work_T Then
            Label1.Caption = "正常"
            Check_RS.Fields(5) = "正常"
         Else
            Label1.Caption = "迟到"
            Check_RS.Fields(5) = "迟到"
         End If
         Check_RS.Fields(6) = "1"
      Else
         T_I = (T_Rest + CInt(Basic_RS.Fields(13))) Mod 4 + 1
         If T_I = 4 Then
            Text1(1).Text = Check_RS.Fields(1)
            Text1(2).Text = "--:--:--"
            Text1(3).Text = "--:--:--"
            Label1.Caption = "休息"
            Check_RS.Fields(5) = "休息"
            Check_RS.Fields(6) = T_I
            Check_RS.Update
            Exit Sub
         End If
         If Not Work_T Then
            Label1.Caption = "正常"
            Check_RS.Fields(5) = "正常"
         Else
            Label1.Caption = "迟到"
            Check_RS.Fields(5) = "迟到"
         End If
         Check_RS.Fields(6) = T_I
      End If
      Check_RS.Update
      Exit Sub
   End If
   Basic_RS.MoveNext
Loop
For X = 0 To 3
    Text1(X).Text = ""
Next X
Label1.Caption = "无效编号,请重试"
End Sub