module1.bas

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

                temHour = adoRR!Hour
                temMinute = adoRR!Minute
                temSecond = adoRR!Second
        Case Else
                adoCon.Execute (SQL + "'" & Trim(adoRR!Type) & "')")
        End Select
        adoRR.MoveNext
   
     SQL = "insert into KaoQin values "
     SQL = SQL + "('" & Trim(adoRR!CardID) & "',"
     SQL = SQL + "'" & Trim(adoRR!Date) & "','" & Trim(adoRR!Hour) & "',"
     SQL = SQL + "'" & Trim(adoRR!Minute) & "','" & Trim(adoRR!Second) & "',"
        
     If IIC = 1 Then
         Select Case Trim(adoRR!Type)
         Case "正常"
            adoCon.Execute ("insert into KaoQin values('" & Trim(temCardID) & "','" & Trim(temDate) & "','" & Trim(temHour) & "','" & Trim(temMinute) & "','" & Trim(temSecond) & "','旷勤')")
         Case "旷勤半天"
            adoCon.Execute (SQL + "'旷勤')")
         Case Else
           adoCon.Execute ("insert into KaoQin values('" & Trim(temCardID) & "','" & Trim(temDate) & "','" & Trim(temHour) & "','" & Trim(temMinute) & "','" & Trim(temSecond) & "','旷勤半天')")
           adoCon.Execute (SQL + "'" & adoRR!Type & "')")
         End Select
     Else
          If Trim(adoRR!Type) <> "正常" Then
             adoCon.Execute (SQL + "'" & Trim(adoRR!Type) & "')")
          End If
     End If
  Case Else
       
         IIC = 0
        SQL = "insert into KaoQin values "
        SQL = SQL + "('" & Trim(adoRR!CardID) & "',"
        SQL = SQL + "'" & Trim(adoRR!Date) & "','" & Trim(adoRR!Hour) & "',"
        SQL = SQL + "'" & Trim(adoRR!Minute) & "','" & Trim(adoRR!Second) & "',"
         
         Select Case Trim(adoRR!Type)
             Case "正常"
             Case "旷勤半天"
                IIC = 1
                temCardID = adoRR!CardID
                temDate = adoRR!Date
                temHour = adoRR!Hour
                temMinute = adoRR!Minute
                temSecond = adoRR!Second
             Case Else
                adoCon.Execute (SQL + "'" & Trim(adoRR!Type) & "')")
              End Select
         adoRR.MoveLast
     SQL = "insert into KaoQin values "
     SQL = SQL + "('" & Trim(adoRR!CardID) & "',"
     SQL = SQL + "'" & Trim(adoRR!Date) & "','" & Trim(adoRR!Hour) & "',"
     SQL = SQL + "'" & Trim(adoRR!Minute) & "','" & Trim(adoRR!Second) & "',"
     If IIC = 1 Then
         Select Case Trim(adoRR!Type)
         Case "正常"
            adoCon.Execute ("insert into KaoQin values('" & Trim(temCardID) & "','" & Trim(temDate) & "','" & Trim(temHour) & "','" & Trim(temMinute) & "','" & Trim(temSecond) & "','旷勤')")
         Case "旷勤半天"
            adoCon.Execute (SQL + "'旷勤')")
         Case Else
           adoCon.Execute ("insert into KaoQin values('" & Trim(temCardID) & "','" & Trim(temDate) & "','" & Trim(temHour) & "','" & Trim(temMinute) & "','" & Trim(temSecond) & "','旷勤半天')")
           adoCon.Execute (SQL + "'" & adoRR!Type & "')")
         End Select
     Else
       If Trim(adoRR!Type) <> "正常" Then
           adoCon.Execute (SQL + "'" & Trim(adoRR!Type) & "')")
       End If
     End If
End Select
      
     ' Bar.Value = Bar.Value + 1
      adoCard.MoveNext
   Loop
  adoDay.MoveNext
Loop
 '为下一次的LastDay负值
Set adoDay = adoCon.Execute("select Date from KaoQinSource order by Date desc")
If adoDay.EOF Then
   MsgBox "没有读取到考勤信息，考勤库为空！", vbOKOnly + vbCritical, "系统提示"
   Exit Sub
End If
adoCon.Execute ("update  LastDay set LastDay ='" & adoDay!Date & "'")


'加入节假日信息
Set adoDay = adoCon.Execute("exec DayIn_proc '" & LastDay & "','" & (Date - 1) & "'")
Do While Not adoDay.EOF
   Set adoCard = adoCon.Execute("exec Card_proc")
   Do While Not adoCard.EOF
      Set adoRs = adoCon.Execute("exec KSID_proc '" & Trim(adoDay!Date) & "','" & Trim(adoCard!CardID) & "'")
    If Not adoRs.EOF Then
      SQL = "insert into KaoQin values "
      SQL = SQL + "('" & Trim(adoRs!CardID) & "',"
      SQL = SQL + "'" & Trim(adoRs!Date) & "','" & Trim(adoRs!Hour) & "',"
      SQL = SQL + "'" & Trim(adoRs!Minute) & "','" & Trim(adoRs!Second) & "',"
      adoCon.Execute (SQL + "'节日加班')")
    End If
       adoCard.MoveNext
   Loop
   
   adoDay.MoveNext
Loop
End Sub

Public Sub setChushi()
Dim sDay As Date

Dim sCount As Integer
Dim sKaoQinID1, sType1, sKaoQinID2, sType2 As String
Dim AdoKaoQin As New ADODB.Recordset

  Set adoRs = adoCon.Execute("select * from QingJia  ")
  Do While Not adoRs.EOF
    sDay = adoRs!StartDay
    For I = 0 To (adoRs!EndDay - adoRs!StartDay)
     Set AdoKaoQin = adoCon.Execute("select count(*) from kaoqin where Date='" & sDay & "'and CardID='" & Trim(adoRs!CardID) & "'")
     sCount = AdoKaoQin(0)
     Set AdoKaoQin = adoCon.Execute("select * from kaoqin where Date='" & sDay & "'and CardID='" & Trim(adoRs!CardID) & "'")
         
         Select Case sCount
         Case 0
          If Left(Trim(adoRs!Type), 2) = "正常" Or Left(Trim(adoRs!Type), 2) = "外出" Then
          Else
            adoCon.Execute ("exec insertK_proc '" & Trim(adoRs!CardID) & "','" & Trim(sDay) & "','0','0','0','" & Trim(adoRs!Type) & "'")
          End If
         Case 1
           If Trim(AdoKaoQin!Type) = "旷勤" Then
               Select Case Trim(adoRs!Type)
                 Case "请假半天"
                  adoCon.Execute ("update KaoQin set Type='" & Trim(adoRs!Type) & "'where  Date='" & sDay & "'and CardID='" & Trim(sDay) & "'")
                  adoCon.Execute ("exec insertK_proc '" & Trim(adoRs!CardID) & "','" & Trim(sDay) & "','0','0','0','旷勤半天'")
                 Case "正常半天"
                  adoCon.Execute ("delete KaoQin  where Date='" & sDay & "'and CardID='" & Trim(adoRs!CardID) & "'")
                  adoCon.Execute ("exec insertK_proc '" & Trim(adoRs!CardID) & "','" & Trim(sDay) & "','0','0','0','旷勤半天'")
                 Case "外出办公半天"
                  adoCon.Execute ("delete KaoQin  where Date='" & sDay & "'and CardID='" & Trim(adoRs!CardID) & "'")
                  adoCon.Execute ("exec insertK_proc '" & Trim(adoRs!CardID) & "','" & Trim(sDay) & "','0','0','0','旷勤半天'")
                 Case "正常"
                  adoCon.Execute ("delete KaoQin  where Date='" & sDay & "'and CardID='" & Trim(adoRs!CardID) & "'")
                 Case "外出办公"
                  adoCon.Execute ("delete KaoQin  where Date='" & sDay & "'and CardID='" & Trim(adoRs!CardID) & "'")
                 Case Else
                  adoCon.Execute ("delete KaoQin where Date='" & sDay & "'and CardID='" & Trim(adoRs!CardID) & "'")
                  adoCon.Execute ("exec insertK_proc '" & Trim(adoRs!CardID) & "','" & Trim(sDay) & "','0','0','0','" & Trim(adoRs!Type) & "'")
                 End Select
              ElseIf Trim(AdoKaoQin!Type) = "加班" Then
                 If Trim(adoRs!Type) = "加班" Or Left(Trim(adoRs!Type), 2) = "正常" Or Left(Trim(adoRs!Type), 2) = "外出" Then
                 Else
                 adoCon.Execute ("exec insertK_proc '" & Trim(adoRs!CardID) & "','" & Trim(sDay) & "','0','0','0','" & Trim(adoRs!Type) & "'")
                 End If
              Else
              If Trim(AdoKaoQin!Type) = "迟到" Or Trim(AdoKaoQin!Type) = "早退" Or Trim(AdoKaoQin!Type) = "旷勤半天" Then
                  If Trim(adoRs!Type) = "正常" Or Trim(adoRs!Type) = "外出办公" Then
                     adoCon.Execute ("delete KaoQin  where Date='" & sDay & "'and CardID='" & Trim(adoRs!CardID) & "'")
                  Else
                     adoCon.Execute ("delete KaoQin  where Date='" & sDay & "'and CardID='" & Trim(adoRs!CardID) & "'")
                     adoCon.Execute ("exec insertK_proc '" & Trim(adoRs!CardID) & "','" & Trim(sDay) & "','0','0','0','" & Trim(adoRs!Type) & "'")
                  End If
               End If
           
           End If
         
         
         
         Case 2
            sType1 = Trim(AdoKaoQin!Type)
            sKaoQinID1 = AdoKaoQin!KaoQinID
            AdoKaoQin.MoveNext
            sType2 = Trim(AdoKaoQin!Type)
            sKaoQinID2 = AdoKaoQin!KaoQinID
            Select Case Trim(adoRs!Type)
            Case "正常"
            adoCon.Execute ("delete KaoQin where  Date='" & sDay & "'and CardID='" & Trim(adoRs!CardID) & "'and Type <>'加班'")
            Case "外出办公"
             adoCon.Execute ("delete KaoQin where  Date='" & sDay & "'and CardID='" & Trim(adoRs!CardID) & "'and Type <>'加班'")
                 
            Case "出差"
               adoCon.Execute ("delete KaoQin  where Date='" & sDay & "'and CardID='" & Trim(adoRs!CardID) & "'and Type <>'加班'")
               adoCon.Execute ("exec insertK_proc '" & Trim(adoRs!CardID) & "','" & Trim(sDay) & "','0','0','0','" & Trim(adoRs!Type) & "'")
            
            Case "请假"
               adoCon.Execute ("delete KaoQin  where Date='" & sDay & "'and CardID='" & Trim(adoRs!CardID) & "'and Type <>'加班'")
               adoCon.Execute ("exec insertK_proc '" & Trim(adoRs!CardID) & "','" & Trim(sDay) & "','0','0','0','" & Trim(adoRs!Type) & "'")
            Case "加班"
               If sType1 = "加班" Or sType2 = "加班" Then
               Else
               adoCon.Execute ("exec insertK_proc '" & Trim(adoRs!CardID) & "','" & Trim(sDay) & "','0','0','0','" & Trim(adoRs!Type) & "'")
               
               End If
            Case "节日加班"
               adoCon.Execute ("delete KaoQin  where Date='" & sDay & "'and CardID='" & Trim(adoRs!CardID) & "'")
               adoCon.Execute ("exec insertK_proc '" & Trim(adoRs!CardID) & "','" & Trim(sDay) & "','0','0','0','" & Trim(adoRs!Type) & "'")
            
            Case "请假半天"
                If (sType1 = "请假半天") Or (sType2 = "请假半天") Then
                ElseIf sType1 = "旷勤半天" Then
                  adoCon.Execute ("update KaoQin set Type='" & Trim(adoRs!Type) & "'where KaoQinID='" & Trim(sKaoQinID1) & "'")
                ElseIf sType2 = "旷勤半天" Then
                  adoCon.Execute ("update KaoQin set Type='" & Trim(adoRs!Type) & "'where KaoQinID='" & Trim(sKaoQinID2) & "'")
                ElseIf sType1 = "加班" Then
                  adoCon.Execute ("update KaoQin set Type='" & Trim(adoRs!Type) & "'where KaoQinID='" & Trim(sKaoQinID2) & "'")
                ElseIf sType2 = "加班" Then
                  adoCon.Execute ("update KaoQin set Type='" & Trim(adoRs!Type) & "'where KaoQinID='" & Trim(sKaoQinID1) & "'")
                ElseIf sType1 = "迟到" Then
                  adoCon.Execute ("update KaoQin set Type='" & Trim(adoRs!Type) & "'where KaoQinID='" & Trim(sKaoQinID1) & "'")
                ElseIf sType2 = "迟到" Then
                  adoCon.Execute ("update KaoQin set Type='" & Trim(adoRs!Type) & "'where KaoQinID='" & Trim(sKaoQinID2) & "'")
                Else
                  adoCon.Execute ("update KaoQin set Type='" & Trim(adoRs!Type) & "'where KaoQinID='" & Trim(sKaoQinID2) & "'")
                End If
            Case "外出办公半天"
               If (sType1 = "请假半天") Or (sType2 = "请假半天") Then
                ElseIf sType1 = "旷勤半天" Then
                  adoCon.Execute ("delete KaoQin where KaoQinID='" & Trim(sKaoQinID1) & "'")
                ElseIf sType2 = "旷勤半天" Then
                  adoCon.Execute ("delete  KaoQin where KaoQinID='" & Trim(sKaoQinID2) & "'")
                ElseIf sType1 = "加班" Then
                ElseIf sType2 = "加班" Then
                ElseIf sType1 = "迟到" Then
                  adoCon.Execute ("delete KaoQin where KaoQinID='" & Trim(sKaoQinID1) & "'")
                ElseIf sType2 = "迟到" Then
                  adoCon.Execute ("delete KaoQin where KaoQinID='" & Trim(sKaoQinID2) & "'")
                Else
                  adoCon.Execute ("delete KaoQin where KaoQinID='" & Trim(sKaoQinID2) & "'")
                End If
            
            Case "正常半天"
                If (sType1 = "请假半天") Or (sType2 = "请假半天") Then
                ElseIf sType1 = "旷勤半天" Then
                  adoCon.Execute ("delete KaoQin where KaoQinID='" & Trim(sKaoQinID1) & "'")
                ElseIf sType2 = "旷勤半天" Then
                  adoCon.Execute ("delete KaoQin where KaoQinID='" & Trim(sKaoQinID2) & "'")
                ElseIf sType1 = "加班" Then
                ElseIf sType2 = "加班" Then
                ElseIf sType1 = "迟到" Then
                  adoCon.Execute ("delete KaoQin where KaoQinID='" & Trim(sKaoQinID1) & "'")
                ElseIf sType2 = "迟到" Then
                  adoCon.Execute ("delete KaoQin where KaoQinID='" & Trim(sKaoQinID2) & "'")
                Else
                  adoCon.Execute ("delete KaoQin where KaoQinID='" & Trim(sKaoQinID2) & "'")
                End If
            End Select
        End Select
     sDay = sDay + 1
    Next I
     adoRs.MoveNext
  Loop
  
  adoCon.Execute ("delete KaoQin where Date in (select StarDay from GongXiu) and Type <>'节日加班'")
  adoCon.Execute ("update KaoQin set Type='加班' where Date not in (select StarDay from GongXiu) and Type='节日加班'")
End Sub


Public Function Hex_Doc(STR) As Integer
Dim I, Sum, Count, J, K As Integer
Dim SSTR As String
Sum = 0
STR = Trim(STR)
I = Len(STR)
For J = 1 To I
     SSTR = Mid(STR, J, 1)
    If Not IsNumeric(SSTR) Then
       SSTR = UCase(SSTR)
       SSTR = CStr(Asc(SSTR) - 55)
    End If
    Count = 1
    For K = 1 To I - J
       Count = Count * 16
    Next K
    Sum = Sum + Val(SSTR) * Count
Next J

Hex_Doc = Sum

End Function