📄 frmkaoqin.frm
字号:
Size = 12
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ColumnCount = 2
BeginProperty Column00
DataField = ""
Caption = ""
BeginProperty DataFormat {6D835690-900B-11D0-9484-00A0C91110ED}
Type = 0
Format = ""
HaveTrueFalseNull= 0
FirstDayOfWeek = 0
FirstWeekOfYear = 0
LCID = 2052
SubFormatType = 0
EndProperty
EndProperty
BeginProperty Column01
DataField = ""
Caption = ""
BeginProperty DataFormat {6D835690-900B-11D0-9484-00A0C91110ED}
Type = 0
Format = ""
HaveTrueFalseNull= 0
FirstDayOfWeek = 0
FirstWeekOfYear = 0
LCID = 2052
SubFormatType = 0
EndProperty
EndProperty
SplitCount = 1
BeginProperty Split0
BeginProperty Column00
EndProperty
BeginProperty Column01
EndProperty
EndProperty
End
Begin VB.Label Label4
AutoSize = -1 'True
BackColor = &H00FFC0C0&
Caption = "通信端口："
BeginProperty Font
Name = "宋体"
Size = 12
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 240
Left = 240
TabIndex = 9
Top = 840
Width = 1290
End
Begin VB.Label Label3
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "考 勤 机 设 置"
BeginProperty Font
Name = "宋体"
Size = 21.75
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00FF0000&
Height = 435
Left = 3000
TabIndex = 8
Top = 480
Width = 3225
End
End
Attribute VB_Name = "frmKaoQinSET"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim SendByte(1 To 2) As Byte
Dim I%
Dim Buf As String
Dim Recchar() As Byte
Dim Add_ad As Integer
Dim Temp As Boolean
Dim Bool As Boolean
Private Sub CMDAD_Click()
On Error GoTo ErrMsg
Dim J As Integer
Dim STR As String
adoCon.Execute ("delete from Card ")
STR = "1007F9FF" + "27D5B9D0" + "27E58E10" + "28088430"
STR = STR + "28D597F0" + "28F85C90" + "2B712010" + "2BFC1650"
STR = STR + "2D0C11F0" + "2D157EF0" + "2E1208B0" + "2E12C4F0"
STR = STR + "2E14D7F0" + "2E3A3330" + "35D3A1B0" + "3977FFD0"
STR = STR + "39CB4990" + "3D835007" + "3F24F430" + "3FB3BE90"
STR = STR + "41AB5C50" + "41AD51B0" + "41AD5790" + "4441D730"
STR = STR + "47C4F007" + "5CEB7007" + "7007F9FF" + "A007F9FF"
STR = STR + "AB5C5007" + "D3A1B007" + "D597F007" + "D5B9D007"
STR = STR + "E1E55170" + "E1FAC410" + "E839EC90" + "E842DB10"
STR = STR + "EB6B7250" + "ED47C4F0" + "F007F9FF" + "FFFFFFFF"
adoCon.Execute ("insert into Card values('1','" & Mid(STR, 1, 8) & "')")
For J = 2 To (Len(STR) / 8)
adoCon.Execute ("insert into Card values ('" & J & "','" & Mid(STR, (J - 1) * 8 + 1, 8) & "')")
Next J
ErrMsg:
If Err.Number <> 0 Then
Exit Sub
End If
End Sub
Private Sub cmdCard_Click()
FRAMdaTA.Enabled = True
FRAMdaTA.Visible = True
txtRec.Enabled = False
txtRec.Visible = False
Text1.Text = ""
Text2.Text = ""
End Sub
Private Sub cmdAdd_Click()
If txtNeiMa.Text = "" Then
MsgBox "没有取得内置码!", vbOKOnly + vbExclamation, "录入提示"
Exit Sub
End If
ssmonth = Hex_D(Mid(Buf, 6, 1))
If Len(ssmonth) = 1 Then
ssmonth = "0" + ssmonth
End If
If Mid(Buf, 1, 2) = "00" And Mid(Buf, 5, 1) = "8" And (ssmonth + "-" + Mid(Buf, 7, 2) = Mid(Date$, 6, 5)) Then
MsgBox "次卡已经存在数据库中，请换新卡！", vbExclamation + vbOKOnly, "系统提示"
Exit Sub
End If
Set adoRs = adoCon.Execute("select CardID from Card where NeiMa='" & Trim(txtNeiMa.Text) & "'")
If adoRs.EOF Then
Set adoRs = adoCon.Execute("select CardID from Card where CardID ='" & Trim(txtCardID.Text) & "'")
If Not adoRs.EOF Then
MsgBox "此卡号已经被占用，请从新填写卡号！", vbOKOnly, "录入提示"
Exit Sub
Else
adoCon.Execute ("insert into Card values('" & Trim(txtCardID.Text) & "','" & Trim(txtNeiMa.Text) & "')")
txtNeiMa.Text = ""
Set adoRs = adoCon.Execute("select * from Card")
Set adoRs = adoCon.Execute("select max(CardID)from Card")
txtCardID.Text = adoRs.Fields(0) + 1
End If
Else
SS = adoRs!CardID
MsgBox "次卡已经存在，卡号是" + CStr(SS) + "．", vbOKOnly, "录入提示"
Exit Sub
End If
Call Ref
End Sub
Private Sub cmdAddNewCard_Click()
If MsgBox("请您先录入数据，以免打卡机内数据丢失．", vbYesNo + vbDefaultButton1, "系统提示") = vbYes Then
MSComm1.PortOpen = False
frmSet_rec.Show
Unload Me
Else
Set adoRs = adoCon.Execute("select * from Card")
If adoRs.EOF Then
txtCardID.Text = 1
Else
Set adoRs = adoCon.Execute("select max(CardID)from Card")
txtCardID.Text = adoRs.Fields(0) + 1
End If
txtNeiMa.Text = ""
Frame1.Visible = True
framehelp.Visible = False
End If
SendByte(1) = 250
SendByte(2) = 177
MSComm1.Output = SendByte
T = GetTickCount
Do
DoEvents
Loop Until GetTickCount - T > 80
Recchar = MSComm1.Input
Buf = ""
For I = LBound(Recchar) To UBound(Recchar)
Buf = Hex(Recchar(I)) + Buf
Next I
txtRec.Text = "现有记录 " + Hex_D(Buf) + " 条"
End Sub
Private Sub cmdCancel_Click()
Frame1.Visible = False
framehelp.Visible = True
End Sub
Private Sub cmdCount_Click()
Dim SendByte(1 To 2) As Byte
SendByte(1) = 250
SendByte(2) = 177
MSComm1.Output = SendByte
T = GetTickCount
Do
DoEvents
Loop Until GetTickCount - T > 80
Recchar = MSComm1.Input
Buf = ""
For I = LBound(Recchar) To UBound(Recchar)
Buf = Hex(Recchar(I)) + Buf
Next I
txtRec.Text = "现有记录 " + Hex_D(Buf) + " 条"
End Sub
Private Sub cmdExit_Click()
MSComm1.PortOpen = False
frmSystem.Visible = True
Unload Me
End Sub
Private Sub cmdGet_Click()
Dim SendByte(1 To 2) As Byte
SendByte(1) = 250
SendByte(2) = 185
Recchar = MSComm1.Input
MSComm1.Output = SendByte
T = GetTickCount
Do
DoEvents
Loop Until GetTickCount - T > 100
Recchar = MSComm1.Input
Buf = ""
SS = ""
For X = LBound(Recchar) To UBound(Recchar)
SS = Hex(Recchar(X))
If Len(SS) = 1 Then SS = "0" + SS
Buf = Buf + SS
Next X
If Mid(Buf, 9, 8) = "" Then
ElseIf Mid(Buf, 9, 8) <> "07F9FFFA" Then
MsgBox "此卡号是" + Mid(Buf, 3, 2) + "在数据库中已经存在！", vbOKOnly, "系统提示"
End If
txtNeiMa.Text = Mid(Buf, 1, 8)
SendByte(1) = 250
SendByte(2) = 177
MSComm1.Output = SendByte
T = GetTickCount
Do
DoEvents
Loop Until GetTickCount - T > 80
Recchar = MSComm1.Input
Buf = ""
For I = LBound(Recchar) To UBound(Recchar)
Buf = Hex(Recchar(I)) + Buf
Next I
txtRec.Text = "现有记录 " + Hex_D(Buf) + " 条"
End Sub
Private Sub cmdGETtime_Click()
Dim sMonth, sDay, sHour, sMinute, sSecond, sYear As String
Dim SendByte(1 To 2) As Byte
sYear = Year(Date)
txtRec.Text = ""
SendByte(1) = 250
SendByte(2) = 179
aa = MSComm1.Input
MSComm1.Output = SendByte
T = GetTickCount
Do
DoEvents
Loop Until GetTickCount - T > 80
Recchar = MSComm1.Input
Buf = ""
For I = LBound(Recchar) To UBound(Recchar)
Buf = Hex(Recchar(I))
If Len(Buf) = 1 Then
Buf = "0" + Buf
End If
Select Case I
Case 4
sMonth = Buf
Case 3
sDay = Buf
Case 2
sHour = Buf
Case 1
sMinute = Buf
Case 0
sSecond = Buf
End Select
Next I
If Left(sMonth, 1) = "9" Then
sMonth = "1" + Right(sMonth, 1)
End If
txtRec.Text = sYear + "年" + sMonth + "月" + sDay + "日" + Chr(13) + Chr(10)
txtRec.Text = txtRec.Text + " " + sHour + "时" + sMinute + "分" + sSecond + "秒"
End Sub
Private Sub cmdSetNew_Click()
If MsgBox("请您先录入数据，以免打卡机内数据丢失．", vbYesNo + vbDefaultButton1, "系统提示") = vbYes Then
MSComm1.PortOpen = False
frmSet_rec.Show
Unload Me
Else
Dim SedStr(1 To 13) As Byte '发送内码命令
Dim B(1 To 8) As Integer '分解内码数组
Dim SendStr(1 To 6) As Byte '发送记录总数数组
Dim AStr, SSTR As String
Dim J, MM, MMA, L, MA0, MA1, MA2, MAA, MAB As Integer
Dim T As Long
'记录数
T = GetTickCount
Set adoRs = adoCon.Execute("select count(*) from Card")
MMA = Val(adoRs(0))
MA0 = Int(MMA / 4096)
MA1 = Int((MMA - MA0 * 4096) / 256)
MA2 = Int((MMA - MA0 * 4096 - MA1 * 256) / 16)
MA3 = Int(MMA - MA0 * 4096 - MA1 * 256 - MA2 * 16)
MAA = MAO * 16 + MA1
MAB = MA2 * 16 + MA3
SendStr(1) = 250
SendStr(2) = 187
SendStr(4) = 0
SendStr(6) = 11
For J = 1 To 4
SendStr(3) = Val(20 + J)
Select Case J
Case 1
SendStr(5) = Val(MAB)
Case 2
SendStr(5) = Val(MAA)
Case 3
SendStr(5) = 0
Case 4
SendStr(5) = 0
End Select
MSComm1.Output = SendStr
Next J
'数据
Set adoRs = adoCon.Execute("select * from Card order by NeiMa")
J = 1
Do While Not adoRs.EOF
For I = 1 To 8
SS = adoRs!NeiMa
AStr = Mid(SS, I, 1)
If Not IsNumeric(AStr) Then
AStr = CStr(Asc(AStr) - 55)
End If
B(I) = Val(AStr)
Next I
MMT = 0 + (J - 1) * 8
M0 = Int(MMT / 4096)
M1 = Int((MMT - M0 * 4096) / 256)
M2 = Int((MMT - M0 * 4096 - M1 * 256) / 16)
M3 = Int((MMT - M0 * 4096 - M1 * 256 - M2 * 16))
MH = M0 * 16 + M1 + 12 * 16
ML = M2 * 16 + M3
MMA = J - 1
SedStr(1) = 250
SedStr(2) = 189
SedStr(3) = ML
SedStr(4) = MH
SedStr(5) = B(1) * 16 + B(2)
SedStr(6) = B(3) * 16 + B(4)
SedStr(7) = B(5) * 16 + B(6)
SedStr(8) = B(7) * 16 + B(8)
MMA = Trim(adoRs!CardID)
MAO = Int(MMA / 1000)
MA1 = Int((MMA - MA0 * 1000) / 100)
MA2 = Int((MMA - MA0 * 1000 - MA1 * 100) / 10)
MA3 = Int(MMA - MA0 * 1000 - MA1 * 100 - MA2 * 10)
MMAA = MAO * 16 + MA1
MAB = MA2 * 16 + MA3
SedStr(9) = MMAA
SedStr(10) = MAB
SedStr(11) = 0
SedStr(12) = 0
SedStr(13) = 171
MSComm1.Output = SedStr
eee = ""
adoRs.MoveNext
J = J + 1
Loop
txtRec.Text = "使用时间" + CStr(Int((GetTickCount - T) / 1000 / 60)) + "分" + CStr(((GetTickCount - T) / 1000) Mod 60) + "秒"
End If
End Sub
Private Sub cmdSetTime_Click()
Dim Month, Day, Hour, Minute, Second As String
Dim SendTime(1 To 7) As Byte
Month = Mid(txtDate.Text, 6, 2)
Day = Mid(txtDate.Text, 9, 2)
Hour = Mid(txtTime.Text, 1, 2)
Minute = Mid(txtTime.Text, 4, 2)
Second = Mid(txtTime.Text, 7, 2)
SendTime(1) = 250
SendTime(2) = 180
SendTime(3) = Val(Hex_D(CStr(Month)))
SendTime(4) = Val(Hex_D(CStr(Day)))
SendTime(5) = Val(Hex_D(CStr(Hour)))
SendTime(6) = Val(Hex_D(CStr(Minute)))
SendTime(7) = Val(Hex_D(CStr(Second)))
MSComm1.Output = SendTime
End Sub
Private Sub Ref()
With AdoFind
.ConnectionString = RtnStr
.RecordSource = "select CardID as 卡号,NeiMa as 卡内置码 from Card "
.Refresh
End With
End Sub
Private Sub Form_Load()
Me.Move (Screen.Width - Me.Width) / 2, (Screen.Height - Me.Height) / 2 - 600
framehelp.Visible = True
Frame1.Visible = False
Temp = False
If MSComm1.PortOpen Then
MSComm1.PortOpen = False
End If
Set adoRs = adoCon.Execute("select * from Card")
MSComm1.PortOpen = True
txtTime.Text = Time$
txtDate.Text = Date$
txtRec.Text = ""
txtNeiMa.Text = ""
With cobCom
.Clear
.AddItem "COM1"
.AddItem "COM2"
.AddItem "COM3"
.AddItem "COM4"
.ListIndex = 0
End With
Call Ref
End Sub
Private Sub Picture_Click()
If Add_ad = 6 Then
CMDAD.Enabled = True
CMDAD.Value = True
Add_ad = 1
End If
Add_ad = Add_ad + 1
End Sub
Private Sub Timer2_Timer()
txtTime.Text = Time$
txtDate.Text = Date$
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -