frmmdi.frm

指纹考勤管理系统

VERSION 5.00
Object = "{6B7E6392-850A-101B-AFC0-4210102A8DA7}#1.3#0"; "COMCTL32.OCX"
Begin VB.MDIForm frmMDI 
   BackColor       =   &H00808000&
   Caption         =   "考勤系统"
   ClientHeight    =   8310
   ClientLeft      =   165
   ClientTop       =   450
   ClientWidth     =   11400
   Icon            =   "frmMDI.frx":0000
   LinkTopic       =   "MDIForm1"
   Picture         =   "frmMDI.frx":030A
   StartUpPosition =   2  '屏幕中心
   WhatsThisHelp   =   -1  'True
   WindowState     =   2  'Maximized
   Begin ComctlLib.ImageList imlToolbarIcons 
      Left            =   7560
      Top             =   480
      _ExtentX        =   1005
      _ExtentY        =   1005
      BackColor       =   -2147483643
      ImageWidth      =   42
      ImageHeight     =   38
      MaskColor       =   12632256
      _Version        =   327682
      BeginProperty Images {0713E8C2-850A-101B-AFC0-4210102A8DA7} 
         NumListImages   =   3
         BeginProperty ListImage1 {0713E8C3-850A-101B-AFC0-4210102A8DA7} 
            Picture         =   "frmMDI.frx":24034E
            Key             =   ""
         EndProperty
         BeginProperty ListImage2 {0713E8C3-850A-101B-AFC0-4210102A8DA7} 
            Picture         =   "frmMDI.frx":2416A0
            Key             =   ""
         EndProperty
         BeginProperty ListImage3 {0713E8C3-850A-101B-AFC0-4210102A8DA7} 
            Picture         =   "frmMDI.frx":2429F2
            Key             =   ""
         EndProperty
      EndProperty
   End
   Begin VB.Menu mnuFile 
      Caption         =   "文件(&F)"
      Begin VB.Menu mnuFileReg 
         Caption         =   "登录(&L)..."
      End
      Begin VB.Menu mnuFileBar1 
         Caption         =   "-"
      End
      Begin VB.Menu mnuFileExit 
         Caption         =   "退出(&X)"
      End
   End
   Begin VB.Menu mnuEdit 
      Caption         =   "编辑(&E)"
      Visible         =   0   'False
      Begin VB.Menu mnuEditCut 
         Caption         =   "剪切(&T)"
         Shortcut        =   ^X
      End
      Begin VB.Menu mnuEditCopy 
         Caption         =   "复制(&C)"
         Shortcut        =   ^C
      End
      Begin VB.Menu mnuEditPaste 
         Caption         =   "粘贴(&P)"
         Shortcut        =   ^V
      End
   End
   Begin VB.Menu mnuApp 
      Caption         =   "应用(&A)"
      Begin VB.Menu mnuAppCollection 
         Caption         =   "指纹数据采集(&C)..."
      End
      Begin VB.Menu mnuAppKQFX 
         Caption         =   "考勤分析(&F)"
      End
      Begin VB.Menu mnuAppBar1 
         Caption         =   "-"
      End
      Begin VB.Menu mnuAppDefine 
         Caption         =   "班次定义(&D)..."
      End
      Begin VB.Menu mnuAppPlan 
         Caption         =   "日常排班(&P)..."
      End
      Begin VB.Menu mnuAppcx 
         Caption         =   "考勤查询..."
      End
   End
   Begin VB.Menu mnuGuard 
      Caption         =   "数据管理(&G)"
      Begin VB.Menu mnuGuardBase 
         Caption         =   "基本数据管理(&B)..."
      End
      Begin VB.Menu mnuGuardEmployee 
         Caption         =   "员工管理(&E)..."
      End
      Begin VB.Menu mnuGuardZW 
         Caption         =   "员工指纹对应(&E)..."
      End
      Begin VB.Menu mnuGuardBeifen 
         Caption         =   "数据管理"
      End
   End
   Begin VB.Menu mnuRep 
      Caption         =   "报表中心(&R)"
      Begin VB.Menu mnuRepShift 
         Caption         =   "班次表(&S)..."
         Visible         =   0   'False
      End
      Begin VB.Menu mnuRepPlan 
         Caption         =   "排班表(&P)..."
         Visible         =   0   'False
      End
      Begin VB.Menu mnuRepDyn 
         Caption         =   "日动态考勤报表(&D)"
      End
      Begin VB.Menu mnuRepBar1 
         Caption         =   "-"
      End
      Begin VB.Menu mnuRepKQ 
         Caption         =   "考勤明细报表(&K)..."
      End
   End
End
Attribute VB_Name = "frmMDI"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Const MDIMsg1 = "您确定要退出本系统吗?"
Const mStrCollection = "打卡数据采集"
Const mStrLeave = "请假登记"
Const mstrAbsent = "其他缺席登记"
Const mMsg2 = "抱歉,您的权限不够操作该模块!!!"

Const mClose = 5

Const mstbDate = 1
Const mstbTime = 2
Const mstbOperator = 3
Const mstbLevel = 4
Const mstbMsg = 5

Dim misStart As Boolean

Private Sub MDIForm_Load()
    Dim connstr As String
  '  connstr = "Provider=MSDASQL.1;Persist Security Info=False;User ID=sa;Data Source=kqgl;Initial Catalog=kqgl"
    connstr = "Provider=MSDASQL.1;Password=bohao;Persist Security Info=True;User ID=bohao;Data Source=kqgl;Initial Catalog=kqgl"
    conn.Open connstr
    Me.WindowState = 2
    misStart = True
End Sub

Private Sub mnuAppCollection_Click()
 '   frmProg.Show 1

    Dim rscj As New ADODB.Recordset
    Dim rsls As New ADODB.Recordset

'    frmProg.ProgressBar1.Value = 0
        
    Dim rcount As Long
    Sql = "select * from 员工考勤记录"
    rscj.Open Sql, conn, adOpenKeyset, adLockPessimistic
    
    If rscj.RecordCount <> 0 Then
    
        rcount = rscj.RecordCount
  '      frmProg.ProgressBar1.Max = rcount
        rscj.MoveFirst
        Dim i As Integer
        For i = 0 To rscj.RecordCount - 1
'            frmProg.ProgressBar1.Value = i
            
            Dim yggh As Long
            Dim pb As String
            Dim kqsj As Date
            
            If Format(rscj.Fields("考勤时间"), "hh:mm:ss") < "16:00:00" Then
                pb = "a" & Day(rscj.Fields("考勤时间"))
            Else
                pb = "p" & Day(rscj.Fields("考勤时间"))
            End If
            
            kqsj = Format(rscj.Fields("考勤时间"), "hh:mm:ss")
            If rsls.State Then
            rsls.Close
            End If
        
            Sql = "select * from 指纹工号对应表 where 指纹号='" & rscj.Fields("指纹号") & "'"
            rsls.Open Sql, conn
            If IsNull(rsls.Fields("工号")) Or rsls.EOF = True Then
                rsls.Close
            Else
                yggh = rsls.Fields("工号")
                rsls.Close
                
                Sql = "select * from 排班 where 工号='" & yggh & "'"
                rsls.Open Sql, conn
                
                If rsls.EOF = False Then
                
                    Dim bc As String
                    If IsNull(rsls.Fields(pb)) Then
                        bc = ""
                    Else
                        bc = rsls.Fields(pb)
                    End If
                    
                    rsls.Close
                    If Trim(bc) < 37 Then
                             
                        Sql = "select * from 班次 where 段号='" & bc & "'"
                        rsls.Open Sql, conn
                        Dim sbtime As Date
                        Dim xbtime As Date
                        Dim zt As String
                        sbtime = Format(rsls("上班时间"), "hh:mm:ss")
                        xbtime = Format(rsls("下班时间"), "hh:mm:ss")
                        rsls.Close
                        
                        If kqsj < sbtime + 0.083 And kqsj > sbtime - 0.083 Then