batchsetup.frm

一个用VB开发的考勤管理系统... 希望大家来看看..提出见意.. 谢谢.

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