'********數據操作
   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:duanliqing@sohu.com.cn    " + 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