frmmaim.frm

一个使用射频卡的考勤软件

  '********数据操作
   Data2.Recordset.AddNew
   Data2.Recordset("员工_ID") = Data1.Recordset("ID")
   Data2.Recordset("姓名") = Data1.Recordset("姓名")
   Data2.Recordset("日期") = Date
   Data2.Recordset("备注") = "NO"
   Data2.Recordset("考勤时间") = TimeValue("00:00:00 AM")
   Data2.Recordset.Update
   Label1.Caption = Text1.Text & "         未考勤！"
   List1.AddItem CStr(Text1.Text) & "        未考勤！"
  End If
End If
Data1.Recordset.MoveNext
Next i
End Sub

Private Sub Form_Load()
Me.BackColor = &H80000018
Me.BorderStyle = 0
Shape1.BorderWidth = 8
Shape1.BorderColor = &HFF8080
MoveBar1.BackColor = &HFF8080
MoveBar1.Align = 1
'***********************循环读卡处理
'Label1.ForeColor = &HFF&
'Timer2.Interval = 3000
DTPicker1.Value = Date
Frame1.Visible = False
asPopup7.Enabled = False
Data1.DatabaseName = App.Path & "\公司员工考勤库.mdb"
Data1.RecordSource = "员工信息表"
Data1.Refresh
Data2.DatabaseName = App.Path & "\公司员工考勤库.mdb"
Data2.RecordSource = "考勤记录表_1"
Data2.Refresh
Data3.DatabaseName = App.Path & "\公司员工考勤库.mdb"
Data3.RecordSource = "考勤参数表"
Data3.Refresh

  '-------------------------启动滚动文字 必须连同Timer
    label3.Top = Picture1.ScaleHeight
    Label4.ForeColor = &HC0&
    Label4.Top = Picture1.ScaleHeight + label3.Height + 30
    hh0$ = Chr$(13) + Chr$(10)
    SM$ = "射频卡考勤系统 1.0" + hh0$
    SM$ = SM$ + "" + hh0$
    SM$ = SM$ + "程序编制：段利庆" + hh0$
    SM$ = SM$ + "" + hh0$
    SM$ = SM$ + "界面设计：段利庆" + hh0$
    label3.Caption = SM$
    SM$ = "         射频卡考勤系统1.0公告" + hh0$
    SM$ = SM$ + "" + hh0$
    SM$ = SM$ + "    射频卡考勤系统1.0属共享软件。作者" + hh0$
    SM$ = SM$ + "自学VB一年有余，深知编程之苦之乐，有" + hh0$
    SM$ = SM$ + "时为某一功能的实现要花费许多时间，概" + hh0$
    SM$ = SM$ + "因周围无可交流人员。为使后学者在某些" + hh0$
    SM$ = SM$ + "方面少走弯路，特制作此软件，并公布源" + hh0$
    SM$ = SM$ + "程序，您可以免费传播、使用。欢迎到我" + hh0$
    SM$ = SM$ + "主页： Leeking.yeah.net 访问并下载。" + hh0$
    SM$ = SM$ + "同时也希望更多的程序员公布自己的源代" + hh0$
    SM$ = SM$ + "码,共同促进中国软件事业的发展。     " + hh0$
    SM$ = SM$ + "                                     " + hh0$
    SM$ = SM$ + "    若您有疑问可写信至：             " + hh0$
    SM$ = SM$ + "                                     " + hh0$
    SM$ = SM$ + "                                     " + hh0$
    SM$ = SM$ + "西安高新技术产业开发区伟志科技大厦2层" + hh0$
    SM$ = SM$ + "                                     " + hh0$
    SM$ = SM$ + "              段利庆 收              " + hh0$
    SM$ = SM$ + "                                     " + hh0$
    SM$ = SM$ + "邮编：710065" + hh0$
    SM$ = SM$ + "                                     " + hh0$
    SM$ = SM$ + "   E-mail:[e-mail]    " + hh0$
    SM$ = SM$ + "                                    " + hh0$
    SM$ = SM$ + "                        感谢阅读    " + hh0$
    SM$ = SM$ + "                                    " + hh0$
    Label4.Caption = SM$
'****************判断操作的数据表
Dim Mytime2 As Date
Mytime2 = TimeValue("1:00:00 PM")
If Time > Mytime2 Then
 MsgBox "现在是下午时间！"
 Data2.DatabaseName = App.Path & "\公司员工考勤库.mdb"
 Data2.RecordSource = "考勤记录表_2"
 Data2.Refresh
End If
End Sub

Private Sub Form_Resize()
Shape1.Top = 270
Shape1.Left = 0
Shape1.Height = Me.Height - 270
Shape1.Width = Me.Width
End Sub

Private Sub Label1_Click()
ReadCardTimer2
End Sub

Private Sub Timer1_Timer()
 iStep = 20
 label3.Top = label3.Top - iStep
 Label4.Top = Label4.Top - iStep
 If Label4.Top + Label4.Height < Picture1.Top + Picture1.Height Then
    label3.Top = Picture1.ScaleHeight
   If Label4.Top + Label4.Height < 20 Then
    Label4.Top = Picture1.ScaleHeight + label3.Height + 30
   End If
 End If
End Sub

Private Sub Timer2_Timer()
Label1.ForeColor = &HFF0000
''''''''''''''''
ReadCardTimer2
''''''''''''''''''
Timer3.Enabled = True
Timer3.Interval = 1000
Timer2.Enabled = False
End Sub

Private Sub Timer3_Timer()
Label1.ForeColor = &HFF&
''''''''''''''''''''''''
ReadCardTimer3
''''''''''''''''''''''''''
ReadCardTimer2
Timer2.Enabled = True
Timer2.Interval = 1000
Timer3.Enabled = False
End Sub
Private Sub ReadCardTimer2()
Dim err As Integer
err = MCS_InitComm(0, 115200)
MCS_LED (2)
MCS_Buzzer (1)
err = MCS_Load_Key(0, 12, 255, 255, 255, 255, 255, 255)
err = MCS_Load_Key(4, 12, 255, 255, 255, 255, 255, 255)
MCS_LED (1)
err = MCS_ExitComm()
err = MCS_InitComm(0, 115200)
If err <> 0 Then
 Label1.Caption = "com_err"
End If
err = MCS_LED(2)
err = MCS_Config(198, 14)
If err <> 0 Then
 Label1.Caption = "config_err"
End If
'**********是否在天线区域
err = MCS_Request(1, 4)
If err <> 0 Then
Label1.Caption = "系统就绪！请刷卡考勤..."
 Exit Sub
' MsgBox "request_err"
Else
'**************开始正确读卡
'Dim err As Integer
err = MCS_InitComm(0, 115200)
MCS_LED (2)
MCS_Buzzer (1)
err = MCS_Load_Key(0, 12, 255, 255, 255, 255, 255, 255)
err = MCS_Load_Key(4, 12, 255, 255, 255, 255, 255, 255)
MCS_LED (1)
err = MCS_ExitComm()
err = MCS_InitComm(0, 115200)
If err <> 0 Then
 Label1.Caption = "com_err"
End If
err = MCS_LED(2)
err = MCS_Config(198, 14)
If err <> 0 Then
 Label1.Caption = "config_err"
End If
'**********是否在天线区域
err = MCS_Request(1, 4)
If err <> 0 Then
 Label1.Caption = "request_err"
End If
err = MCS_Buzzer(1)
If err <> 0 Then
 Label1.Caption = "buzzer_err"
End If
Dim lserialno As Long
err = MCS_Anticoll(0, lserialno)
If err <> 0 Then
 Label1.Caption = "anticoll_err"
End If
err = MCS_Select(lserialno, 1)
If err <> 0 Then
 Label1.Caption = "select_err"
End If
err = MCS_Authentication(0, 12)
Dim buffer As String * 8
err = MCS_Read(48, buffer)
'err = MCS_Read(49, buffer)
'err = MCS_Read(50, buffer)
'err = MCS_Read(51, buffer)
If err <> 0 Then
 Label1.Caption = "read_err"
End If
err = MCS_Buzzer(0)
If err <> 0 Then
 Label1.Caption = "buzzer_err"
End If
err = MCS_LED(1)
err = MCS_ExitComm()
If err <> 0 Then
 Label1.Caption = "exitcomm_err"
End If
Text1 = buffer
'*****************正确读卡完毕
  Label1.Caption = "读卡完毕！" & buffer
  Text1.Text = buffer
  Button1_Click
End If
End Sub
Private Sub ReadCardTimer3()
Dim err As Integer
err = MCS_InitComm(0, 115200)
MCS_LED (2)
MCS_Buzzer (1)
err = MCS_Load_Key(0, 12, 255, 255, 255, 255, 255, 255)
err = MCS_Load_Key(4, 12, 255, 255, 255, 255, 255, 255)
MCS_LED (1)
err = MCS_ExitComm()
err = MCS_InitComm(0, 115200)
If err <> 0 Then
 Label1.Caption = "com_err"
End If
err = MCS_LED(2)
err = MCS_Config(198, 14)
If err <> 0 Then
 Label1.Caption = "config_err"
End If
'**********是否在天线区域
err = MCS_Request(1, 4)
If err <> 0 Then
Label1.Caption = "系统就绪！请刷卡考勤..."
 Exit Sub
' MsgBox "request_err"
Else
'**************开始正确读卡
'Dim err As Integer
err = MCS_InitComm(0, 115200)
MCS_LED (2)
MCS_Buzzer (1)
err = MCS_Load_Key(0, 12, 255, 255, 255, 255, 255, 255)
err = MCS_Load_Key(4, 12, 255, 255, 255, 255, 255, 255)
MCS_LED (1)
err = MCS_ExitComm()
err = MCS_InitComm(0, 115200)
If err <> 0 Then
 Label1.Caption = "com_err"
End If
err = MCS_LED(2)
err = MCS_Config(198, 14)
If err <> 0 Then
 Label1.Caption = "config_err"
End If
'**********是否在天线区域
err = MCS_Request(1, 4)
If err <> 0 Then
 Label1.Caption = "request_err"
End If
err = MCS_Buzzer(1)
If err <> 0 Then
 Label1.Caption = "buzzer_err"
End If
Dim lserialno As Long
err = MCS_Anticoll(0, lserialno)
If err <> 0 Then
 Label1.Caption = "anticoll_err"
End If
err = MCS_Select(lserialno, 1)
If err <> 0 Then
 Label1.Caption = "select_err"
End If
err = MCS_Authentication(0, 12)
Dim buffer As String * 8
err = MCS_Read(48, buffer)
'err = MCS_Read(49, buffer)
'err = MCS_Read(50, buffer)
'err = MCS_Read(51, buffer)
If err <> 0 Then
 Label1.Caption = "read_err"
End If
err = MCS_Buzzer(0)
If err <> 0 Then
 Label1.Caption = "buzzer_err"
End If
err = MCS_LED(1)
err = MCS_ExitComm()
If err <> 0 Then
 Label1.Caption = "exitcomm_err"
End If
Text1 = buffer
'*****************正确读卡完毕
  Label1.Caption = "读卡完毕！" & buffer
  Text1.Text = buffer
  Button1_Click
End If
End Sub
Private Sub MyGrid()
 If DataEnvironment1.rsCommand2.State <> adStateClosed Then
        DataEnvironment1.rsCommand2.Close
    End If
    
    ' 读取 Text1 设定给参数一
      DataEnvironment1.Commands("Command2").Parameters(0) = CStr(DTPicker1.Value)
    ' 读取 Text2 设定给参数二
      'DataEnvironment1.Commands("Command1").Parameters(1) = CStr(DTPicker2.Value)

    DataGrid1.DataMember = "Command2"
    Set DataGrid1.DataSource = DataEnvironment1
End Sub