kaoqin.frm

可以用于商业用途

         Top             =   720
         Width           =   1335
         _extentx        =   2355
         _extenty        =   661
         icon            =   "kaoqin.frx":1652
         style           =   8
         caption         =   "   下班考勤"
         iconalign       =   1
         tooltiptitle    =   ""
         tooltipicon     =   0
         tooltiptype     =   0
         font            =   "kaoqin.frx":19EE
      End
      Begin VB.Label Label1 
         Caption         =   "要考勤员工的编号:"
         Height          =   255
         Left            =   240
         TabIndex        =   1
         Top             =   360
         Width           =   1575
      End
   End
End
Attribute VB_Name = "kaoqin"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
  'ini文件操作
Private Declare Function GetPrivateProfileString Lib "kernel32" _
   Alias "GetPrivateProfileStringA" (ByVal lpApplicationName As String, _
   ByVal lpKeyName As Any, ByVal lpDefault As String, _
   ByVal lpReturnedString As String, ByVal nSize As Long, _
   ByVal lpFileName As String) As Long
Private Declare Function WritePrivateProfileString Lib "kernel32" _
   Alias "WritePrivateProfileStringA" (ByVal lpApplicationName As String, _
   ByVal lpKeyName As Any, ByVal lpString As Any, _
   ByVal lpFileName As String) As Long
   Dim SqlTxt As String
Dim AddFlg As Boolean
Dim conn1 As New adodb.Connection

Dim conn As New adodb.Connection
Dim rs As New adodb.Recordset



Private Sub Command1_Click()
chaxun
End Sub

Private Sub DataGrid1_Click()
Rows

End Sub

Private Sub Form_Load()
st
tempstart
text1.Text = Date
Text3.Text = time
End Sub

Private Sub isButton1_Click()

If Combo4.Text = "" Then
MsgBox "尚未选中员工编号", vbInformation
Else
TempSave
End If

End Sub

Private Sub isButton4_Click()
disb
End Sub

Private Sub isButton5_Click()
Unload Me

End Sub





Sub st()
Dim i As Integer
Dim StrConnect As String '定义
   StrConnect = App.Path
    If Right(StrConnect, 1) <> "\" Then StrConnect = StrConnect + "\"
conn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Persist Security Info=False;Data Source=" & StrConnect & "\data\kq.mdb"
rs.Open "select ID,编号 from yggl", conn, 1, 1
i = 0
Do While Not rs.EOF
Combo4.AddItem rs("编号")
Combo4.ItemData(i) = rs("id")
i = i + 1
rs.MoveNext
Loop
list.Text = i
rs.Close
conn.Close
End Sub
Sub disb()
txt_zs.Enabled = False
txt_ws.Enabled = False
txt_zhuangtai.Enabled = False
txt_memo.Enabled = False
End Sub
Sub enbel()
txt_zs.Enabled = True
txt_ws.Enabled = True
txt_zhuangtai.Enabled = True
txt_memo.Enabled = True
End Sub




Sub TempSave()

Dim success As String

success = WritePrivateProfileString(Combo4.Text, "考勤时间", text1.Text, App.Path & "\temp\temp.ini")
success = WritePrivateProfileString(Combo4.Text, "员工编号", Combo4.Text, App.Path & "\temp\temp.ini")
If Format(time, "h:m") > Format(text1.Text, "h:m") Then
success = WritePrivateProfileString(Combo4.Text, "状态", "迟到", App.Path & "\temp\temp.ini")
Else
success = WritePrivateProfileString(Combo4.Text, "状态", "白天在岗", App.Path & "\temp\temp.ini")
End If
success = WritePrivateProfileString(Combo4.Text, "上班时间(早)", Text3.Text, App.Path & "\temp\temp.ini")
success = WritePrivateProfileString(Combo4.Text, "备注", "无", App.Path & "\temp\temp.ini")
End Sub
Sub startx()

End Sub
 
 Sub tempstart()
 Dim i As Integer
Dim ret As Long
Dim buff As String
Dim a(60)
Dim B(60)
Dim c(60)
Dim d(60)
Dim e(60)
For i = 1 To list.Text
'读取考勤时间
buff = String(255, 0)
ret = GetPrivateProfileString(i, "考勤时间", a(i), buff, 256, App.Path & "\temp\temp.ini")
a(i) = buff
'读取员工编号
buff = String(255, 0)
ret = GetPrivateProfileString(i, "员工编号", B(i), buff, 256, App.Path & "\temp\temp.ini")
B(i) = buff
'读取状态
buff = String(255, 0)
ret = GetPrivateProfileString(i, "状态", c(i), buff, 256, App.Path & "\temp\temp.ini")
c(i) = buff
'读取上班时间
buff = String(255, 0)
ret = GetPrivateProfileString(i, "上班时间(早)", d(i), buff, 256, App.Path & "\temp\temp.ini")
d(i) = buff


Next i
Dim objLI As ListItem
Dim si As ListSubItem
   Dim li As ListItem


Dim j As Integer

    Me.ListView1.ColumnHeaders.Add , , "工号"
    Me.ListView1.ColumnHeaders.Add , , "考勤时间"
    Me.ListView1.ColumnHeaders.Add , , "状态"
    Me.ListView1.ColumnHeaders.Add , , "上班时间"
    
    For j = 1 To list.Text
 Set objLI = ListView1.ListItems.Add(Text:=B(j))
 Set si = objLI.ListSubItems.Add(Text:="" & a(j))
  Set si = objLI.ListSubItems.Add(Text:="" & c(j))
   Set si = objLI.ListSubItems.Add(Text:="" & d(j))
 Next j
 
 End Sub

Sub TempSave1()
Dim success As String
If Format(time, "h:m") > Format(Text2.Text, "h:m") Then
success = WritePrivateProfileString(Combo4.Text, "状态", "早退", App.Path & "\temp\temp.ini")
Else
success = WritePrivateProfileString(Combo4.Text, "状态", "晚上在岗", App.Path & "\temp\temp.ini")
End If

success = WritePrivateProfileString(Combo4.Text, "下班时间(晚)", Text3.Text, App.Path & "\temp\temp.ini")
End Sub

Private Sub isButton2_Click()
If Combo4.Text = "" Then
MsgBox "尚未选中员工编号", vbInformation
Else
TempSave1
End If

End Sub

Private Sub isButton3_Click()
data_save

End Sub

Private Sub ListView1_ItemClick(ByVal Item As MSComctlLib.ListItem)
Dim i As Integer
txt_zhuangtai.Text = ListView1.SelectedItem.SubItems(2)
txt_zs.Text = ListView1.SelectedItem.SubItems(3)
End Sub

Sub data_save()

Dim str As String
Dim j As Integer
Dim i As Integer
Dim ret As Long
Dim buff As String
Dim a(20) As String
Dim B(20) As String
Dim c(20) As Variant
Dim d(20) As Variant
Dim e(20) As Variant

For i = 1 To list.Text
'读取考勤时间
buff = String(255, 0)
ret = GetPrivateProfileString(i, "考勤时间", a(i), buff, 256, App.Path & "\temp\temp.ini")
a(i) = buff
'读取员工编号
buff = String(255, 0)
ret = GetPrivateProfileString(i, "员工编号", B(i), buff, 256, App.Path & "\temp\temp.ini")
B(i) = buff
'读取状态
buff = String(255, 0)
ret = GetPrivateProfileString(i, "状态", c(i), buff, 256, App.Path & "\temp\temp.ini")
c(i) = buff
'读取上班时间
buff = String(255, 0)
ret = GetPrivateProfileString(i, "上班时间(早)", d(i), buff, 256, App.Path & "\temp\temp.ini")
d(i) = buff
'读取下班时间
buff = String(255, 0)
ret = GetPrivateProfileString(i, "下班时间(晚)", e(i), buff, 256, App.Path & "\temp\temp.ini")
e(i) = buff
Next i


Dim ssql As String
Dim cnn As New adodb.Connection
Dim ret1 As New adodb.Recordset
'连接数据库1
cnn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" + App.Path & "\data\kq.mdb" + ";Persist Security Info=False;"
ret1.Open "select * from 考勤状态", cnn, 1, 3

   
For j = 1 To list.Text

If ret1.EOF Then
ret1.AddNew

ret1.Fields("员工编号") = Trim("" & LPSTRToVBString$(B(j)))
ret1.Fields("状态") = Trim("" & LPSTRToVBString$(c(j)))
ret1.Fields("考勤时间") = Trim("" & Format(LPSTRToVBString$(a(j)), "yyyy-mm-dd"))
ret1.Fields("上班时间") = Trim("" & Format(LPSTRToVBString$(d(j)), "hh:mm:ss"))
ret1.Fields("下班时间") = Trim("" & Format(LPSTRToVBString$(e(j)), "hh:mm:ss"))
ret1.Fields("备注") = "无"
ret1.Update
 
   End If
     Next j
End Sub

Sub st1()
Dim i As Integer
Dim StrConnect As String '定义
   StrConnect = App.Path
    If Right(StrConnect, 1) <> "\" Then StrConnect = StrConnect + "\"
conn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Persist Security Info=False;Data Source=" & StrConnect & "\data\kq.mdb"
rs.Open "select * from 考勤时间设定", conn, 1, 1
rs.MoveFirst
z.Text = rs.Fields("早上班")
w.Text = rs.Fields("晚下班")
rs.Close
conn.Close
End Sub