📄 administer.frm
字号:
End
Begin VB.CommandButton cm3
Caption = "创建帐户"
Height = 375
Left = 120
TabIndex = 3
Top = 960
Width = 975
End
Begin VB.Label Label2
Caption = "修改密码:"
Height = 375
Left = 120
TabIndex = 16
Top = 600
Width = 1335
End
Begin VB.Label lb1
Caption = "选择账户:"
Height = 375
Left = 120
TabIndex = 15
Top = 360
Width = 1335
End
End
Begin VB.Frame Frame3
Caption = "管理员帐户"
Height = 2055
Left = 3000
TabIndex = 17
Top = 120
Visible = 0 'False
Width = 3975
Begin VB.CommandButton Command1
Caption = "退出管理"
Height = 375
Left = 2040
TabIndex = 10
Top = 1440
Width = 975
End
Begin VB.TextBox t1
Appearance = 0 'Flat
Enabled = 0 'False
Height = 270
Index = 3
Left = 720
TabIndex = 7
Top = 1080
Width = 1215
End
Begin VB.CommandButton cm8
Caption = "取消"
Enabled = 0 'False
Height = 375
Left = 1080
TabIndex = 9
Top = 1440
Width = 975
End
Begin VB.CommandButton cm7
Caption = "确定"
Enabled = 0 'False
Height = 375
Left = 120
TabIndex = 8
Top = 1440
Width = 975
End
Begin VB.Label Label5
Caption = "新密码:"
Height = 255
Left = 120
TabIndex = 20
Top = 1080
Width = 855
End
Begin VB.Label Label4
BackColor = &H80000009&
Caption = "修改管理员密码:"
Height = 255
Left = 120
TabIndex = 19
Top = 600
Width = 1455
End
Begin VB.Label Label3
Caption = "管理员初始密码为:666666"
Height = 255
Left = 120
TabIndex = 18
Top = 240
Width = 2295
End
End
End
Begin VB.TextBox Text1
Appearance = 0 'Flat
Height = 270
IMEMode = 3 'DISABLE
Left = 2520
PasswordChar = "*"
TabIndex = 0
Top = 840
Width = 1575
End
Begin VB.Label Label6
Caption = " 确 定"
Height = 255
Left = 4440
TabIndex = 21
Top = 840
Width = 975
End
Begin VB.Label Label1
Caption = "请输入管理员密码:"
Height = 255
Left = 480
TabIndex = 12
Top = 840
Width = 1575
End
End
End
Attribute VB_Name = "administer"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim rs As New ADODB.Recordset
Dim RS1 As New ADODB.Recordset
Dim RS2 As New ADODB.Recordset
'Dim RS2 As New ADODB.Recordset
Dim myIndex As Integer
Dim gradeStore, Keys, Parents As String '贮存GRADE值
Dim Grade As Integer '级别数
Dim i As Integer '文件数
Dim program(50) As String '级别项目名称
Dim XJ As Integer '新建控制
Dim dblTt, ii, cJ, ok, RNF As Integer '新建文件个数
'Option Explicit
Dim Cmd1 As New ADODB.Command
Dim db1 As New ADODB.Connection
Private Sub cm21_Click()
im(myIndex).BorderStyle = 0
If i = 9 Then MsgBox "只可新建9个文件夹!", , "提示": Exit Sub
tt(i).Visible = True
tt(i).Text = "新建类别"
tt(i).Locked = False
im(i).Visible = True
tt(i).ForeColor = vbWhite
tt(i).BackColor = vbBlue
tt(i).SetFocus
tt(i).SelStart = 0
tt(i).SelLength = 50
i = i + 1
XJ = 1
End Sub
Private Sub cm22_Click()
Dim w, gs As String
If im(myIndex).BorderStyle = 0 Then Exit Sub
w = MsgBox("是否真的删除 " & tt(myIndex).Text & " 中及其以下所有类别?", vbYesNo + vbQuestion + vbDefaultButton2, "删除操作")
im(myIndex).BorderStyle = 0
If w = vbNo Then Exit Sub
MyOpen rs, "select * from program where grade='" & gradeStore & "" & myIndex + 1 & "'"
gs = rs(0)
If i > myIndex Then
MyOpen rs, "delete from program where grade like '" & gradeStore & "" & myIndex + 1 & "%'"
End If
i = i - 1
im(i).Visible = False
tt(i).Visible = False
If Line1(i).Visible = True Then
Line1(myIndex).Visible = True
Line2(myIndex).Visible = True
Line1(i).Visible = False
Line2(i).Visible = False
Else
Line1(myIndex).Visible = False
Line2(myIndex).Visible = False
End If
tt(myIndex).Text = tt(i).Text
If i > myIndex Then
MyOpen rs, "update program set grade='" & gradeStore & "" & myIndex + 1 & "' & right(grade,len(grade)-len(" & gs & ")) where grade in (select grade from program where grade like '" & gradeStore & "" & i + 1 & "%')"
End If
End Sub
Private Sub cm23_Click()
Unload Me
End Sub
Private Sub Command12_Click()
Call Beifeng("1")
End Sub
Private Sub Command14_Click()
Dim strConnectString As String
'ServerConnect = False
'Dim A, B, C As Variant
'Dim database As String
Dim SQLstatus As String
On Error GoTo ErrHandle
SQLstatus = "ACCESS"
Select Case UCase(SQLstatus)
Case "ACCESS"
strConnectString = "Provider=Microsoft.Jet.OLEDB.4.0;Password='';Data Source=" & App.Path & "\back\xitong.cci"
Case "SQL"
'strConnectString = "driver={SQL SERVER};SERVER=" & ServerName & "; UID=sa;PWD=;DATABASE=" & DatabaseName & ""
'strConnectString = "Provider=SQLOLEDB.1;Persist Security Info=False;User ID=sa;Initial Catalog=" & DatabaseName & ";Data Source=" & ServerName
Case "ORACLE"
'strConnectString = "driver={ORACLE ODBC DRIVER};CONNECTSTRING=ORA;UID=wsfy;PWD=wsfy;"
'strConnectString = "Provider=MSDAORA.1;Password=wsfy;User ID=wsfy;Data Source=" & ServerName & ";Persist Security Info=True"
End Select
db1.ConnectionString = strConnectString
db1.ConnectionTimeout = 100
db1.Open strConnectString
Set Cmd1.ActiveConnection = db1
'ServerConnect = True
Exit Sub
ErrHandle:
Dim adoErr As ADODB.Error
If db1.Errors.Count > 0 Then
For Each adoErr In db1.Errors
MsgBox "[Error Code] " & adoErr.Number & Chr(13) & adoErr.Description, vbCritical + vbOKOnly, "Error"
Next adoErr
End If
End Sub
Private Sub Command2_Click()
Unload Me
End Sub
Private Sub Command3_Click()
If im(myIndex).BorderStyle = 0 Then Exit Sub
MyOpen rs, "update adpw set grade='" & gradeStore & "" & myIndex + 1 & "',zw='" & tt(myIndex).Text & "'"
Label8.Caption = tt(myIndex).Text
im(myIndex).BorderStyle = 0
End Sub
Private Sub Command4_Click()
If im(myIndex).BorderStyle = 0 Then Exit Sub
MyOpen rs, "update adpw set grade1='" & myIndex + 1 & "',zw1='" & tt(myIndex).Text & "'"
Label7.Caption = tt(myIndex).Text
im(myIndex).BorderStyle = 0
End Sub
Private Sub Command7_Click()
Call Beifeng("0")
End Sub
Private Sub Command9_Click()
Call Beifeng("_")
End Sub
Private Sub Form_Load()
Status3 = 1
'zw = 0
Me.Top = 0
Me.Left = 0
ok = 0
Text1.BackColor = vbBlue
Text1.ForeColor = vbWhite
Label6.ForeColor = vbWhite
Label6.BackColor = vbBlack
End Sub
Private Sub Form_Unload(Cancel As Integer)
Status3 = 0
i = 0
Grade = 1
ok = 0
gradeStore = ""
End Sub
Private Sub Frame4_Click()
cm21.SetFocus
tt(myIndex).ForeColor = vbBlack
tt(myIndex).BackColor = vbWhite
tt(myIndex).Locked = True
im(myIndex).BorderStyle = 0
End Sub
Private Sub im_Click(Index As Integer)
im(myIndex).BorderStyle = 0
im(Index).BorderStyle = 1
tt(myIndex).ForeColor = vbBlack
tt(myIndex).BackColor = vbWhite
tt(myIndex).Locked = True
myIndex = Index
cm21.SetFocus
End Sub
Private Sub im_DblClick(Index As Integer)
im(Index).BorderStyle = 0
MyOpen rs, "select * from program where grade='" & gradeStore & "" & Index + 1 & "'"
gradeStore = rs.Fields(0)
Parents = Val(rs("keys"))
program(Grade) = tt(Index).Text
showGrade (Grade)
Grade = Grade + 1
Showfile (gradeStore)
End Sub
Private Sub Im1_Click()
im(myIndex).BorderStyle = 0
cm21.SetFocus
If Grade = 1 Or XJ = 1 Or dblTt = 1 Then Exit Sub
gradeStore = Left(gradeStore, Len(gradeStore) - 1)
MyOpen rs, "select keys from program where grade='" & gradeStore & "'"
On Error GoTo L1:
Parents = Val(rs(0))
L2:
showGrade (Grade - 2)
Grade = Grade - 1
Showfile (gradeStore)
Exit Sub
L1:
Parents = "0"
GoTo L2:
End Sub
Private Sub Im1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
Im1.Top = 4680 + 20
Im1.Left = 2520 + 20
End Sub
Private Sub Im1_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
Im1.Top = 4680
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -