form1.frm

用microsoft vb6.0写的上班考勤系统！

      End
      Begin VB.Menu Faka 
         Caption         =   "发卡(&F)"
         Shortcut        =   ^F
      End
      Begin VB.Menu Infomation 
         Caption         =   "员工资料(&Y)"
         Shortcut        =   ^Y
      End
   End
   Begin VB.Menu Moshi 
      Caption         =   "考勤模式设置(&M)"
      Begin VB.Menu SetTime 
         Caption         =   "设置考勤时间(&G)"
         Shortcut        =   ^G
      End
      Begin VB.Menu QingJia 
         Caption         =   "请假(&H)"
         Shortcut        =   ^H
      End
      Begin VB.Menu JiaBan 
         Caption         =   "加班(&J)"
         Shortcut        =   ^J
      End
      Begin VB.Menu HuanBan 
         Caption         =   "个别员工换班(&H)"
      End
      Begin VB.Menu SetShuJu 
         Caption         =   "设置考勤数据"
      End
      Begin VB.Menu SetBumen 
         Caption         =   "设置部门名称"
      End
      Begin VB.Menu SetJiWei 
         Caption         =   "设置职位名称"
      End
      Begin VB.Menu SetHoliday 
         Caption         =   "设置每月休息天数(&D)"
         Shortcut        =   ^D
      End
   End
   Begin VB.Menu Query 
      Caption         =   "查询信息(&Q)"
   End
   Begin VB.Menu Xitong 
      Caption         =   "系统设置(X)"
      Begin VB.Menu UserManage 
         Caption         =   "使用者管理(&C)"
         Shortcut        =   ^C
      End
      Begin VB.Menu Manage 
         Caption         =   "系统管理(&I)"
         Shortcut        =   ^I
      End
   End
   Begin VB.Menu GongZi 
      Caption         =   "工资表"
   End
   Begin VB.Menu Tool 
      Caption         =   "设备设置"
      Enabled         =   0   'False
   End
   Begin VB.Menu BtnPri 
      Caption         =   "打印"
      Begin VB.Menu PriCulb 
         Caption         =   "打印会所"
      End
      Begin VB.Menu PriSwiss 
         Caption         =   "打印(4次)"
      End
   End
   Begin VB.Menu Exit 
      Caption         =   "退出(&E)"
   End
End
Attribute VB_Name = "MainForm"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private record_data As String * 30
'Private record_data_Next As String * 30
Private Dangtian
Dim ST, Wo, TT
Dim Curr, Shijian, ONO
Public NextInfo, Ming, Banhao, BanMingC, DaKaShiJian, BanShiJian, XiaShiJian, BanMing, bumen, GH, CON
Dim T1, T2, XQ, AAA As Date
Dim ChaShiJian
Dim MyDate, MyWeekDay
Dim Riqi
Dim KaCiShu
Dim AA, BB, CC, DD, JW
Dim ShangYiDaKa, XiaYiDaKa As Boolean
Dim XM
Public HaveAdd As Boolean
Dim Yesterday As Date
Dim Shi1, Shi2, Shi3, Shi4, Shi5, Shi6, Shi7, Shi8, Shi9, Shi10, Shi11, Shi12
Public NO, ShiDuan As String
Public BBB
Public CheReadCardNO As Boolean
Private Cnnmain   As ADODB.Connection
Private Rstmain   As ADODB.Recordset
Private Cnnfaka   As ADODB.Connection
Private Rstfaka   As ADODB.Recordset
Private CnnBanci  As ADODB.Connection
Private Rstbanci  As ADODB.Recordset
Private Cnnshuju  As ADODB.Connection
Private RstShuju  As ADODB.Recordset
Private RstCheck  As ADODB.Recordset
Private RstEnd    As ADODB.Recordset
Private Rstkaoqin As ADODB.Recordset
Private RstShuju1 As ADODB.Recordset
Private RstShuju2 As ADODB.Recordset
Private RstShuju3 As ADODB.Recordset
Private RstAdd As ADODB.Recordset
Private Function CheckCardIsSet(ByVal CardNo As String) As Boolean
  Set RstShuju = New ADODB.Recordset
  RstShuju.Open "select * from Cardinfo where cardno='" + NO + "'", Cnnshuju, adOpenStatic, adLockBatchOptimistic, adCmdText
  If Not RstShuju.EOF Then
    CheckCardIsSet = True
  Else
    CheckCardIsSet = False
  End If
End Function
Public Function CheckDaKaToo() As Boolean
  Dim CheckDaKaTime, IfDaKaTime, CheckChaTime
  
  Set RstShuju = New ADODB.Recordset
  RstShuju.Open "select * from kaoqishuju where xingming='" + Ming + "'and riqi='" + Riqi + "' and shijian='" + Shijian + "' ", Cnnshuju, adOpenStatic, adLockBatchOptimistic, adCmdText
  If Not RstShuju.EOF Then
    Exit Function
    RstShuju.Close
    Set RstShuju = Nothing
  End If
  If RstShuju.EOF Then
    
    Set Rstkaoqin = New ADODB.Recordset
    Rstkaoqin.Open "select max(shijian) from kaoqishuju where xingming='" + Ming + "'and riqi='" + Riqi + "'", Cnnshuju, adOpenStatic, adLockBatchOptimistic, adCmdText
    
    If Not Rstkaoqin.EOF Then
      IfDaKaTime = Trim(CDate(Rstkaoqin.Fields(0)))
      'Rstshuju!checkkatoo = 1
      'Rstshuju.UpdateBatch
       CheckDaKaTime = Trim(CDate(Shijian))
       CheckChaTime = DateDiff("N", CheckDaKaTime, IfDaKaTime)
       If CheckChaTime > -30 And CheckChaTime <= 0 Then
           CheckDaKaToo = True
         Else
           CheckDaKaToo = False
       End If
       Exit Function
     End If
     
     If Rstkaoqin.EOF Then
       CheckDaKaToo = False
       Exit Function
    End If
  
   End If
   If CheckDaKaToo = True Then
     If status > 0 Then
               CloseComm (status)
         Else
              MsgBox "关闭串口失败！", vbOKOnly, "提醒！"
     End If
            
   End If
  'ChaShiJian = DateDiff("N", BanShiJian, DaKaShiJian)
End Function
Private Function CheckDaka_Again() As Boolean
  ShiDuan = 0
  Set Rstfaka = New ADODB.Recordset
  Rstfaka.Open "select * from cardinfo  where cardno='" + NO + "'", Cnnfaka, adOpenStatic, adLockBatchOptimistic, adCmdText
  If Not Rstfaka.EOF Then
    Ming = Trim(Rstfaka!xingming)
    Banhao = Trim(Rstfaka!Banhao)
    BanMing = Trim(Rstfaka!BanMing)
  End If
  
  Set RstShuju = New ADODB.Recordset
  RstShuju.Open "select * from Ban where banhao='" + Banhao + "' and banming='" + BanMing + "'", Cnnshuju, adOpenStatic, adLockBatchOptimistic, adCmdText
  If Not RstShuju.EOF Then
    Shi1 = RstShuju.Fields(18)
    Shi2 = RstShuju.Fields(19)
    Shi3 = RstShuju.Fields(20)
    Shi4 = RstShuju.Fields(21)
    Shi5 = RstShuju.Fields(22)
    Shi6 = RstShuju.Fields(23)
    Shi7 = RstShuju.Fields(24)
    Shi8 = RstShuju.Fields(25)
    Shi9 = RstShuju.Fields(26)
    Shi10 = RstShuju.Fields(27)
    Shi11 = RstShuju.Fields(28)
    Shi12 = RstShuju.Fields(29)
    If Shi1 < Shijian And Shi2 > Shijian Then
      Set Rstkaoqin = New ADODB.Recordset
      Rstkaoqin.Open "select  * from kaoqishuju where xingming='" + Ming + "' and riqi='" + Riqi + "'and shiduan=1 ", Cnnshuju, adOpenStatic, adLockBatchOptimistic, adCmdText
      If Rstkaoqin.EOF Then
        CheckDaka_Again = False
        ShiDuan = 1
        
      Else
        CheckDaka_Again = True
        ShiDuan = 9
      End If
      'Exit Sub
    End If
    
    If Shi3 < Shijian And Shi4 > Shijian Then
      Set Rstkaoqin = New ADODB.Recordset
      Rstkaoqin.Open "select  * from kaoqishuju where xingming='" + Ming + "' and riqi='" + Riqi + "' and shiduan=2", Cnnshuju, adOpenStatic, adLockBatchOptimistic, adCmdText
      If Rstkaoqin.EOF Then
        CheckDaka_Again = False
        ShiDuan = 2
      Else
        CheckDaka_Again = True
        ShiDuan = 9
      End If
      'Exit Sub
      
    End If
    
    If Shi5 < Shijian And Shi6 > Shijian Then
      Set Rstkaoqin = New ADODB.Recordset
      Rstkaoqin.Open "select  * from kaoqishuju where xingming='" + Ming + "' and riqi='" + Riqi + "' and shiduan=3", Cnnshuju, adOpenStatic, adLockBatchOptimistic, adCmdText
      If Rstkaoqin.EOF Then
        CheckDaka_Again = False
        ShiDuan = 3
      Else
        CheckDaka_Again = True
        ShiDuan = 9
      End If
      'Exit Sub
      
    End If
    
    If Shi7 < Shijian And Shi8 > Shijian Then
      Set Rstkaoqin = New ADODB.Recordset
      Rstkaoqin.Open "select  * from kaoqishuju where xingming='" + Ming + "' and riqi='" + Riqi + "' and shiduan=4", Cnnshuju, adOpenStatic, adLockBatchOptimistic, adCmdText
      If Rstkaoqin.EOF Then
        CheckDaka_Again = False
        ShiDuan = 4
      Else
        CheckDaka_Again = True
        ShiDuan = 9
      End If
      'Exit Sub
      
    End If
    
    
   'End If
   
    If Shi9 < Shijian And Shi10 > Shijian Then
      Set Rstkaoqin = New ADODB.Recordset
      Rstkaoqin.Open "select  * from kaoqishuju where xingming='" + Ming + "' and riqi='" + Riqi + "' and shiduan=5", Cnnshuju, adOpenStatic, adLockBatchOptimistic, adCmdText
      If Rstkaoqin.EOF Then
        CheckDaka_Again = False
        ShiDuan = 5
      Else
        CheckDaka_Again = True
        ShiDuan = 9
      End If
      'Exit Sub
      
    End If
    
    If Shi11 < Shijian And Shi12 > Shijian Then
      Set Rstkaoqin = New ADODB.Recordset
      Rstkaoqin.Open "select  * from kaoqishuju where xingming='" + Ming + "' and riqi='" + Riqi + "' and shiduan=6", Cnnshuju, adOpenStatic, adLockBatchOptimistic, adCmdText
      If Rstkaoqin.EOF Then
        CheckDaka_Again = False
        ShiDuan = 6
      Else
        CheckDaka_Again = True
        ShiDuan = 9
      End If
      'Exit Sub
      
    End If
    
    
End If
    
    
   

End Function
Private Function CheckMei() As Boolean     '查上午没打卡
  Set Rstmain = New ADODB.Recordset
  Rstmain.Open "select * from kaoqishuju where xingming='" + Ming + "'and ifsxban=1 and riqi='" + Riqi + "' and checkqingjia=0 ", Cnnshuju, adOpenKeyset, adLockOptimistic, adCmdText
  If Not Rstmain.EOF Then
    XiaShiJian = CDate(Rstmain.Fields(4))
    
    Set Rstmain = New ADODB.Recordset
    Rstmain.Open "select * from ban where banhao='" + Banhao + "' and banming='" + BanMingC + "'", Cnnshuju, adOpenStatic, adLockBatchOptimistic, adCmdText
    If Not Rstmain.EOF Then
      DaKaShiJian = Rstmain.Fields(7)
    End If
       ChaShiJian = DateDiff("n", XiaShiJian, DaKaShiJian)
    
    If -5 < ChaShiJian And ChaShiJian < 60 Then
     CheckMei = True
    Else
     CheckMei = False
    End If
  End If
End Function
Private Function IfFour() As Boolean '是否四次打卡
 Set Rstmain = New ADODB.Recordset
 Rstmain.Open "select * from ban where banhao='" + Banhao + "'and banming='" + BanMingC + "'", Cnnshuju, adOpenStatic, adLockBatchOptimistic, adCmdText
  If Not RstShuju.EOF Then
    KaCiShu = Rstmain.Fields(4)
  End If
  
  Set Rstmain = New ADODB.Recordset
  Rstmain.Open "select * from dangtiandaka where xingming='" + Ming + "'and riqi='" + Riqi + "'", Cnnshuju, adOpenStatic, adLockBatchOptimistic, adCmdText
  If Not Rstmain.EOF And KaCiShu = 4 Then
     IfFour = True
  Else
     IfFour = False
  End If

End Function

Private Sub CheckIFLate()
Dim ChiDaoTime, JiaBanTime
  Set RstShuju = New ADODB.Recordset
  RstShuju.Open "select * from chidaotime ", Cnnshuju, adOpenStatic, adLockBatchOptimistic, adCmdText
  If Not RstShuju.EOF Then
    ChiDaoTime = CInt(RstShuju.Fields(0))
  End If
  
  Set RstShuju = New ADODB.Recordset
  RstShuju.Open "select * from jiabantime ", Cnnshuju, adOpenStatic, adLockBatchOptimistic, adCmdText
  If Not RstShuju.EOF Then
   JiaBanTime = CInt(RstShuju.Fields(0))
  End If
  
  Set RstShuju = New ADODB.Recordset
  RstShuju.Open "select * from kaoqishuju where iflate=1 and xingming='" + Ming + "' and riqi='" + Riqi + "' and checkqingjia=0 and shijian='" + Shijian + "'", Cnnshuju, adOpenKeyset, adLockOptimistic, adCmdText
  'If Not Rstshuju.EOF And CheckMei = True Then
  If Not RstShuju.EOF And ShiDuan = 2 Then
    RstShuju!ifsxban = 2
    RstShuju.UpdateBatch
  End If
  
  
  
  '判断上班是否准时
  Set RstShuju = New ADODB.Recordset
  RstShuju.Open "select * from kaoqishuju where xingming='" + Ming + "'and ifsxban=1 and riqi='" + Riqi + "' and checkqingjia=0 and shijian='" + Shijian + "'", Cnnshuju, adOpenKeyset, adLockOptimistic, adCmdText
  If Not RstShuju.EOF Then
    Banhao = Trim(RstShuju.Fields(9))
    BanMingC = Trim(RstShuju.Fields(10))
    DaKaShiJian = CDate(RstShuju.Fields(4))
    
   
    Rstbanci.Close
    Set Rstbanci = New ADODB.Recordset        '从班次的表中提取班号和班名的打卡时间
    Rstbanci.Open "select * from ban where banhao='" + Banhao + "'and banming='" + BanMingC + "' ", CnnBanci, adOpenKeyset, adLockOptimistic, adCmdText
    If ShiDuan = 1 Then
        BanShiJian = CDate(Rstbanci.Fields(5))
    End If
    If ShiDuan = 2 Then
        BanShiJian = CDate(Rstbanci.Fields(7))
    End If
    If ShiDuan = 3 Then
        BanShiJian = CDate(Rstbanci.Fields(9))
    End If
    If ShiDuan = 4 Then
      BanShiJian = CDate(Rstbanci.Fields(11))
    End If
    If ShiDuan = 5 Then
      BanShiJian = CDate(Rstbanci.Fields(13))
    End If
    If ShiDuan = 6 Then
      BanShiJian = CDate(Rstbanci.Fields(15))
    End If