www.pudn.com > VBFTPServer.rar > UserOpts.frm
VERSION 5.00
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "Comdlg32.ocx"
Begin VB.Form UserOpts
AutoRedraw = -1 'True
BorderStyle = 3 'Fixed Dialog
Caption = "用户选项"
ClientHeight = 5730
ClientLeft = 45
ClientTop = 330
ClientWidth = 7245
LinkTopic = "Form1"
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 5730
ScaleWidth = 7245
ShowInTaskbar = 0 'False
StartUpPosition = 1 '所有者中心
Begin MSComDlg.CommonDialog CommonDialog1
Left = 4560
Top = 5280
_ExtentX = 847
_ExtentY = 847
_Version = 393216
End
Begin VB.CommandButton UsrDone
Caption = "完成"
Height = 375
Left = 2640
TabIndex = 25
Top = 5280
Width = 1575
End
Begin VB.Frame Frame1
Caption = "安装"
Height = 5175
Left = 2520
TabIndex = 4
Top = 0
Width = 4575
Begin VB.TextBox UsrName
Appearance = 0 'Flat
Height = 285
Left = 1080
TabIndex = 27
Top = 240
Width = 2655
End
Begin VB.TextBox HomeDir
Appearance = 0 'Flat
Height = 285
Left = 1080
TabIndex = 24
Top = 960
Width = 2655
End
Begin VB.TextBox Pword
Appearance = 0 'Flat
Height = 285
Left = 1080
TabIndex = 21
Top = 600
Width = 2655
End
Begin VB.Frame frm1
Caption = "文件/目录设置"
Height = 3495
Left = 120
TabIndex = 5
Top = 1560
Width = 4335
Begin VB.CommandButton FDUpdate
Caption = "更新"
Height = 375
Left = 1920
TabIndex = 26
Top = 3000
Width = 735
End
Begin VB.CheckBox FRead
Appearance = 0 'Flat
Caption = "读"
ForeColor = &H80000008&
Height = 255
Left = 3000
TabIndex = 17
Top = 480
Width = 855
End
Begin VB.CheckBox FWrite
Appearance = 0 'Flat
Caption = "写"
ForeColor = &H80000008&
Height = 255
Left = 3000
TabIndex = 16
Top = 720
Width = 735
End
Begin VB.CheckBox FDelete
Appearance = 0 'Flat
Caption = "删除"
ForeColor = &H80000008&
Height = 255
Left = 3000
TabIndex = 15
Top = 960
Width = 855
End
Begin VB.CheckBox FEx
Appearance = 0 'Flat
Caption = "运行"
ForeColor = &H80000008&
Height = 255
Left = 3000
TabIndex = 14
Top = 1200
Width = 975
End
Begin VB.CheckBox DList
Appearance = 0 'Flat
Caption = "列表"
ForeColor = &H80000008&
Height = 255
Left = 3000
TabIndex = 13
Top = 1800
Width = 855
End
Begin VB.CheckBox DMake
Appearance = 0 'Flat
Caption = "创建"
ForeColor = &H80000008&
Height = 255
Left = 3000
TabIndex = 12
Top = 2040
Width = 735
End
Begin VB.CheckBox DRemove
Appearance = 0 'Flat
Caption = "移除"
ForeColor = &H80000008&
Height = 255
Left = 3000
TabIndex = 11
Top = 2280
Width = 975
End
Begin VB.CheckBox DSub
Appearance = 0 'Flat
Caption = "替换"
ForeColor = &H80000008&
Height = 255
Left = 3000
TabIndex = 10
Top = 2520
Width = 855
End
Begin VB.ListBox AccsList
Appearance = 0 'Flat
Height = 2550
ItemData = "UserOpts.frx":0000
Left = 120
List = "UserOpts.frx":0002
TabIndex = 9
Top = 240
Width = 2655
End
Begin VB.CommandButton FDAdd
Caption = "添加"
Height = 375
Left = 240
TabIndex = 8
Top = 3000
Width = 615
End
Begin VB.CommandButton FDEdit
Caption = "编辑"
Height = 375
Left = 1080
TabIndex = 7
Top = 3000
Width = 615
End
Begin VB.CommandButton FDRemove
Caption = "移除"
Height = 375
Left = 2880
TabIndex = 6
Top = 3000
Width = 735
End
Begin VB.Label Label1
Caption = "文件"
Height = 255
Left = 2880
TabIndex = 19
Top = 240
Width = 495
End
Begin VB.Label Label2
Caption = "目录"
Height = 255
Left = 2880
TabIndex = 18
Top = 1560
Width = 975
End
End
Begin VB.Label Label5
Caption = "本地路径:"
Height = 255
Left = 120
TabIndex = 23
Top = 960
Width = 855
End
Begin VB.Label Label4
Caption = "用户名:"
Height = 255
Left = 120
TabIndex = 22
Top = 240
Width = 855
End
Begin VB.Label Label3
Caption = "密码:"
Height = 255
Left = 120
TabIndex = 20
Top = 600
Width = 855
End
End
Begin VB.Frame Frame2
Caption = "用户"
Height = 5175
Left = 120
TabIndex = 0
Top = 0
Width = 2295
Begin VB.CommandButton UsrRemove
Caption = "移除"
Height = 375
Left = 1320
TabIndex = 3
Top = 4560
Width = 855
End
Begin VB.CommandButton UsrAdd
Caption = "添加"
Height = 375
Left = 120
TabIndex = 2
Top = 4560
Width = 855
End
Begin VB.ListBox UserList
Appearance = 0 'Flat
Height = 3990
ItemData = "UserOpts.frx":0004
Left = 120
List = "UserOpts.frx":0006
TabIndex = 1
Top = 240
Width = 2055
End
End
End
Attribute VB_Name = "UserOpts"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim uItem As Integer
Dim aItem As Integer
Dim tStrng As String
Dim uUser As Integer
Dim Pcnt As Integer
Private Type Priv
Path As String
Accs As String '[R]ead,[W]rite,[D]elete,e[X]ecute > Files
'[L]ist,[M]ake,[K]ill,[S]ubs > Dirs
End Type
Private Privs(20) As Priv
Private Sub FDAdd_Click()
tStrng = Get_Path("")
If tStrng <> "" Then
AccsList.AddItem (tStrng)
Pcnt = Pcnt + 1
UserIDs.No(uUser).Priv(Pcnt).Path = tStrng
FDUpdate.Enabled = True
FDRemove.Enabled = True
End If
AccsList_False
End Sub
Private Sub FDEdit_Click()
tStrng = Get_Path(AccsList.Text)
If tStrng <> "" Then
AccsList.List(aItem) = tStrng
UserIDs.No(uUser).Priv(aItem + 1).Path = tStrng
End If
AccsList_False
End Sub
Private Sub FDRemove_Click()
Dim z As Integer
For z = (aItem + 1) To UserIDs.No(uUser).Pcnt
UserIDs.No(uUser).Priv(z).Path = UserIDs.No(uUser).Priv(z + 1).Path
UserIDs.No(uUser).Priv(z).Accs = UserIDs.No(uUser).Priv(z + 1).Accs
Next
UserIDs.No(uUser).Pcnt = UserIDs.No(uUser).Pcnt - 1
AccsList.RemoveItem (aItem)
AccsList_False
End Sub
Private Sub FDUpdate_Click()
Dim z As Integer, s As String
UserIDs.No(uUser).Name = UsrName
UserIDs.No(uUser).Pass = Pword
UserIDs.No(uUser).Home = HomeDir
UserIDs.No(uUser).Pcnt = Pcnt
s = ""
z = aItem + 1
If FRead.Value = 1 Then s = s & "R"
If FWrite.Value = 1 Then s = s & "W"
If FDelete.Value = 1 Then s = s & "D"
If FEx.Value = 1 Then s = s & "X"
If DList.Value = 1 Then s = s & "L"
If DMake.Value = 1 Then s = s & "M"
If DRemove.Value = 1 Then s = s & "K"
If DSub.Value = 1 Then s = s & "S"
Privs(z).Accs = s
UserIDs.No(uUser).Priv(z).Accs = s
AccsList_False
End Sub
Private Sub Form_Load()
Dim x As Integer, y As Integer
y = UserIDs.Count
If (y > 0) Then
For x = 1 To UserIDs.Count
UserList.AddItem UserIDs.No(x).Name
Next
End If
aItem = -1
uItem = -1
AccsList_False
UserList_False
FDAdd.Enabled = False
End Sub
Private Sub Form_Terminate()
Unload Me
End Sub
Private Sub UserList_LostFocus()
' If uItem >= 0 Then UserList_False
End Sub
Private Sub UsrDone_Click()
Dim z As Integer
Form_Terminate
End Sub
Private Sub UsrRemove_Click()
Dim z As Integer, i As Integer
z = UserIDs.Count
For i = uUser To z
UserIDs.No(i) = UserIDs.No(i + 1)
Next
UserList.RemoveItem (uItem)
UserIDs.Count = z - 1
AccsList.Clear
ClearAccs
UsrName = ""
Pword = ""
HomeDir = ""
aItem = -1
UserList_False
End Sub
Private Sub UsrAdd_Click()
Dim i As Integer, S1 As String
S1 = "New User"
UsrName = S1
UserList.AddItem S1
i = UserIDs.Count + 1
UserIDs.No(i).Name = S1
UserIDs.Count = i
UserList_False
End Sub
Private Sub UserList_Click()
Dim x As Integer, z As Integer
uItem = UserList.ListIndex
Debug.Print "User List Item = " & uItem
'[R]ead,[W]rite,[D]elete,e[X]ecute > Files
'[L]ist,[M]ake,[K]ill,[S]ubs > Dirs
uUser = uItem + 1
AccsList.Clear
ClearAccs
Pword = ""
HomeDir = ""
aItem = -1
UserList_True
AccsList_False
FDAdd.Enabled = True
UsrName = UserIDs.No(uUser).Name
Pword = UserIDs.No(uUser).Pass
HomeDir = UserIDs.No(uUser).Home
Pcnt = UserIDs.No(uUser).Pcnt
For z = 1 To Pcnt
Privs(z).Path = UserIDs.No(uUser).Priv(z).Path
Privs(z).Accs = UserIDs.No(uUser).Priv(z).Accs
AccsList.AddItem Privs(z).Path
Next
End Sub
Private Sub AccsList_Click()
Dim x As Integer, z As Integer
aItem = AccsList.ListIndex
Debug.Print "Access List Item = " & aItem
ClearAccs
AccsList_True
z = aItem + 1
Debug.Print UserIDs.No(uUser).Priv(z).Accs
If InStr(Privs(z).Accs, "R") Then
FRead.Value = 1
End If
If InStr(Privs(z).Accs, "W") Then
FWrite.Value = 1
End If
If InStr(Privs(z).Accs, "D") Then
FDelete.Value = 1
End If
If InStr(Privs(z).Accs, "X") Then
FEx.Value = 1
End If
If InStr(Privs(z).Accs, "L") Then
DList.Value = 1
End If
If InStr(Privs(z).Accs, "M") Then
DMake.Value = 1
End If
If InStr(Privs(z).Accs, "K") Then
DRemove.Value = 1
End If
If InStr(Privs(z).Accs, "S") Then
DSub.Value = 1
End If
End Sub
Private Sub AccsList_DblClick()
aItem = AccsList.ListIndex
tStrng = Get_Path(AccsList.Text)
If tStrng <> "" Then
AccsList.List(aItem) = tStrng
UserIDs.No(uUser).Priv(aItem + 1).Path = tStrng
End If
AccsList.Selected(aItem) = False
End Sub
Private Sub UserList_True()
UsrRemove.Enabled = True
End Sub
Private Sub UserList_False()
Debug.Print "uItem=" & uItem
UsrRemove.Enabled = False
If uItem >= 0 Then
UserList.Selected(uItem) = False
uItem = -1
End If
End Sub
Private Sub AccsList_True()
FDEdit.Enabled = True
FDRemove.Enabled = True
FDUpdate.Enabled = True
End Sub
Private Sub AccsList_False()
Debug.Print "aItem=" & aItem
FDEdit.Enabled = False
FDRemove.Enabled = False
FDUpdate.Enabled = False
If aItem >= 0 Then
AccsList.Selected(aItem) = False
aItem = -1
End If
End Sub
Private Sub ClearAccs()
FRead.Value = 0
FWrite.Value = 0
FDelete.Value = 0
FEx.Value = 0
DList.Value = 0
DMake.Value = 0
DRemove.Value = 0
DSub.Value = 0
End Sub
Function Get_Path(olds As String) As String
AddEditDir.DirPath = olds
AddEditDir.Show 1
If Tag <> "" Then
Get_Path = Tag
Tag = ""
End If
End Function