www.pudn.com > 档案管理系统源码VB.zip > frmOperator.frm
VERSION 5.00
Object = "{5E9E78A0-531B-11CF-91F6-C2863C385E30}#1.0#0"; "MSFLXGRD.OCX"
Begin VB.Form frmOperator
BorderStyle = 3 'Fixed Dialog
Caption = "操作用户管理< 系统管理员 >"
ClientHeight = 3600
ClientLeft = 45
ClientTop = 615
ClientWidth = 6120
Icon = "frmOperator.frx":0000
LinkTopic = "Form1"
LockControls = -1 'True
MaxButton = 0 'False
MDIChild = -1 'True
MinButton = 0 'False
NegotiateMenus = 0 'False
ScaleHeight = 3600
ScaleWidth = 6120
ShowInTaskbar = 0 'False
Begin VB.ComboBox cmbAuthority
Height = 300
ItemData = "frmOperator.frx":0442
Left = 4365
List = "frmOperator.frx":0452
Style = 2 'Dropdown List
TabIndex = 3
Top = 2355
Width = 1530
End
Begin VB.Frame Frame1
Caption = "操作员列表"
ForeColor = &H00800000&
Height = 2160
Left = 210
TabIndex = 12
Top = 1185
Width = 3375
Begin MSFlexGridLib.MSFlexGrid Grid1
Height = 1695
Left = 120
TabIndex = 6
ToolTipText = "双击显示菜单!"
Top = 315
Width = 3135
_ExtentX = 5530
_ExtentY = 2990
_Version = 393216
Cols = 3
FixedCols = 0
ForeColor = 0
ForeColorFixed = 64
BackColorSel = 14737632
ForeColorSel = 255
BackColorBkg = 12632256
GridColorFixed = 8421504
AllowBigSelection= 0 'False
FocusRect = 0
FillStyle = 1
ScrollBars = 2
SelectionMode = 1
AllowUserResizing= 3
BorderStyle = 0
Appearance = 0
End
Begin VB.Line Line8
BorderColor = &H00FFFFFF&
X1 = 105
X2 = 3270
Y1 = 2010
Y2 = 2010
End
Begin VB.Line Line7
BorderColor = &H00FFFFFF&
X1 = 3255
X2 = 3255
Y1 = 315
Y2 = 2025
End
Begin VB.Line Line6
BorderColor = &H00808080&
X1 = 105
X2 = 3270
Y1 = 300
Y2 = 300
End
Begin VB.Line Line5
BorderColor = &H00808080&
X1 = 105
X2 = 105
Y1 = 315
Y2 = 2010
End
End
Begin VB.TextBox Text1
Height = 300
Left = 4365
MaxLength = 5
TabIndex = 0
Top = 1305
Width = 1530
End
Begin VB.TextBox Text2
Height = 300
IMEMode = 3 'DISABLE
Left = 4365
MaxLength = 20
PasswordChar = "*"
TabIndex = 1
Top = 1650
Width = 1530
End
Begin VB.TextBox Text3
Height = 300
IMEMode = 3 'DISABLE
Left = 4365
MaxLength = 20
PasswordChar = "*"
TabIndex = 2
Top = 1995
Width = 1530
End
Begin VB.CommandButton Command1
Caption = "保存(S)"
Enabled = 0 'False
Height = 375
Left = 3660
TabIndex = 4
Top = 2970
Width = 1110
End
Begin VB.CommandButton Command2
Cancel = -1 'True
Caption = "关闭(&C)"
Height = 375
Left = 4830
TabIndex = 5
Top = 2970
Width = 1110
End
Begin VB.PictureBox Picture1
BackColor = &H0000C000&
Height = 750
Left = 165
ScaleHeight = 690
ScaleWidth = 5715
TabIndex = 7
ToolTipText = "操作提示"
Top = 180
Width = 5775
Begin VB.Label Label6
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "添加新的帐号"
ForeColor = &H00FFFFFF&
Height = 180
Left = 2610
TabIndex = 11
Top = 150
Width = 1080
End
Begin VB.Label Label5
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "=> 输入各项之后,按保存"
ForeColor = &H00000000&
Height = 180
Left = 2835
TabIndex = 10
Top = 405
Width = 1980
End
Begin VB.Label Label7
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "删除存在的帐号："
ForeColor = &H00FFFFFF&
Height = 180
Left = 150
TabIndex = 9
Top = 150
Width = 1440
End
Begin VB.Label Label8
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "=> 双击选定的帐号"
Height = 180
Left = 540
TabIndex = 8
Top = 405
Width = 1530
End
End
Begin VB.Label Label3
AutoSize = -1 'True
Caption = "权限："
ForeColor = &H000000C0&
Height = 180
Index = 1
Left = 3765
TabIndex = 16
Top = 2415
Width = 540
End
Begin VB.Line Line3
BorderColor = &H00E0E0E0&
Index = 2
X1 = 6090
X2 = 6090
Y1 = 15
Y2 = 3570
End
Begin VB.Line Line2
BorderColor = &H00808080&
Index = 2
X1 = 6075
X2 = 6075
Y1 = 15
Y2 = 3540
End
Begin VB.Line Line3
BorderColor = &H00E0E0E0&
Index = 0
X1 = 30
X2 = 30
Y1 = 15
Y2 = 3540
End
Begin VB.Line Line2
BorderColor = &H00808080&
Index = 0
X1 = 15
X2 = 15
Y1 = 0
Y2 = 3540
End
Begin VB.Line Line1
BorderColor = &H00808080&
Index = 4
X1 = 30
X2 = 6090
Y1 = 3540
Y2 = 3540
End
Begin VB.Line Line1
BorderColor = &H00E0E0E0&
Index = 3
X1 = 15
X2 = 6090
Y1 = 3555
Y2 = 3555
End
Begin VB.Line Line1
BorderColor = &H00E0E0E0&
Index = 2
X1 = 45
X2 = 6090
Y1 = 15
Y2 = 15
End
Begin VB.Line Line1
BorderColor = &H00808080&
Index = 0
X1 = 15
X2 = 6090
Y1 = 0
Y2 = 0
End
Begin VB.Label Label1
AutoSize = -1 'True
Caption = "姓名："
Height = 180
Left = 3765
TabIndex = 15
Top = 1350
Width = 615
End
Begin VB.Label Label2
AutoSize = -1 'True
Caption = "口令："
Height = 180
Left = 3765
TabIndex = 14
Top = 1710
Width = 615
End
Begin VB.Label Label3
AutoSize = -1 'True
Caption = "重复："
Height = 180
Index = 0
Left = 3765
TabIndex = 13
Top = 2055
Width = 615
End
Begin VB.Line Line1
Index = 1
X1 = 150
X2 = 5940
Y1 = 960
Y2 = 960
End
Begin VB.Line Line2
BorderColor = &H00FFFFFF&
Index = 1
X1 = 150
X2 = 5925
Y1 = 975
Y2 = 975
End
Begin VB.Line Line3
BorderColor = &H00FFFFFF&
Index = 1
X1 = 3600
X2 = 5940
Y1 = 2850
Y2 = 2850
End
Begin VB.Line Line4
X1 = 3600
X2 = 5940
Y1 = 2835
Y2 = 2835
End
Begin VB.Menu MnuOperate
Caption = "帐号操作^&C)"
Begin VB.Menu MnuAdd
Caption = "添加帐号[&A]"
Shortcut = ^A
End
Begin VB.Menu Line02
Caption = "-"
End
Begin VB.Menu MnuDelete
Caption = "删除帐号[&D] ..."
Shortcut = {DEL}
End
Begin VB.Menu Line01
Caption = "-"
Visible = 0 'False
End
End
Begin VB.Menu MnuReturn
Caption = "关闭选择^&O)"
Begin VB.Menu MnuAuthority
Caption = "返回首页[&A]..."
Shortcut = ^R
End
End
End
Attribute VB_Name = "frmOperator"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim DelNO As Integer, UserStr As String
Private Sub cmbAuthority_Change()
If KeyAscii = 13 Then
SendKeys "{tab}"
End If
End Sub
Private Sub cmbAuthority_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
SendKeys "{Tab}"
End If
End Sub
Private Sub Command1_Click()
If InStr(1, Trim(Text1.Text), "'", vbTextCompare) Then
MsgBox "操作员姓名之中有特殊字符" + "<'>,请删除。", vbOKOnly + 48, "提示："
Text1.SetFocus
Exit Sub
End If
On Error Resume Next
'校对数据库是否已经存在该操作员
Dim DB As Database, EF As Recordset, RecStr As String
DBEngine.BeginTrans
Set DB = OpenDatabase(ConData, False, False, ConStr)
Set EF = DB.OpenRecordset("User", dbOpenDynaset)
RecStr = "UID='" & Trim(Text1.Text) & "'"
EF.FindFirst RecStr
If Not EF.NoMatch Then
EF.Close
DB.Close
MsgBox "操作员< " & Trim(Text1.Text) & " >已经存在,不能继续! ", vbInformation
Text1.Text = ""
Text1.SetFocus
Exit Sub
End If
EF.Close
'UserText = Text1.Text
'保存
'如果要加密的话，请将 Text2.text 的文本加密!
'别忘记在登录时，要进行解密!
Dim shiftStr As String, shiftStrR As Variant, shiftNum As Integer, ili As Integer, SureStr As String
shiftStr = Trim(Text2.Text)
shiftNum = Len(shiftStr)
ili = 1
SureStr = ""
For ili = 1 To shiftNum
shiftStrR = Mid(shiftStr, ili, 1)
shiftStrR = Asc(shiftStrR)
shiftStrR = shiftStrR - 3
shiftStrR = Chr(shiftStrR)
SureStr = SureStr & shiftStrR
Next
'保存记录
RecStr = "Insert into User (UID,PWD,权限) values('" & Trim(Text1.Text) & "','" & Trim(SureStr) & "','" & cmbAuthority.Text & "')"
DB.Execute RecStr
DB.Close
DBEngine.CommitTrans
'刷新记录
LoadOperator
Text1.Text = "" '刷新数据
Text2.Text = ""
Text3.Text = ""
Text1.SetFocus
End Sub
Private Sub Command2_Click()
Unload Me
End Sub
Private Sub Form_Load()
On Error Resume Next
frmOperator.HelpContextID = 5
Me.Left = Val(GetSetting(App.EXEName, "Operator", "Left"))
Me.Top = Val(GetSetting(App.EXEName, "Operator", "Top"))
'安装操作员
LoadOperator
cmbAuthority.ListIndex = 0
End Sub
Private Sub Form_Unload(Cancel As Integer)
SaveSetting App.EXEName, "Operator", "Left", Me.Left
SaveSetting App.EXEName, "Operator", "Top", Me.Top
End Sub
Private Sub Grid1_DblClick()
If Grid1.Text = "" Then
MnuDelete.Enabled = False
MnuAuthority.Enabled = False
Else
MnuDelete.Enabled = True
MnuAuthority.Enabled = True
End If
PopupMenu MnuOperate
End Sub
Private Sub Grid1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Grid1.Text = "" Then
MnuDelete.Enabled = False
MnuAuthority.Enabled = False
Else
MnuDelete.Enabled = True
MnuAuthority.Enabled = True
End If
If Button = 2 Then
PopupMenu MnuOperate
End If
End Sub
Private Sub MnuAdd_Click()
Text1.SetFocus
End Sub
Private Sub MnuAuthority_Click()
GetStatus "返回首页"
Unload Me
End Sub
Private Sub MnuDelete_Click()
DeleteRecord
End Sub
Private Sub MnuOperate_Click()
GetStatus "帐号删除、添加操作"
End Sub
Private Sub Text1_Change()
If Trim(Text1.Text) <> "" Then
Command1.Enabled = True
Else
Command1.Enabled = False
End If
End Sub
Private Sub Text1_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 And Trim(Text1.Text) <> "" Then
SendKeys "{tab}"
End If
End Sub
Private Sub Text2_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
SendKeys "{tab}"
End If
End Sub
Private Sub Text3_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
SendKeys "{tab}"
End If
End Sub
Private Sub Text3_LostFocus()
If Trim(Text3.Text) <> Trim(Text2.Text) Then
MsgBox "两次口令不符，请重新再来 ", vbOKOnly + 64, "口令不符"
Text2.Text = ""
Text3.Text = ""
Text2.SetFocus
End If
End Sub
Private Sub DeleteRecord()
On Error Resume Next
If Grid1.Text = "" Then Exit Sub
If DelNO = 1 Then
MsgBox "仅剩下当前用户了,不能继续,请注意! ", vbOKOnly + 32, "不能删除"
Exit Sub
End If
Dim Qp As Integer
Qp = MsgBox("真的要删除[" & Grid1.Text & "]操作员吗（Y/N）？", vbYesNo + 16 + vbDefaultButton2, "确认删除")
If Qp = 7 Then
Exit Sub
End If
Dim DB As Database, RecStr As String
DBEngine.BeginTrans
Set DB = OpenDatabase(ConData, False, False, ConStr)
RecStr = "Delete * From User Where UID='" & Grid1.Text & "'"
DB.Execute RecStr
DB.Close
DBEngine.CommitTrans
'刷新记录
LoadOperator
End Sub
Private Sub LoadOperator()
'配置网格
Grid1.Visible = False
Grid1.Clear
Grid1.Cols = 3
Grid1.FormatString = "^ 操作员 |^ 口令 |^ 权限 "
Grid1.ColWidth(0) = 800
Grid1.ColWidth(1) = 1210
Grid1.ColWidth(2) = 1130
Dim DB As Database, EF As Recordset, HH As Integer
Dim shiftStr As String, shiftStrL As String, shiftStrR As String, shiftNum As Integer, ili As Integer, tempStr As String, SureStr As String, Qy As Integer
Set DB = OpenDatabase(ConData, False, False, ConStr)
Set EF = DB.OpenRecordset("User", dbOpenTable)
DelNO = EF.RecordCount
Grid1.Rows = EF.RecordCount + 4
Set EF = DB.OpenRecordset("Select * From User", dbOpenDynaset)
HH = 1
Do While Not EF.EOF()
Grid1.Row = HH
Grid1.Col = 0
Grid1.CellAlignment = 1
If Not IsNull(EF.Fields(0).Value) Then
Grid1.Text = EF.Fields(0).Value
UserStr = Grid1.Text
End If
Grid1.Row = HH
Grid1.Col = 1
Grid1.CellAlignment = 1
If Not IsNull(EF.Fields(1).Value) Then
'解口令为可视
shiftStr = Trim(EF.Fields(1).Value)
shiftNum = Len(shiftStr)
ili = 1
SureStr = ""
Qy = 0
For ili = 1 To shiftNum
shiftStrR = Mid(shiftStr, ili, 1)
shiftStrR = Asc(shiftStrR)
shiftStrR = shiftStrR + 3
shiftStrR = Chr(shiftStrR)
SureStr = SureStr & shiftStrR
Next
'因为是超级用户,所以可以看见所有的帐号密码
Grid1.Text = SureStr
End If
Grid1.Row = HH
Grid1.Col = 2
Grid1.CellAlignment = 1
If Not IsNull(EF.Fields(2).Value) Then
Grid1.Text = EF.Fields(2).Value
End If
EF.MoveNext
HH = HH + 1
Loop
EF.Close
DB.Close
Grid1.Col = 0
Grid1.Row = 1
Grid1.ColSel = 2
Grid1.Visible = True
End Sub