www.pudn.com > 档案管理系统源码VB.zip > frmManager.frm
VERSION 5.00
Object = "{6B7E6392-850A-101B-AFC0-4210102A8DA7}#1.3#0"; "COMCTL32.OCX"
Begin VB.Form frmManager
BackColor = &H00E0E0E0&
Caption = "档案管理中心"
ClientHeight = 5415
ClientLeft = 60
ClientTop = 630
ClientWidth = 10905
Icon = "frmManager.frx":0000
LinkTopic = "Form1"
LockControls = -1 'True
MDIChild = -1 'True
ScaleHeight = 5415
ScaleWidth = 10905
WindowState = 2 'Maximized
Begin VB.PictureBox SliptBar
BackColor = &H00C0FFC0&
BorderStyle = 0 'None
DrawStyle = 1 'Dash
FillColor = &H000000FF&
FillStyle = 2 'Horizontal Line
ForeColor = &H000000FF&
Height = 4740
Left = 2355
MouseIcon = "frmManager.frx":030A
ScaleHeight = 4740
ScaleMode = 0 'User
ScaleWidth = 60
TabIndex = 1
Top = 15
Visible = 0 'False
Width = 60
End
Begin ComctlLib.TreeView TreeView
Height = 4410
Left = 75
TabIndex = 0
Top = 165
Width = 2430
_ExtentX = 4286
_ExtentY = 7779
_Version = 327682
Indentation = 317
LabelEdit = 1
LineStyle = 1
Style = 7
ImageList = "imlSmallIcons"
Appearance = 1
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
OLEDropMode = 1
End
Begin VB.PictureBox ListView
AutoRedraw = -1 'True
BackColor = &H00E0E0E0&
BorderStyle = 0 'None
Height = 5760
Left = 3240
ScaleHeight = 5760
ScaleWidth = 8160
TabIndex = 2
Top = 165
Width = 8160
Begin VB.PictureBox picEditFile
AutoSize = -1 'True
BackColor = &H00E0E0E0&
BorderStyle = 0 'None
Height = 240
Left = 6585
MouseIcon = "frmManager.frx":045C
MousePointer = 99 'Custom
Picture = "frmManager.frx":05AE
ScaleHeight = 240
ScaleWidth = 240
TabIndex = 14
ToolTipText = "查看、编辑、打印文件"
Top = 1755
Visible = 0 'False
Width = 240
End
Begin VB.TextBox txtFields
BackColor = &H00E0E0E0&
BorderStyle = 0 'None
Height = 1350
Index = 3
Left = 1455
Locked = -1 'True
MaxLength = 50
MultiLine = -1 'True
ScrollBars = 2 'Vertical
TabIndex = 11
Top = 3795
Width = 5010
End
Begin VB.TextBox txtFields
BackColor = &H00E0E0E0&
BorderStyle = 0 'None
Height = 1350
Index = 2
Left = 1455
Locked = -1 'True
MaxLength = 100
MultiLine = -1 'True
ScrollBars = 2 'Vertical
TabIndex = 10
Top = 2175
Width = 5010
End
Begin VB.TextBox txtFields
BackColor = &H00E0E0E0&
BorderStyle = 0 'None
Height = 195
Index = 1
Left = 1455
Locked = -1 'True
TabIndex = 6
Top = 1785
Width = 4965
End
Begin VB.TextBox txtFields
BackColor = &H00E0E0E0&
BorderStyle = 0 'None
Height = 195
Index = 0
Left = 1455
Locked = -1 'True
TabIndex = 5
Top = 1365
Width = 4965
End
Begin VB.Line Line16
BorderColor = &H00FFFFFF&
X1 = 6450
X2 = 6450
Y1 = 1725
Y2 = 2025
End
Begin VB.Line Line15
BorderColor = &H00FFFFFF&
X1 = 6450
X2 = 6450
Y1 = 1305
Y2 = 1620
End
Begin VB.Line Line14
BorderColor = &H00808080&
X1 = 1410
X2 = 6465
Y1 = 3750
Y2 = 3750
End
Begin VB.Line Line13
BorderColor = &H00FFFFFF&
X1 = 6465
X2 = 6465
Y1 = 3750
Y2 = 5175
End
Begin VB.Line Line12
BorderColor = &H00FFFFFF&
X1 = 1410
X2 = 6465
Y1 = 5160
Y2 = 5160
End
Begin VB.Line Line11
BorderColor = &H00FFFFFF&
X1 = 6465
X2 = 6465
Y1 = 2100
Y2 = 3555
End
Begin VB.Line Line10
BorderColor = &H00808080&
X1 = 1410
X2 = 6465
Y1 = 2115
Y2 = 2115
End
Begin VB.Line Line9
BorderColor = &H00FFFFFF&
X1 = 1410
X2 = 6480
Y1 = 3555
Y2 = 3555
End
Begin VB.Line Line8
BorderColor = &H00808080&
X1 = 1410
X2 = 6450
Y1 = 1725
Y2 = 1725
End
Begin VB.Line Line7
BorderColor = &H00FFFFFF&
X1 = 1425
X2 = 6465
Y1 = 2025
Y2 = 2025
End
Begin VB.Line Line6
BorderColor = &H00FFFFFF&
X1 = 1410
X2 = 6450
Y1 = 1605
Y2 = 1605
End
Begin VB.Line Line5
BorderColor = &H00808080&
X1 = 1410
X2 = 6450
Y1 = 1305
Y2 = 1305
End
Begin VB.Line Line4
BorderColor = &H00808080&
X1 = 1410
X2 = 1410
Y1 = 3765
Y2 = 5175
End
Begin VB.Line Line3
BorderColor = &H00808080&
X1 = 1410
X2 = 1410
Y1 = 2115
Y2 = 3555
End
Begin VB.Line Line2
BorderColor = &H00808080&
X1 = 1410
X2 = 1410
Y1 = 1740
Y2 = 2040
End
Begin VB.Line Line1
BorderColor = &H00808080&
X1 = 1410
X2 = 1410
Y1 = 1320
Y2 = 1605
End
Begin VB.Line lBottom
BorderColor = &H00808080&
Visible = 0 'False
X1 = 6555
X2 = 6855
Y1 = 2025
Y2 = 2025
End
Begin VB.Line lRight
BorderColor = &H00FFFFFF&
Visible = 0 'False
X1 = 6840
X2 = 6840
Y1 = 1725
Y2 = 2040
End
Begin VB.Line lTop
BorderColor = &H00FFFFFF&
Visible = 0 'False
X1 = 6540
X2 = 6855
Y1 = 1710
Y2 = 1710
End
Begin VB.Line lLeft
BorderColor = &H00808080&
Visible = 0 'False
X1 = 6540
X2 = 6540
Y1 = 1710
Y2 = 2040
End
Begin VB.Label Label1
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "参考说明："
ForeColor = &H00800080&
Height = 180
Index = 3
Left = 450
TabIndex = 12
Top = 3810
Width = 900
End
Begin VB.Label Label1
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "档案说明："
ForeColor = &H000000C0&
Height = 180
Index = 2
Left = 450
TabIndex = 9
Top = 2190
Width = 900
End
Begin VB.Label Label1
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "文件名称："
ForeColor = &H00000000&
Height = 180
Index = 1
Left = 450
TabIndex = 8
Top = 1785
Width = 900
End
Begin VB.Label Label1
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "档案类别："
ForeColor = &H00800000&
Height = 180
Index = 0
Left = 450
TabIndex = 7
Top = 1350
Width = 900
End
Begin VB.Label lblLine
BackColor = &H0000C000&
BorderStyle = 1 'Fixed Single
Height = 45
Left = 285
TabIndex = 4
Top = 780
Width = 3435
End
Begin VB.Label lblFileCaption
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "档案仓库"
BeginProperty Font
Name = "宋体"
Size = 12
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00FFFFFF&
Height = 240
Left = 1530
TabIndex = 3
Top = 330
Width = 960
End
Begin VB.Label Label2
BackColor = &H000000C0&
Height = 825
Left = 375
TabIndex = 13
Top = -15
Width = 2100
End
End
Begin ComctlLib.ImageList imlSmallIcons
Left = 0
Top = 0
_ExtentX = 1005
_ExtentY = 1005
BackColor = -2147483643
ImageWidth = 13
ImageHeight = 13
MaskColor = 12632256
UseMaskColor = 0 'False
_Version = 327682
BeginProperty Images {0713E8C2-850A-101B-AFC0-4210102A8DA7}
NumListImages = 5
BeginProperty ListImage1 {0713E8C3-850A-101B-AFC0-4210102A8DA7}
Picture = "frmManager.frx":06F8
Key = "SClosed"
EndProperty
BeginProperty ListImage2 {0713E8C3-850A-101B-AFC0-4210102A8DA7}
Picture = "frmManager.frx":0C1A
Key = "Open"
EndProperty
BeginProperty ListImage3 {0713E8C3-850A-101B-AFC0-4210102A8DA7}
Picture = "frmManager.frx":113C
Key = "File"
EndProperty
BeginProperty ListImage4 {0713E8C3-850A-101B-AFC0-4210102A8DA7}
Picture = "frmManager.frx":165E
Key = "SOpen"
EndProperty
BeginProperty ListImage5 {0713E8C3-850A-101B-AFC0-4210102A8DA7}
Picture = "frmManager.frx":1B80
Key = "Closed"
EndProperty
EndProperty
End
Begin VB.Image imgSplit
Height = 4425
Left = 2955
MousePointer = 9 'Size W E
Top = 135
Width = 150
End
Begin VB.Menu MnuControl
Caption = "操作中心^&P)"
Begin VB.Menu MnuSearchFile
Caption = "&S 查询档案"
Shortcut = ^S
End
Begin VB.Menu Line03
Caption = "-"
End
Begin VB.Menu MnuRefresh
Caption = "&R 刷新仓库"
Shortcut = ^F
End
Begin VB.Menu MLine2
Caption = "-"
End
Begin VB.Menu MnuFolder
Caption = "&C 目录管理"
Shortcut = ^C
End
Begin VB.Menu MLine01
Caption = "-"
End
Begin VB.Menu MnuAddFile
Caption = "&A 添加档案"
Enabled = 0 'False
Shortcut = ^N
End
Begin VB.Menu MnuModifyFile
Caption = "&M 修改档案"
Enabled = 0 'False
Shortcut = ^L
End
Begin VB.Menu MnuDeleteFile
Caption = "&D 删除档案"
Enabled = 0 'False
Shortcut = ^D
End
Begin VB.Menu Line502
Caption = "-"
End
Begin VB.Menu MnuOpenFile
Caption = "&E 打开档案关联的文件"
Enabled = 0 'False
Shortcut = ^O
End
End
Begin VB.Menu MnuReturnX
Caption = "关闭选择^&O)"
Begin VB.Menu MnuReturn
Caption = "返回首页(&R)"
Shortcut = ^R
End
Begin VB.Menu Line601
Caption = "-"
End
Begin VB.Menu MnuExit
Caption = "退出系统(&X)"
Shortcut = ^X
End
End
End
Attribute VB_Name = "frmManager"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim SL As Long
Dim MDown As Boolean, lShow As Boolean
Dim mNode As Node
Dim mdbFile As Database
Dim strHistory As String
Const sglSplitLimit = 500
Public Sub Form_Load()
IT = True
TreeView.Top = 0
TreeView.Left = 0
'定位上次分隔条
If Val(GetSetting(App.EXEName, "Config", "Split")) < 1500 Then
imgSplit.Left = 1500
Else
imgSplit.Left = Val(GetSetting(App.EXEName, "Config", "Split"))
End If
'安装列表
cmdLoad_Click
'使搜索有效
frmMain.Toolbar1.Buttons(9).Enabled = True
frmMain.Toolbar1.Buttons(11).Enabled = False
subPurView '安装权限
End Sub
Private Sub Form_Resize()
On Error Resume Next
If Me.Height < 3000 Then Me.Height = 3000
If Me.Width < 3000 Then Me.Width = 3000
SizeControls imgSplit.Left
End Sub
Private Sub Form_Unload(Cancel As Integer)
'使按钮无效
frmMain.Toolbar1.Buttons(9).Enabled = False
frmMain.Toolbar1.Buttons(5).Enabled = False
frmMain.Toolbar1.Buttons(6).Enabled = False
frmMain.Toolbar1.Buttons(7).Enabled = False
frmMain.Toolbar1.Buttons(11).Enabled = True
IT = False
End Sub
Private Sub imgSplit_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
With imgSplit
SliptBar.Move .Left, .Top, .Width \ 2, .Height - 20
End With
SliptBar.Visible = True
MDown = True
End Sub
Private Sub imgSplit_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim lPos As Single
If MDown Then
lPos = X + imgSplit.Left
If lPos < sglSplitLimit Then
SliptBar.Left = sglSplitLimit
ElseIf lPos > Me.ScaleWidth - sglSplitLimit Then
SliptBar.Left = Me.ScaleWidth - sglSplitLimit
Else
SliptBar.Left = lPos
End If
End If
End Sub
Private Sub imgSplit_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
SizeControls SliptBar.Left
SliptBar.Visible = False
MDown = False
SaveSetting App.EXEName, "Config", "Split", imgSplit.Left
End Sub
Sub SizeControls(X As Single)
On Error Resume Next
'设置 Width 属性
If X < 1500 Then X = 1500
If X > (Me.Width - 1500) Then X = Me.Width - 1500
TreeView.Width = X
imgSplit.Left = X
ListView.Left = X + 40
ListView.Width = Me.Width - (TreeView.Width - 30)
TreeView.Height = Me.ScaleHeight
ListView.Top = TreeView.Top
ListView.Height = TreeView.Height
imgSplit.Top = TreeView.Top
imgSplit.Height = TreeView.Height
End Sub
Public Sub cmdLoad_Click()
Me.MousePointer = 11
'清除右边的项目内容
lblFileCaption.Caption = "档案仓库"
txtFields(1).Text = ""
txtFields(2).Text = ""
txtFields(3).Text = ""
txtFields(0).Text = ""
frmMain.Toolbar1.Buttons(5).Enabled = False
frmMain.Toolbar1.Buttons(6).Enabled = False
frmMain.Toolbar1.Buttons(7).Enabled = False
MnuAddFile.Enabled = False
MnuModifyFile.Enabled = False
MnuDeleteFile.Enabled = False
MnuOpenFile.Enabled = False
Dim rsPublishers As Recordset, rsTitles As Recordset
Dim IntIndex
TreeView.Nodes.Clear '清除原有的数据
'配置TreeView
TreeView.Sorted = True
Set mNode = TreeView.Nodes.Add
With mNode
.Text = "档案仓库"
.Tag = "FileManager"
.Image = "Closed"
End With
TreeView.LabelEdit = 1
Set mdbFile = OpenDatabase(ConData, False, False, ConStr)
Set rsPublishers = mdbFile.OpenRecordset("Catalog", dbOpenDynaset)
Do Until rsPublishers.EOF
Set mNode = TreeView.Nodes.Add(1, tvwChild, rsPublishers!Name, CStr(rsPublishers!Name), "SClosed")
mNode.Tag = "File"
IntIndex = mNode.Index
If strSearchString <> "" Then '查询时
Set rsTitles = mdbFile.OpenRecordset("Select * from Detail Where Name ='" & rsPublishers!Name & "'" & strSearchString)
Else
Set rsTitles = mdbFile.OpenRecordset("Select * from Detail Where Name ='" & rsPublishers!Name & "'")
End If
Do Until rsTitles.EOF
Set mNode = TreeView.Nodes.Add(IntIndex, tvwChild)
mNode.Text = rsTitles!档案号
mNode.Key = rsTitles!档案号
mNode.Tag = "SFile"
mNode.Image = "File"
rsTitles.MoveNext
Loop
rsPublishers.MoveNext ' Move to next Publishers record.
Loop
TreeView.Nodes(1).Sorted = True
TreeView.Nodes(1).Expanded = True
'释放数据库
rsTitles.Close
rsPublishers.Close
mdbFile.Close
Set mdbFile = Nothing
'取消所有档案操作
MnuAddFile.Enabled = False
MnuModifyFile.Enabled = False
MnuDeleteFile.Enabled = False
Me.MousePointer = 0
End Sub
Private Sub ListView_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
If lShow = False Then Exit Sub '已经隐藏时退出
lLeft.Visible = False
lRight.Visible = False
lTop.Visible = False
lBottom.Visible = False
lShow = False
End Sub
Private Sub ListView_Resize()
lblFileCaption.Left = (ListView.Width - lblFileCaption.Width) / 2
lblLine.Width = ListView.ScaleWidth
lblLine.Left = -20
Label2.Left = -20
Label2.Width = ListView.ScaleWidth
End Sub
Public Sub MnuAddFile_Click()
Me.MousePointer = 11
frmNewForm.Show 1
Me.MousePointer = 0
End Sub
Public Sub MnuDeleteFile_Click()
If MsgBox("真的要删除档案吗？ " & vbCrLf & vbclrf & vbCrLf & strFileID & " [是/否]？ ", vbYesNo + vbCritical + vbDefaultButton2, "档案删除后将不能恢复!") = vbNo Then Exit Sub
Dim strTemp As String
DBEngine.BeginTrans
Set mdbFile = OpenDatabase(ConData, False, False, ConStr)
strTemp = "Delete * From Detail Where Name='" & strFileType & "' And 档案号='" & strFileID & "'"
mdbFile.Execute strTemp
mdbFile.Close
Set mdbFile = Nothing
DBEngine.CommitTrans
'刷新数据
Call cmdLoad_Click
frmMain.Toolbar1.Buttons(5).Enabled = False
frmMain.Toolbar1.Buttons(6).Enabled = False
frmMain.Toolbar1.Buttons(7).Enabled = False
MnuAddFile.Enabled = False
MnuModifyFile.Enabled = False
MnuDeleteFile.Enabled = False
End Sub
Private Sub MnuExit_Click()
Unload frmMain
End Sub
Private Sub MnuFolder_Click()
Me.MousePointer = 11
frmCatalog.Show 1
Me.MousePointer = 0
End Sub
Public Sub MnuModifyFile_Click()
Me.MousePointer = 11
frmModifyForm.Show 1
Me.MousePointer = 0
End Sub
Private Sub MnuOpenFile_Click()
Call picEditFile_Click
End Sub
Private Sub MnuRefresh_Click()
strSearchString = "" '查询条件为空
Call cmdLoad_Click
End Sub
Private Sub MnuReturn_Click()
Unload Me
End Sub
Public Sub MnuSearchFile_Click()
Me.MousePointer = 11
frmSearchForm.Show 1
Me.MousePointer = 0
End Sub
Private Sub picEditFile_Click()
On Error Resume Next
'编辑档案
Dim retVal As Long
retVal = ShellExecute(Me.hwnd, "Open", txtFields(1).Text, "", App.Path + "\File", 1)
If retVal = 2 Then '文件不存在
MsgBox "下面文件没有找到： " & vbCrLf & vbCrLf & txtFields(1).Text & " ", vbInformation, "档案管理系统"
Exit Sub
End If
If retVal = 31 Then '文件不能打开时
If MsgBox("系统不能自动打开下面文件： " & vbCrLf & vbCrLf & txtFields(1).Text & _
vbCrLf & vbCrLf & "是否使用其它Open方法试试,(是/否)? ", vbYesNo + vbQuestion, "档案管理系统") = vbNo Then
Exit Sub
Else
'使用Explorer打开文件
retVal = Shell("Explorer.Exe " & txtFields(1).Text, vbNormalFocus)
End If
End If
End Sub
Private Sub picEditFile_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
lTop.BorderColor = &H808080
lBottom.BorderColor = &HFFFFFF
End Sub
Private Sub picEditFile_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
If lShow = True Then Exit Sub '已经显示时退出
lLeft.Visible = True
lRight.Visible = True
lTop.Visible = True
lBottom.Visible = True
lShow = True
End Sub
Private Sub picEditFile_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
lTop.BorderColor = &HFFFFFF
lBottom.BorderColor = &H808080
End Sub
Private Sub TreeView_Collapse(ByVal Node As ComctlLib.Node)
If Node.Tag = "FileManager" Then Node.Image = "Closed"
If Node.Tag = "File" Then Node.Image = "SClosed"
End Sub
Private Sub TreeView_Expand(ByVal Node As ComctlLib.Node)
If Node.Tag = "FileManager" Then Node.Image = "Open"
If Node.Tag = "File" Then Node.Image = "SOpen"
End Sub
Private Sub TreeView_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = 2 Then
PopupMenu MnuControl
End If
End Sub
Private Sub TreeView_NodeClick(ByVal Node As ComctlLib.Node)
lblFileCaption.Caption = Node.Text
lblFileCaption.Left = (ListView.Width - lblFileCaption.Width) / 2
If Node.Tag = "SFile" Then
MnuAddFile.Enabled = True
MnuModifyFile.Enabled = True
MnuDeleteFile.Enabled = True
frmMain.Toolbar1.Buttons(5).Enabled = True
frmMain.Toolbar1.Buttons(6).Enabled = True
frmMain.Toolbar1.Buttons(7).Enabled = True
subPurView '安装权限
Else
MnuAddFile.Enabled = False
MnuModifyFile.Enabled = False
MnuDeleteFile.Enabled = False
frmMain.Toolbar1.Buttons(5).Enabled = False
frmMain.Toolbar1.Buttons(6).Enabled = False
frmMain.Toolbar1.Buttons(7).Enabled = False
End If
If Node.Tag = "SFile" And strHistory <> Node.Text Then
If Trim(Node.Text) <> "" Then
LoadData (Node.Text) '安装数据库
strHistory = Node.Text
If Trim(txtFields(1).Text) <> "" And PurView <> "只能添加" Then
MnuOpenFile.Enabled = True
Else
MnuOpenFile.Enabled = False
End If
End If
End If
If Node.Tag <> "SFile" Then
txtFields(0).Text = ""
txtFields(1).Text = ""
txtFields(2).Text = ""
txtFields(3).Text = ""
strHistory = ""
MnuOpenFile.Enabled = False
End If
'安装ID与类型,但为根目录时跳过
If Node.Text = "档案仓库" Then
ElseIf Node.Tag = "File" Then
MnuAddFile.Enabled = True
frmMain.Toolbar1.Buttons(5).Enabled = True
strFileType = Node.Text
strFileID = ""
Else
strFileType = Node.Parent.Text
strFileID = Node.Text
End If
End Sub
Private Sub LoadData(strTemp As String)
If PurView = "只能添加" Then Exit Sub
Set mdbFile = OpenDatabase(ConData, False, False, ConStr)
Dim rsTitles As Recordset
Set rsTitles = mdbFile.OpenRecordset("Select * From Detail Where 档案号='" & strTemp & "'", dbOpenDynaset)
txtFields(0).Text = rsTitles!Name
txtFields(1).Text = rsTitles!文件名
txtFields(2).Text = rsTitles!文件说明
txtFields(3).Text = rsTitles!参考说明
rsTitles.Close
mdbFile.Close
Set mdbFile = Nothing
End Sub
Private Sub txtFields_Change(Index As Integer)
If Trim(txtFields(1).Text) = "" Then
picEditFile.Visible = False
Else
picEditFile.Visible = True
End If
End Sub
Private Sub txtFields_MouseMove(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
If lShow = False Then Exit Sub '已经隐藏时退出
lLeft.Visible = False
lRight.Visible = False
lTop.Visible = False
lBottom.Visible = False
lShow = False
End Sub
Private Sub subPurView()
'权限控制
Select Case PurView
Case "只能添加"
MnuAddFile.Enabled = True
MnuModifyFile.Enabled = False
MnuDeleteFile.Enabled = False
frmMain.Toolbar1.Buttons(5).Enabled = True
frmMain.Toolbar1.Buttons(6).Enabled = False
frmMain.Toolbar1.Buttons(7).Enabled = False
MnuSearchFile.Enabled = False
frmMain.Toolbar1.Buttons(9).Enabled = False
Case "不能修改"
MnuAddFile.Enabled = True
MnuModifyFile.Enabled = False
MnuDeleteFile.Enabled = False
frmMain.Toolbar1.Buttons(5).Enabled = True
frmMain.Toolbar1.Buttons(6).Enabled = False
frmMain.Toolbar1.Buttons(7).Enabled = False
Case "可以修改"
'没有
Case "超级权限"
'没有权限限制
End Select
End Sub
Private Function LocalPath(strFileName As String) As String
strFileName = Trim(strFileName)
Dim X As Integer
X = 1
For X = 1 To Len(strFileName)
If InStr(1, Right(strFileName, X), "\", vbTextCompare) Then
Exit For
End If
Next
If X > Len(strFileName) Then
LocalPath = CurDir()
Else
LocalPath = Left(strFileName, Len(strFileName) - X)
End If
End Function