www.pudn.com > 考勤管理系统源码(VB含串口接口程序).zip > BatchSetup.frm
VERSION 5.00
Object = "{6B7E6392-850A-101B-AFC0-4210102A8DA7}#1.3#0"; "COMCTL32.OCX"
Begin VB.Form frmNewCard
BackColor = &H00C0C0C0&
BorderStyle = 3 'Fixed Dialog
Caption = "发新卡"
ClientHeight = 5295
ClientLeft = 45
ClientTop = 330
ClientWidth = 5790
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Icon = "BatchSetup.frx":0000
LinkTopic = "Form1"
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 5295
ScaleWidth = 5790
StartUpPosition = 1 '所有者中心
Begin ComctlLib.StatusBar sbrState
Align = 2 'Align Bottom
Height = 315
Left = 0
TabIndex = 17
Top = 4980
Width = 5790
_ExtentX = 10213
_ExtentY = 556
SimpleText = ""
_Version = 327682
BeginProperty Panels {0713E89E-850A-101B-AFC0-4210102A8DA7}
NumPanels = 1
BeginProperty Panel1 {0713E89F-850A-101B-AFC0-4210102A8DA7}
Object.Width = 10372
MinWidth = 10372
Key = "State"
Object.Tag = ""
Object.ToolTipText = "状态提示"
EndProperty
EndProperty
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
End
Begin VB.Frame fraSetup
BeginProperty Font
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 4590
Left = 210
TabIndex = 10
Top = 120
Width = 3915
Begin VB.TextBox txtName
Height = 345
Left = 2370
TabIndex = 4
Top = 2550
Width = 1245
End
Begin VB.TextBox txtPassWord
Height = 345
IMEMode = 3 'DISABLE
Left = 2385
MaxLength = 6
PasswordChar = "*"
TabIndex = 5
Text = "b62307"
Top = 3345
Width = 1245
End
Begin VB.TextBox txtNewPassWord
Height = 345
Left = 2385
MaxLength = 6
TabIndex = 7
Top = 3855
Visible = 0 'False
Width = 1245
End
Begin VB.CheckBox chkChangePass
Caption = "更改密码"
Enabled = 0 'False
Height = 315
Left = 285
TabIndex = 6
Top = 3870
Width = 1230
End
Begin VB.TextBox txtSetup
Enabled = 0 'False
Height = 345
Index = 3
Left = 2370
MaxLength = 5
TabIndex = 3
Text = "0"
Top = 1875
Width = 1245
End
Begin VB.TextBox txtSetup
Enabled = 0 'False
Height = 345
Index = 2
Left = 2370
MaxLength = 3
TabIndex = 2
Text = "0"
Top = 1395
Width = 1245
End
Begin VB.TextBox txtSetup
Height = 345
Index = 1
Left = 2370
MaxLength = 4
TabIndex = 1
Top = 825
Width = 1245
End
Begin VB.TextBox txtSetup
Enabled = 0 'False
Height = 345
Index = 0
Left = 2370
MaxLength = 4
TabIndex = 0
Text = "WZMG"
Top = 345
Width = 1245
End
Begin VB.Label lblSetup
AutoSize = -1 'True
Caption = "姓名："
Height = 210
Index = 4
Left = 285
TabIndex = 18
Top = 2617
Width = 630
End
Begin VB.Label lblNewPassWord
AutoSize = -1 'True
Caption = "新密码:"
Height = 210
Left = 1575
TabIndex = 16
Top = 3915
Visible = 0 'False
Width = 735
End
Begin VB.Label lblPassWord
AutoSize = -1 'True
Caption = "IC卡校验密码:"
Height = 210
Left = 285
TabIndex = 15
Top = 3405
Width = 1365
End
Begin VB.Label lblSetup
AutoSize = -1 'True
Caption = "交易数据(0-65535):"
Height = 210
Index = 3
Left = 285
TabIndex = 14
Top = 1935
Width = 1890
End
Begin VB.Label lblSetup
AutoSize = -1 'True
Caption = "状态代码(0-255):"
Height = 210
Index = 2
Left = 285
TabIndex = 13
Top = 1455
Width = 1680
End
Begin VB.Label lblSetup
AutoSize = -1 'True
Caption = "个人代码(4个字符):"
Height = 210
Index = 1
Left = 285
TabIndex = 12
Top = 885
Width = 1890
End
Begin VB.Label lblSetup
AutoSize = -1 'True
Caption = "IC卡代码(4个字符):"
Height = 210
Index = 0
Left = 285
TabIndex = 11
Top = 405
Width = 1890
End
End
Begin VB.CommandButton cmdExit
Caption = "退出(&X)"
Height = 420
Left = 4380
TabIndex = 9
Top = 780
Width = 1155
End
Begin VB.CommandButton cmdWrite
Caption = "写卡(&W)"
Height = 420
Left = 4380
TabIndex = 8
Top = 240
Width = 1125
End
End
Attribute VB_Name = "frmNewCard"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Const CID = 0
Const PID = 1
Const SID = 2
Const DATA = 3
Const Emp_Name = 4
'Public mblnIsBatch As Boolean
Const mstrParaErr = "写卡参数不能为空,请输入!"
Const mstrDataErr = "交易数据超出范围(0-65535)!,请重输!"
Const mstrWriteErr = "写卡错误"
Const mstrCIDErr = "IC卡代码必须是4个字符!"
Const mstrPIDErr = "个人代码必须是4个字符!"
Const mstrSIDErr = "状态代码超出范围(0-255)!,请重输!"
Const mstrPSWErr = "IC卡检验密码必须是6个字符!"
Const mstrNoCardErr = "无卡,请插入卡后再操作!"
Const mstrPowerOnErr = "无法上电,请检查电源及其他相关硬件后,再试!"
Const mstrCheckPSWErr = "校验密码不正确"
Const mstrWriteMainErr = "写主存储区错误"
Const mstrChgPswErr = "更改密码错误"
Const mstrReadMainErr = "读主存储区错误"
Const mstrCheckDataErr = "所读数据与所写数据不同错误"
Const mstrSuccessMsg = "写卡成功,请取出卡!"
Const mstrPSWCheck = "检查密码..."
Const mstrWMainCheck = "写主存储区..."
Const mstrRMainCheck = "读主存储区..."
Const mstrChgPSWCheck = "更改密码..."
'Const mstrWriteToDatabase = "正在写数据库..."
Const mstrReady = "等待开始写卡..."
Private Sub chkChangePass_Click()
If chkChangePass.Value = 1 Then
lblNewPassWord.Visible = True
txtNewPassWord.Visible = True
Else
lblNewPassWord.Visible = False
txtNewPassWord.Visible = False
End If
End Sub
Private Sub chkChangePass_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = 13 Then
SendKeyTab KeyCode
End If
End Sub
Private Sub cmdExit_Click()
Unload Me
End Sub
Private Sub cmdWrite_Click()
Dim strTemp As String
Dim strWrite As String
Dim strWriteDot As String
Dim i As Integer
Dim nRet As Integer
Dim strEncode As String
Dim nData(3) As Byte
Dim strCID As String
Dim strPID As String
Dim strSID As String
Dim strDATA As String
Dim strPSW As String
Dim strNewPSW As String
Dim blnIsToMsg As Boolean
Dim strMsgTitle As String
Dim blnIsOpen As Boolean
blnIsOpen = False
blnIsToMsg = False
strCID = Trim(txtSetup(CID))
strPID = Trim(txtSetup(PID))
strSID = Trim(txtSetup(SID))
strDATA = Trim(txtSetup(DATA))
strPSW = Trim(txtPassword)
If chkChangePass.Value = 1 Then
strNewPSW = Trim(txtNewPassWord)
End If
On Error GoTo WriteErr
For i = 0 To 3
If txtSetup(i).Text = "" Then
MsgBox mstrParaErr, vbInformation, gTitle
txtSetup(i).SetFocus
Exit Sub
End If
Next i
If Len(strCID) <> 4 Then
MsgBox mstrCIDErr, vbInformation, gTitle
txtSetup(CID).SetFocus
Exit Sub
End If
If Len(strPID) <> 4 Then
MsgBox mstrPIDErr, vbInformation, gTitle
txtSetup(PID).SetFocus
Exit Sub
End If
If Val(strSID) < 0 Or Val(strSID) > 255 Then
MsgBox mstrSIDErr, vbInformation, gTitle
txtSetup(SID).SetFocus
Exit Sub
End If
If Val(strDATA) < 0 Or Val(strDATA) > 65535 Then
MsgBox mstrDataErr, vbInformation, gTitle
txtSetup(DATA).SetFocus
Exit Sub
End If
If Len(strPSW) <> 6 Then
MsgBox mstrPSWErr, vbInformation, gTitle
txtPassword.SetFocus
Exit Sub
End If
If OpenComm(gCommPort) <> 0 Then
MsgBox mstrOpenCommErr, vbInformation, gTitle
GoTo WriteErr
End If
blnIsOpen = True
nRet = CardExist
If nRet = 0 Then
MsgBox mstrNoCardErr, vbInformation, gTitle
Exit Sub
End If
blnIsToMsg = True
strWrite = ""
For i = 1 To 4
strTemp = Hex(Asc(Mid(strCID, i, 1)))
strWrite = strWrite & IIf(Len(strTemp) = 1, "0" & strTemp, strTemp)
Next
For i = 1 To 4
strTemp = Hex(Asc(Mid(strPID, i, 1)))
strWrite = strWrite & IIf(Len(strTemp) = 1, "0" & strTemp, strTemp)
Next
strTemp = Hex(Val(strSID))
strWrite = strWrite & IIf(Len(strTemp) = 1, "0" & strTemp, strTemp)
'strEncode = txtSetup(PID) 'Only for Test!!!!!!
nData(0) = Val(strDATA) \ 256
nData(1) = Val(strDATA) Mod 256
nData(2) = (((Asc(Mid(strPID, 1, 1)) + Asc(Mid(strPID, 2, 1))) Xor nData(0)) + nData(1)) Mod 256
nData(3) = ((Asc(Mid(strPID, 3, 1)) + Asc(Mid(strPID, 4, 1)) Xor nData(1)) + nData(2)) Mod 256
For i = 0 To 3
strTemp = Hex(nData(i))
strWrite = strWrite & IIf(Len(strTemp) = 1, "0" & strTemp, strTemp)
Next
nRet = PowerOn
If nRet <> 0 Then
MsgBox mstrPowerOnErr, vbInformation, gTitle
Exit Sub
End If
chgLblState mstrPSWCheck
nRet = IC_PSCCheck(strPSW)
If nRet <> 0 Then
strMsgTitle = mstrCheckPSWErr
GoTo WriteErr
End If
chgLblState mstrWMainCheck
nRet = IC_WriteMain(dwOffset, dwLength, strWrite)
If nRet <> 0 Then
strMsgTitle = mstrWriteMainErr
GoTo WriteErr
End If
strTemp = Space(64)
strWriteDot = ""
For i = 1 To Len(txtName.Text)
nRet = ReadDot(Asc(Mid(txtName.Text, i, 1)), strTemp)
strWriteDot = strWriteDot & strTemp
Next
If Len(strWriteDot) < 192 Then
strWriteDot = strWriteDot & String(192 - Len(strWriteDot), "0")
End If
nRet = IC_WriteMain(dwNameOffset, dwNameLength, strWriteDot)
If nRet <> 0 Then
strMsgTitle = mstrWriteMainErr
GoTo WriteErr
End If
If chkChangePass.Value = 1 Then
chgLblState mstrChgPSWCheck
nRet = IC_ChangePass(strNewPSW)
If nRet <> 0 Then
'MsgBox "Password Change Error"
strMsgTitle = mstrChgPswErr
GoTo WriteErr
End If
End If
strTemp = Space(2 * dwLength)
chgLblState mstrRMainCheck
nRet = IC_ReadMain(dwOffset, dwLength, strTemp)
If nRet <> 0 Then
strMsgTitle = mstrReadMainErr
GoTo WriteErr
End If
If strTemp <> strWrite Then
strMsgTitle = mstrCheckDataErr
Exit Sub
End If
nRet = PowerOff
CloseComm
blnIsOpen = False
chgLblState mstrReady
'If mblnIsBatch Then Unload Me
Exit Sub
WriteErr:
If blnIsOpen Then
PowerOff
CloseComm
End If
If blnIsToMsg Then
Dim strTitle As String
If isEmpty(strMsgTitle) Then
strTitle = mstrWriteErr
Else
strTitle = strMsgTitle
End If
MsgBox strTitle, vbCritical, mstrWriteErr
End If
Exit Sub
End Sub
Private Sub chgLblState(strMsg As String)
With sbrState.Panels(1)
.Text = strMsg
End With
End Sub
Private Sub Form_Load()
sbrState.Panels(1).Width = Me.ScaleWidth
chgLblState mstrReady
End Sub
Private Sub txtNewPassWord_GotFocus()
GotFocus txtNewPassWord
End Sub
Private Sub txtNewPassWord_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = 13 Then
SendKeyTab KeyCode
End If
End Sub
Private Sub txtNewPassWord_KeyPress(KeyAscii As Integer)
KeyAscii = KeyFilter(KeyAscii, True)
End Sub
Private Sub txtPassword_GotFocus()
GotFocus txtPassword
End Sub
Private Sub txtPassword_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = 13 Then
SendKeyTab KeyCode
End If
End Sub
Private Sub txtSetup_GotFocus(Index As Integer)
GotFocus txtSetup(Index)
End Sub
Private Sub txtSetup_KeyDown(Index As Integer, KeyCode As Integer, Shift As Integer)
If KeyCode = 13 Then
SendKeyTab KeyCode
End If
End Sub
Private Sub txtSetup_KeyPress(Index As Integer, KeyAscii As Integer)
Select Case Index
Case SID, DATA
KeyAscii = ValiText(KeyAscii, "0123456789", True)
Case Else
KeyAscii = KeyFilter(KeyAscii, False)
End Select
End Sub