module1.bas

来自「VB写的通过串口与考勤机连接通讯的程序」· BAS 代码 · 共 409 行 · 第 1/2 页

Attribute VB_Name = "Module1"
Public Recchar() As Byte
Public ChuShi As Boolean
Public adoCon As New ADODB.Connection
Public adoRs As New ADODB.Recordset
Declare Function GetTickCount Lib "kernel32" () As Long
Public lNum As Integer
Public Function RtnStr() As String
   RtnStr = "Provider = SQLOLEDB;" + ConStr
End Function
Public Function ConStr() As String
 ConStr = "Integrated security=sspi;user id=sa;initial catalog=cclanya;data source=www-qy9v9b4wl3i"
End Function



Public Function Hex_D(STR As String) As String
Dim StrDate(1 To 16) As String
Dim J, I As Integer
Dim Sum, SumJ As Integer

For J = 1 To Len(STR)
   StrDate(J) = Mid(STR, Len(STR) + 1 - J, 1)
   If Not IsNumeric(StrDate(J)) Then
      StrDate(J) = UCase(StrDate(J))
      StrDate(J) = CStr(Asc(StrDate(J)) - 55)
      
   End If
   SumJ = 1
   I = 1
  Do While I < J
    SumJ = 16 * SumJ
    I = I + 1
  Loop
  Sum = Sum + Val(StrDate(J)) * SumJ
Next J
Hex_D = CStr(Sum)
End Function




Public Sub setConnect()
On Error GoTo ErrMsg

With adoCon
   .Provider = "SQLOLEDB"
   .ConnectionString = ConStr
   .Open
End With
ErrMsg:
   If Err.Number <> 0 Then
      MsgBox "数据库连接错误:" + CStr(Err.Number) + Err.Description, vbOKOnly + vbCritical, "系统提示"
     
   End If
End Sub
Public Sub InPutKaoQin()
Dim adoCard As New ADODB.Recordset
Dim adoDay As New ADODB.Recordset
Dim TDate As Date
Dim TCardID As String
Dim adoRR As New ADODB.Recordset
Dim AdoCc As New ADODB.Connection
Dim Fid, Lid As String
Dim IID, IIC As Integer
Dim SQL As String
Dim temCardID, temDate, temHour, temMinute, temSecond As String

Set adoRs = adoCon.Execute("select LastDay from LastDay ")
If adoRs.EOF Then
   Set adoDay = adoCon.Execute("select Date from KaoQinSource order by Date")
   LastDay = adoDay!Date
   adoCon.Execute ("insert into LastDay values('" & LastDay & "')")
Else
   LastDay = adoRs!LastDay

End If


 
 


'取最后区间的日期

Set adoDay = adoCon.Execute("exec DayNot_proc '" & LastDay & "','" & (Date - 1) & "'")

'某天,除今天
Do While Not adoDay.EOF
   '某人
   TDate = adoDay!Date
   Set adoCard = adoCon.Execute("exec Card_proc")
   Do While Not adoCard.EOF
      
      TCardID = Trim(adoCard!CardID)
    Set AdoCc = New ADODB.Connection
    Set adoRR = New ADODB.Recordset
      AdoCc.ConnectionString = RtnStr
      AdoCc.Open
      
      adoRR.Open "exec KSID_proc '" & STR(TDate) & "','" & STR(TCardID) & "'", AdoCc, adOpenKeyset, adLockPessimistic
      Select Case adoRR.RecordCount
      
    Case 0
        adoCon.Execute ("exec InsertK_proc '" & TCardID & "','" & TDate & "','0','0','0','旷勤'")
 
         
    Case 1
        
        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 "正常"
                adoCon.Execute ("exec insertK_proc" + SQL + "'旷勤半天'")
              Case "旷勤半天"
                adoCon.Execute ("exec insertK_proc" + SQL + "'旷勤'")
              Case Else
                adoCon.Execute ("exec insertK_proc" + SQL + "'" & Trim(adoRR!Type) & "'")
                adoCon.Execute ("exec insertK_proc" + SQL + "'旷勤半天'")
             End Select
   Case 2
        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.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