frmprint.frm

VB写的通过串口与考勤机连接通讯的程序

       .Refresh
    End With
   If lNum > 0 Then
   cmdPrint.Enabled = True
   End If
   ChkModify.Visible = False
   cmdModify.Value = False
   Frame2.Visible = False
   Exit Sub
End If


'考勤

If OptKaoQin.Value = True Then
    If chkKaoQinName.Value = 1 Then
       Set adoRs = adoCon.Execute("exec QingName_proc '" & Trim(cobKaoQinName) & "'")
      If Not adoRs.EOF Then
       sCardID = " KaoQin.CardID like '" & Trim(adoRs!CardID) & "'"
      Else
       sCardID = " kaoQin.CardID like '%' "
      End If
    Else
       sCardID = " kaoQin.CardID like '%' "
    End If
    

    If chkKaoQinType.Value = 1 Then
       
       sType = "KaoQin.Type like '%" & Trim(cobKaoQinType.Text) & "%'"
    Else
       sType = "KaoQin.Type like '%'"
    End If
    If chkKaoQinDate.Value = 1 Then
       sDate = "KaoQin.Date between '" & Format(DTKaoQinStart, "yyyy-mm-dd") & "' and '" & Format(DTKaoQinEnd, "yyyy-mm-dd") & "'"
       StarDay = DTKaoQinStart.Value
       EndDay = DTKaoQinEnd.Value
    Else
       sDate = "KaoQin.Date like '%'"
       Set adoTemp = adoCon.Execute("select min(date)as Sday ,max(date)as Eday  from kaoqin")
       If adoTemp.EOF Then
          MsgBox "没有考勤记录，请与管理员联系", vbOKOnly + vbCritical, "系统提示"
          Exit Sub
       Else
          StarDay = adoTemp!sDay
          EndDay = adoTemp!Eday
       End If
    End If
    If OptPName.Value = True Then
       PaiXu = " order by Name,Date,Type"
    Else
       PaiXu = " order by Date,Name ,Type"
    End If
    
    
    SQL = "select Worker.Name as 姓名 ,KaoQin.CardID as 卡号,"
    SQL = SQL + " KaoQin.Date as 日期,KaoQin.Hour as 时,KaoQin.Minute as 分,"
    SQL = SQL + "KaoQin.Type as 类别,KaoQin.KaoQinID as ID"
    Whstr = " from KaoQin join Worker on Worker.CardID=KaoQin.CardID "
    Whstr = Whstr + " where "
    Whstr = Whstr + sCardID + " and " + sType + " and "
    Whstr = Whstr + sDate + PaiXu
    SqlPrint = " select Worker.Name  ,KaoQin.CardID ,"
    SqlPrint = SqlPrint + " KaoQin.Date ,KaoQin.Hour ,KaoQin.Minute ,"
    SqlPrint = SqlPrint + "KaoQin.Second,KaoQin.Type  "

   adoCon.Execute ("delete from KaoQin_temp")
   adoCon.Execute ("insert into KaoQin_temp(Name,CardID,Date,Hour,Minute,Second,Type) " + SqlPrint + Whstr)
   adoCon.Execute ("update KaoQin_temp set Stday='" & Trim(StarDay) & "',Enday='" & Trim(EndDay) & "'where CardID<>'0000'")
    With AdoFind
       .ConnectionString = RtnStr
       .RecordSource = SQL + Whstr
       .Refresh
    End With
    If lNum > 0 Then
    cmdPrint.Enabled = True
    End If
    If lNum = 2 Then
    ChkModify.Visible = True
    cmdModify.Visible = True
    End If
    
  
    Exit Sub
End If
'原始数据
If OptSource.Value = True Then
    If chkKaoQinName.Value = 1 Then
       Set adoRs = adoCon.Execute("exec QingName_proc '" & Trim(cobKaoQinName) & "'")
      If Not adoRs.EOF Then
       sCardID = " KaoQinSource.CardID like '" & Trim(adoRs!CardID) & "'"
      Else
       sCardID = " KaoQinSource.CardID like '%' "
      End If
    Else
       sCardID = " KaoQinSource.CardID like '%' "
    End If
    

    If chkKaoQinDate.Value = 1 Then
       sDate = "KaoQinSource.Date between '" & Format(DTKaoQinStart, "yyyy-mm-dd") & "' and '" & Format(DTKaoQinEnd, "yyyy-mm-dd") & "'"
       StarDay = DTKaoQinStart.Value
       EndDay = DTKaoQinEnd.Value
    Else
       sDate = "KaoQinsource.Date like '%'"
       Set adoTemp = adoCon.Execute("select min(date)as Sday ,max(date)as Eday  from kaoqinsource")
       If adoTemp.EOF Then
          MsgBox "没有考勤记录，请与管理员联系", vbOKOnly + vbCritical, "系统提示"
          Exit Sub
       Else
          StarDay = adoTemp!sDay
          EndDay = adoTemp!Eday
       End If
    End If
    If OptPName.Value = True Then
       PaiXu = " order by Name,Date"
    Else
       PaiXu = " order by Date,Name"
    End If
    SQL = "select Worker.Name as 姓名 ,KaoQinSource.CardID as 卡号,"
    SQL = SQL + " KaoQinSource.Date as 日期,KaoQinSource.Hour as 时,KaoQinSource.Minute as 分,KaoQinSource.Second as 秒"
    Whstr = " from KaoQinSource join Worker on Worker.CardID=kaoQinSource.CardID "
    Whstr = Whstr + " where "
    Whstr = Whstr + sCardID + " and "
    Whstr = Whstr + sDate + PaiXu
    SqlPrint = " select Worker.Name  ,kaoQinSource.CardID ,"
    SqlPrint = SqlPrint + " kaoQinSource.Date ,kaoQinSource.Hour ,kaoQinSource.Minute ,"
    SqlPrint = SqlPrint + "kaoQinSource.Second,kaoQinSource.Type  "

   adoCon.Execute ("delete from KaoQin_temp")
   adoCon.Execute ("insert into KaoQin_temp(Name,CardID,Date,Hour,Minute,Second,Type) " + SqlPrint + Whstr)
   adoCon.Execute ("update KaoQin_temp set Stday='" & Trim(StarDay) & "',Enday='" & Trim(EndDay) & "'where CardID<>'0000'")
    
    
    With AdoFind
       .ConnectionString = RtnStr
       .RecordSource = SQL + Whstr
       .Refresh
    End With
     If lNum > 0 Then
    cmdPrint.Enabled = True
    End If
  
  
   ChkModify.Visible = False
   cmdModify.Visible = False
   Frame2.Visible = False
   Exit Sub
End If
ErrMsg:
 If Err.Number > 0 Then
    MsgBox "请与管理员联系！", vbOKOnly + vbCritical, "系统提示"
    Exit Sub
 End If

End Sub


Private Sub KaoQinNew()
Set adoRs = adoCon.Execute("select Name from Worker")


With cobKaoQinName
    .Clear
    .AddItem ""
  If Not adoRs.EOF Then
     Do While Not adoRs.EOF
        .AddItem adoRs!Name
        adoRs.MoveNext
     Loop
  End If
   .ListIndex = 0
End With
DTKaoQinStart.Value = Format(Now, "yyyy-mm-dd")
DTKaoQinEnd.Value = Format(Now, "yyyy-mm-dd")
With cobKaoQinType
   .Clear
   .AddItem "请假"
   .AddItem "迟到"
   .AddItem "早退"
   .AddItem "加班"
   .AddItem "旷勤"
   .AddItem "节日加班"
   .AddItem "出差"
End With
cobKaoQinType.BackColor = &H80000004
cobKaoQinName.BackColor = &H80000004
OptPName.Value = True
OptKaoQin.Value = True
cmdChu.Enabled = False
Frame2.Visible = False
cmdModify.Enabled = False

End Sub





Private Sub cmdMo_Click()
On Error GoTo ErrMsg
ErrMsg:
If ISID <> "" Then
If MsgBox("是否要修改次条记录？", vbYesNo, "修改提示") = vbYes Then
     Set adoRs = adoCon.Execute("select CardID from Worker where Name='" & Trim(txtmoName.Text) & "'")
     adoCon.Execute ("update Kaoqin set CardID='" & Trim(adoRs!CardID) & "',Date='" & Trim(DTMo.Value) & "',Type='" & Trim(txtMoType.Text) & "' where KaoQinID='" & Trim(ISID) & "'")
     MsgBox "修改成功！", vbOKOnly, "系统提示"
     cmdFind_Click
End If
End If
If Err.Number > 0 Then
   MsgBox "修改有误！", vbOKOnly + vbExclamation, "系统提示"
   Exit Sub
End If
End Sub

Private Sub cmdMOdify_Click()
If ChkModify.Value = 1 Then
Frame2.Enabled = True
Frame2.Visible = True
End If
End Sub

Private Sub Command5_Click()
  
  For I = 1 To 100
  sCardID = Int(5! * Rnd())
  sDate = "2002-" + CStr(Int(1! * Rnd()) + 1) + "-" + CStr(Int(27! * Rnd()) + 1)
  sHour = Int(11! * Rnd() + 1)
  sMinute = Int(60! * Rnd())
  sSecond = Int(60! * Rnd())
  Select Case sHour
  Case 8, 9
   sType = "迟到"
  Case 10, 12, 13
   sType = "出差"
  Case 14, 15
    sType = "旷勤"
  Case 16, 17
    sType = "早退"
  Case 18, 19, 20, 21, 22, 23, 24
    sType = "加班"
    Case 0, 1, 2, 3, 4, 5, 6, 7
    sType = "正常"
  End Select
     adoCon.Execute ("insert into Kaoqinsource values('" & sCardID & "','" & sDate & "','" & sHour & "','" & sMinute & "','" & sSecond & "','" & sType & "')")
  Next
End Sub









Private Sub cmdPrint_Click()
If OptKaoQin.Value = True Then
   
   CrystalReport1.ReportFileName = App.Path & "\KaoQin.rpt"
   CrystalReport1.RetrieveDataFiles
   CrystalReport1.Action = 1
   
   
ElseIf OptBaoBiao.Value = True Then
   CrystalReport1.ReportFileName = App.Path & "\print.rpt"
   CrystalReport1.RetrieveDataFiles
   CrystalReport1.Action = 1

Else
   CrystalReport1.ReportFileName = App.Path & "\KaoQinSource.rpt"
   CrystalReport1.RetrieveDataFiles
   CrystalReport1.Action = 1
End If
End Sub








Private Sub Command1_Click()
If DataEnvironment1.Connection1.State = adStateOpen Then
   DataEnvironment1.Connection1.Close
End If
DataEnvironment1.Connection1.Open
DataEnvironment1.Command1
DataReport1.Show
End Sub

Private Sub DateGRL_Click()
On Error GoTo ErrMsg
ErrMsg:
  If ChkModify.Visible = True And cmdModify.Visible = True And ChkModify.Value = 1 Then
     DateGRL.Col = 6
     ISID = DateGRL.Text
     Set adoRs = adoCon.Execute("select Worker.Name ,KaoQin.Date,KaoQin.Type from KaoQin join Worker on KaoQin.CardID=Worker.CardID where KaoQinID='" & Trim(ISID) & "'")
     txtmoName.Text = adoRs!Name
     txtMoType.Text = adoRs!Type
     DTMo.Value = adoRs!Date
  
  
  
  
  End If

 If Err.Number > 0 Then
    MsgBox "没有选记录", vbOKOnly + vbExclamation, "系统提示"
    Exit Sub
 End If
End Sub

Private Sub DTKaoQinStart_Change()
If OptBaoBiao.Value = True Then
Dim sMonth, sYear As String
 sMonth = Month(DTKaoQinStart.Value) + 1
 sYear = Year(DTKaoQinStart.Value)
 If sMonth > 12 Then
    sMonth = sMonth - 12
    sYear = sYear + 1
 End If
 sYear = CStr(sYear) + "-" + CStr(sMonth) + "-1"
 DTKaoQinEnd.Value = CDate(sYear) - 1
 End If
End Sub

Private Sub Form_Load()
 Select Case lNum
   Case 0
    cmdChu.Enabled = False
    chkChu.Enabled = False
    ChkModify.Visible = False
    cmdModify.Visible = False
    cmdAdd.Enabled = False
    cmdDel.Enabled = False
    cmdMo.Enabled = False
    cmdCancel.Enabled = False
   Case 1
    cmdChu.Visible = False
    chkChu.Visible = False
    ChkModify.Visible = False
    cmdModify.Visible = False
    cmdAdd.Enabled = False
    cmdDel.Enabled = False
    cmdMo.Enabled = False
    cmdCancel.Enabled = False
   Case 2
   ChkModify.Visible = True
   cmdModify.Visible = True
   End Select
Me.Move (Screen.Width - Me.Width) / 2, (Screen.Height - Me.Height) / 2 - 900
Call KaoQinNew
DTKaoQinStart.Enabled = False
DTKaoQinEnd.Enabled = False
cobKaoQinName.Enabled = False
cobKaoQinType.Enabled = False
cmdPrint.Enabled = False
txtDate.Text = Format(Now, "yyyy-mm-dd")
'txtDate.Text = Date$
txtTime.Text = Time$
ChuShi = True

End Sub






Private Sub OptBaoBiao_Click()
 
 Dim sMonth, sYear As String
 sMonth = Month(Now) + 1
 sYear = Year(Now)
 If sMonth > 12 Then
    sMonth = sMonth - 12
    sYear = sYear + 1
 End If
 sYear = CStr(sYear) + "-" + CStr(sMonth) + "-1"
  chkKaoQinDate.Value = 1
  DTKaoQinStart.Enabled = True
 DTKaoQinEnd.Enabled = True
 DTKaoQinStart.Value = CStr(Year(Now)) + "-" + CStr(Month(Now)) + "-1"
 DTKaoQinEnd.Value = CDate(sYear) - 1


End Sub

Private Sub OptKaoQin_Click()
 Dim sMonth, sYear As String
 sMonth = Month(Now) + 1
 sYear = Year(Now)
 If sMonth > 12 Then
    sMonth = sMonth - 12
    sYear = sYear + 1
 End If
 sYear = CStr(sYear) + "-" + CStr(sMonth) + "-1"
 DTKaoQinStart.Value = CStr(Year(Now)) + "-" + CStr(Month(Now)) + "-1"
 DTKaoQinEnd.Value = CDate(sYear) - 1



DTKaoQinStart.Enabled = False
 DTKaoQinEnd.Enabled = False
 chkKaoQinDate.Value = 0
End Sub




Private Sub OptSource_Click()
 Dim sMonth, sYear As String
 sMonth = Month(Now) + 1
 sYear = Year(Now)
 If sMonth > 12 Then
    sMonth = sMonth - 12
    sYear = sYear + 1
 End If
 sYear = CStr(sYear) + "-" + CStr(sMonth) + "-1"
 DTKaoQinStart.Value = CStr(Year(Now)) + "-" + CStr(Month(Now)) + "-1"
 DTKaoQinEnd.Value = CDate(sYear) - 1



DTKaoQinStart.Enabled = False
 DTKaoQinEnd.Enabled = False
 chkKaoQinDate.Value = 0
End Sub

Private Sub Timer1_Timer()
   txtTime = Time
End Sub