frmpass.frm

Visual basic 数据库编程技术与实例源码 源码

End Sub

Private Sub cmdTop_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
    Call MacButton("p", frmPassword.cmdTop, 0, 0, 100, 50, frmLogin.Source, 138, 39, 3)
End Sub

Private Sub cmdUndo_Click()
    If EditMode = True Then
        Call MacButton("    Edit", frmPassword.cmdEdit, 0, 0, 73, 50, frmLogin.Source, 0, 0, 1)
    Else
        Call MacButton("   New", frmPassword.cmdNew, 0, 0, 73, 50, frmLogin.Source, 0, 0, 1)
    End If
    Press_Buttons ("Undo")
    Call MacButton("   Undo", frmPassword.cmdUndo, 0, 0, 73, 50, frmLogin.Source, 0, 0, 1)
End Sub

Private Sub cmdUndo_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    Call MacButton("   Undo", frmPassword.cmdUndo, 0, 0, 73, 50, frmLogin.Source, 74, 0, 1)
End Sub

Private Sub cmdUndo_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
    Call MacButton("   Undo", frmPassword.cmdUndo, 0, 0, 73, 50, frmLogin.Source, 0, 0, 1)
End Sub

Private Sub Form_Activate()
    On Error Resume Next
    If EditMode = False Then
        strs = "select * from USER_PASSWORD order by USER_NAME"
        Set datprimary = New adodb.Recordset
        datprimary.Open strs, myDB, 1, 3
        
        'Set datprimary = frmLogin.db.OpenRecordset(strs)
        If Not datprimary.BOF Then
            Display_Fields
        End If
            Enable_Fields (True)
            Object_Tab_Trigger (False)
            Enable_Buttons
            Enable_Buttons
            rec_Isnew = False
        If cmdNew.Enabled Then cmdNew.SetFocus
    End If
End Sub

Private Sub Form_Load()
    On Error Resume Next
    Call ColForm(BoxContainer, 217, 211, 213, 125)
    Call ColForm(ButtonContainer, 217, 211, 213, 125)
    Call ColForm(CheckContainer, 217, 211, 213, 125)
    Call CreateMacOSTitleBar(titleBar, " 权限设定")
    Call BitBlt(frmPassword.Closed.hDC, 0, 0, 73, 50, frmLogin.Source.hDC, 0, 107, SRCCOPY)
    frmPassword.Closed.Refresh
    Call BitBlt(frmPassword.Maximized.hDC, 0, 0, 73, 50, frmLogin.Source.hDC, 0, 72, SRCCOPY)
    frmPassword.Maximized.Refresh
    Call BitBlt(frmPassword.Minimized.hDC, 0, 0, 73, 50, frmLogin.Source.hDC, 0, 124, SRCCOPY)
    frmPassword.Minimized.Refresh
    KeyPreview = True
    Call MacButton("   New", frmPassword.cmdNew, 0, 0, 73, 50, frmLogin.Source, 0, 0, 1)
    Call MacButton("    Edit", frmPassword.cmdEdit, 0, 0, 73, 50, frmLogin.Source, 0, 0, 1)
    Call MacButton("   Save", frmPassword.cmdSave, 0, 0, 73, 50, frmLogin.Source, 0, 0, 1)
    Call MacButton("   Undo", frmPassword.cmdUndo, 0, 0, 73, 50, frmLogin.Source, 0, 0, 1)
    Call MacButton("  Delete", frmPassword.cmdDel, 0, 0, 73, 50, frmLogin.Source, 0, 0, 1)
    Call MacButton("   Find", frmPassword.cmdFind, 0, 0, 73, 50, frmLogin.Source, 0, 0, 1)
    Call MacButton("    Exit", frmPassword.cmdExit, 0, 0, 73, 50, frmLogin.Source, 0, 0, 1)
    Call MacButton("p", frmPassword.cmdTop, 0, 0, 100, 50, frmLogin.Source, 138, 39, 3)
    Call MacButton("u", frmPassword.cmdNext, 0, 0, 100, 50, frmLogin.Source, 138, 39, 3)
    Call MacButton("t", frmPassword.cmdPrev, 0, 0, 100, 50, frmLogin.Source, 138, 39, 3)
    Call MacButton("q", frmPassword.cmdLast, 0, 0, 100, 50, frmLogin.Source, 138, 39, 3)
    txtCombo(0).Clear
    txtCombo(0).AddItem "Administrator"
    txtCombo(0).AddItem "End-User"
End Sub

Private Sub Form_KeyUp(KeyCode As Integer, Shift As Integer)
    On Error Resume Next
    Dim AltDown
    AltDown = (Shift And vbAltMask) > 0
    Select Case KeyCode
        Case vbKeyEscape:
                Me.Hide
        Case vbKeyN:
                If AltDown Then
                    Call MacButton("   New", frmPassword.cmdNew, 0, 0, 73, 50, frmLogin.Source, 0, 0, 1)
                End If
        Case vbKeyE:
                If AltDown Then
                    Call MacButton("    Edit", frmPassword.cmdEdit, 0, 0, 73, 50, frmLogin.Source, 0, 0, 1)
                End If
        Case vbKeyS:
                If AltDown Then
                    Call MacButton("   Save", frmPassword.cmdSave, 0, 0, 73, 50, frmLogin.Source, 0, 0, 1)
                End If
        Case vbKeyU:
                If AltDown Then
                    Call MacButton("   Undo", frmPassword.cmdUndo, 0, 0, 73, 50, frmLogin.Source, 0, 0, 1)
                End If
        Case vbKeyD:
                If AltDown Then
                    Call MacButton("  Delete", frmPassword.cmdDel, 0, 0, 73, 50, frmLogin.Source, 0, 0, 1)
                End If
        Case vbKeyF:
                If AltDown Then
                    Call MacButton("   Find", frmPassword.cmdFind, 0, 0, 73, 50, frmLogin.Source, 0, 0, 1)
                End If
        Case vbKeyX:
                If AltDown Then
                    Call MacButton("    Exit", frmPassword.cmdExit, 0, 0, 73, 50, frmLogin.Source, 0, 0, 1)
                End If
        Case vbKeyLeft:
                If AltDown Then
                    Call MacButton("t", frmPassword.cmdPrev, 0, 0, 100, 50, frmLogin.Source, 138, 39, 3)
                End If
        Case vbKeyRight:
                If AltDown Then
                    Call MacButton("u", frmPassword.cmdNext, 0, 0, 100, 49, frmLogin.Source, 138, 39, 3)
                End If
        Case vbKeyUp:
                If AltDown Then
                    Call MacButton("p", frmPassword.cmdTop, 0, 0, 100, 50, frmLogin.Source, 138, 39, 3)
                End If
        Case vbKeyDown:
                If AltDown Then
                    Call MacButton("q", frmPassword.cmdLast, 0, 0, 100, 50, frmLogin.Source, 138, 39, 3)
                End If
    End Select
End Sub

Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
    On Error Resume Next
    Dim AltDown
    AltDown = (Shift And vbAltMask) > 0
    Select Case KeyCode
        Case vbKeyEscape:
                Me.Hide
        Case vbKeyF1:
                frmHelp.Show
                frmHelp.Help_Values = Space(1) & vbCrLf & _
                                      "Note: The following are Password Security Key Shortcuts." & vbCrLf & _
                                      Space(1) & vbCrLf & _
                                      "ALT-N=New, ALT-E=Edit, ALT-S=Save, ALT-U=Undo, ALT-D=Delete" & vbCrLf & _
                                      "ALT-F=Find, ALT-X=Exit" & vbCrLf & _
                                      Space(1) & vbCrLf & _
                                      "Left Arrow=Previous Records, Right Arrow=Next Records" & vbCrLf & _
                                      "Top Arrow=Top Record, Down Arrow=Last Record"
        Case vbKeyN:
                If AltDown Then
                    Call MacButton("   New", frmPassword.cmdNew, 0, 0, 73, 50, frmLogin.Source, 74, 0, 1)
                    cmdNew_Click
                End If
        Case vbKeyE:
                If AltDown Then
                    Call MacButton("    Edit", frmPassword.cmdEdit, 0, 0, 73, 50, frmLogin.Source, 74, 0, 1)
                    cmdEdit_Click
                End If
        Case vbKeyS:
                If AltDown Then
                    Call MacButton("   Save", frmPassword.cmdSave, 0, 0, 73, 50, frmLogin.Source, 74, 0, 1)
                    cmdSave_Click
                End If
        Case vbKeyU:
                If AltDown Then
                    Call MacButton("   Undo", frmPassword.cmdUndo, 0, 0, 73, 50, frmLogin.Source, 74, 0, 1)
                    cmdUndo_Click
                End If
        Case vbKeyD:
                If AltDown Then
                    Call MacButton("  Delete", frmPassword.cmdDel, 0, 0, 73, 50, frmLogin.Source, 74, 0, 1)
                    cmdDel_Click
                End If
        Case vbKeyF:
                If AltDown Then
                    Call MacButton("   Find", frmPassword.cmdFind, 0, 0, 73, 50, frmLogin.Source, 74, 0, 1)
                    cmdFind_Click
                End If
        Case vbKeyX:
                If AltDown Then
                    Call MacButton("    Exit", frmPassword.cmdExit, 0, 0, 73, 50, frmLogin.Source, 74, 0, 1)
                    cmdExit_Click
                End If
        Case vbKeyLeft:
                If AltDown Then
                    Call MacButton("t", frmPassword.cmdPrev, 0, 0, 100, 50, frmLogin.Source, 112, 39, 3)
                    cmdPrev_Click
                End If
        Case vbKeyRight:
                If AltDown Then
                    Call MacButton("u", frmPassword.cmdNext, 0, 0, 100, 49, frmLogin.Source, 112, 39, 3)
                    cmdNext_Click
                End If
        Case vbKeyUp:
                If AltDown Then
                    Call MacButton("p", frmPassword.cmdTop, 0, 0, 100, 50, frmLogin.Source, 112, 39, 3)
                    cmdTop_Click
                End If
        Case vbKeyDown:
                If AltDown Then
                    Call MacButton("q", frmPassword.cmdLast, 0, 0, 100, 50, frmLogin.Source, 112, 39, 3)
                    cmdLast_Click
                End If
    End Select
End Sub

Private Sub titleBar_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    Call DragForm(Me)
End Sub

Private Sub Closed_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    Call BitBlt(frmPassword.Closed.hDC, 0, 0, 73, 50, frmLogin.Source.hDC, 18, 107, SRCCOPY)
    frmPassword.Closed.Refresh
End Sub

Private Sub Closed_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
    Call BitBlt(frmPassword.Closed.hDC, 0, 0, 73, 50, frmLogin.Source.hDC, 0, 107, SRCCOPY)
    frmPassword.Closed.Refresh
End Sub

Private Sub Maximized_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    Call BitBlt(frmPassword.Maximized.hDC, 0, 0, 73, 50, frmLogin.Source.hDC, 18, 72, SRCCOPY)
    frmPassword.Maximized.Refresh
End Sub

Private Sub Maximized_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
    Call BitBlt(frmPassword.Maximized.hDC, 0, 0, 73, 50, frmLogin.Source.hDC, 0, 72, SRCCOPY)
    frmPassword.Maximized.Refresh
End Sub

Private Sub Minimized_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    Call BitBlt(frmPassword.Minimized.hDC, 0, 0, 73, 50, frmLogin.Source.hDC, 18, 124, SRCCOPY)
    frmPassword.Minimized.Refresh
End Sub

Private Sub Minimized_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
    Call BitBlt(frmPassword.Minimized.hDC, 0, 0, 73, 50, frmLogin.Source.hDC, 0, 124, SRCCOPY)
    frmPassword.Minimized.Refresh
End Sub

Private Sub Display_Fields()
    On Error Resume Next
    If datprimary.AbsolutePosition <> -1 Then
        txtField(0) = IIf(IsNull(datprimary("USER_NAME")), "", datprimary("USER_NAME"))
        txtField(1) = IIf(IsNull(datprimary("USER_PASSWORD")), "", UnCode_Pass(datprimary("USER_PASSWORD")))
        DatePick.Value = IIf(IsDate(datprimary("USER_BIRTHDATE")), datprimary("USER_BIRTHDATE"), Date)
        txtCombo(0) = IIf(IsNull(datprimary("USER_TYPE")), "", IIf(datprimary("USER_TYPE") = "A", "Administrator", "End-User"))
        txtCheck(0).Value = IIf(IsNull(datprimary("USER_ALLOW_SM")), 0, IIf(datprimary("USER_ALLOW_SM") = 0, 0, 1))
        txtCheck(1).Value = IIf(IsNull(datprimary("USER_ALLOW_PM")), 0, IIf(datprimary("USER_ALLOW_PM") = 0, 0, 1))
        txtCheck(2).Value = IIf(IsNull(datprimary("USER_ALLOW_CM")), 0, IIf(datprimary("USER_ALLOW_CM") = 0, 0, 1))
        txtCheck(3).Value = IIf(IsNull(datprimary("USER_ALLOW_ST")), 0, IIf(datprimary("USER_ALLOW_ST") = 0, 0, 1))
        txtCheck(4).Value = IIf(IsNull(datprimary("USER_ALLOW_RT")), 0, IIf(datprimary("USER_ALLOW_RT") = 0, 0, 1))
        txtCheck(5).Value = IIf(IsNull(datprimary("USER_ALLOW_SRR")), 0, IIf(datprimary("USER_ALLOW_SRR") = 0, 0, 1))
        txtCheck(6).Value = IIf(IsNull(datprimary("USER_ALLOW_SHR")), 0, IIf(datprimary("USER_ALLOW_SHR") = 0, 0, 1))
        txtCheck(7).Value = IIf(IsNull(datprimary("USER_ALLOW_RHR")), 0, IIf(datprimary("USER_ALLOW_RHR") = 0, 0, 1))
        txtCheck(8).Value = IIf(IsNull(datprimary("USER_ALLOW_SPSR")), 0, IIf(datprimary("USER_ALLOW_SPSR") = 0, 0, 1))
        txtCheck(9).Value = IIf(IsNull(datprimary("USER_ALLOW_PLR")), 0, IIf(datprimary("USER_ALLOW_PLR") = 0, 0, 1))
        txtCheck(10).Value = IIf(IsNull(datprimary("USER_ALLOW_SLR")), 0, IIf(datprimary("USER_ALLOW_SLR") = 0, 0, 1))
        txtCheck(11).Value = IIf(IsNull(datprimary("USER_ALLOW_BRF")), 0, IIf(datprimary("USER_ALLOW_BRF") = 0, 0, 1))
        txtCheck(12).Value = IIf(IsNull(datprimary("USER_ALLOW_PS")), 0, IIf(datprimary("USER_ALLOW_PS") = 0, 0, 1))
        txtCheck(13).Value = IIf(IsNull(datprimary("USER_ALLOW_CFS")), 0, IIf(datprimary("USER_ALLOW_CFS") = 0, 0, 1))
        txtCheck(14).Value = IIf(IsNull(datprimary("USER_ALLOW_SS")), 0, IIf(datprimary("USER_ALLOW_SS") = 0, 0, 1))
    Else
        Clear_Fields
    End If
End Sub

Private Sub Clear_Fields()
    ' ENABLE ONLY TO BLANK FIELD txtField(1)
    'txtField(0) = ""
    txtField(1) = ""
    For i = 0 To 14
        txtCheck(i) = 0
    Next i
End Sub

Private Sub Update_Fields(isNew As Boolean)
    On Error Resume Next
    If isNew Then
        datprimary.AddNew
        datprimary("USER_NAME") = txtField(0)
        datprimary("USER_PASSWORD") = txtField(1)
        datprimary("USER_BIRTHDATE") = DatePick.Value
        datprimary("USER_TYPE") = IIf(txtCombo(0) = "Administrator", "A", "E")
        datprimary("USER_ALLOW_SM") = IIf(txtCheck(0).Value = 0, 0, -1)
        datprimary("USER_ALLOW_PM") = IIf(txtCheck(1).Value = 0, 0, -1)
        datprimary("USER_ALLOW_CM") = IIf(txtCheck(2).Value = 0, 0, -1)
        datprimary("USER_ALLOW_ST") = IIf(txtCheck(3).Value = 0, 0, -1)
        datprimary("USER_ALLOW_RT") = IIf(txtCheck(4).Value = 0, 0, -1)
        datprimary("USER_ALLOW_SRR") = IIf(txtCheck(5).Value = 0, 0, -1)
        datprimary("USER_ALLOW_SHR") = IIf(txtCheck(6).Value = 0, 0, -1)
        datprimary("USER_ALLOW_RHR") = IIf(txtCheck(7).Value = 0, 0, -1)
        datprimary("USER_ALLOW_SPSR") = IIf(txtCheck(8).Value = 0, 0, -1)
        datprimary("USER_ALLOW_PLR") = IIf(txtCheck(9).Value = 0, 0, -1)
        datprimary("USER_ALLOW_SLR") = IIf(txtCheck(10).Value = 0, 0, -1)
        datprimary("USER_ALLOW_BRF") = IIf(txtCheck(11).Value = 0, 0, -1)
        datprimary("USER_ALLOW_PS") = IIf(txtCheck(12).Value = 0, 0, -1)
        datprimary("USER_ALLOW_CFS") = IIf(txtCheck(13).Value = 0, 0, -1)
        datprimary("USER_ALLOW_SS") = IIf(txtCheck(14).Value = 0, 0, -1)
        datprimary.Update
    Else
        datprimary("USER_NAME") = txtField(0)
        datprimary("USER_PASSWORD") = Decode_Pass(txtField(1))
        datprimary("USER_BIRTHDATE") = DatePick.Value
        datprimary("USER_TYPE") = IIf(txtCombo(0) = "Administrator", "A", "E")
        datprimary("USER_ALLOW_SM") = IIf(txtCheck(0).Value = 0, 0, -1)
        datprimary("USER_ALLOW_PM") = IIf(txtCheck(1).Value = 0, 0, -1)
        datprimary("USER_ALLOW_CM") = IIf(txtCheck(2).Value = 0, 0, -1)
        datprimary("USER_ALLOW_ST") = IIf(txtCheck(3).Value = 0, 0, -1)
        datprimary("USER_ALLOW_RT") = IIf(txtCheck(4).Value = 0, 0, -1)
        datprimary("USER_ALLOW_SRR") = IIf(txtCheck(5).Value = 0, 0, -1)
        datprimary("USER_ALLOW_SHR") = IIf(txtCheck(6).Value = 0, 0, -1)
        datprimary("USER_ALLOW_RHR") = IIf(txtCheck(7).Value = 0, 0, -1)
        datprimary("USER_ALLOW_SPSR") = IIf(txtCheck(8).Value = 0, 0, -1)
        datprimary("USER_ALLOW_PLR") = IIf(txtCheck(9).Value = 0, 0, -1)
        datprimary("USER_ALLOW_SLR") = IIf(txtCheck(10).Value = 0, 0, -1)
        datprimary("USER_ALLOW_BRF") = IIf(txtCheck(11).Value = 0, 0, -1)
        datprimary("USER_ALLOW_PS") = IIf(txtCheck(12).Value = 0, 0, -1)
        datprimary("USER_ALLOW_CFS") = IIf(txtCheck(13).Value = 0, 0, -1)
        datprimary("USER_ALLOW_SS") = IIf(txtCheck(14).Value = 0, 0, -1)
        datprimary.Update
    End If
    If isNew Then datprimary.MoveLast
End Sub

P