UserOpts.frm
上传用户:guantou168
上传日期:2015-06-25
资源大小:74k
文件大小:14k
源码类别:

Ftp服务器

开发平台:

Visual Basic

  1. VERSION 5.00
  2. Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "Comdlg32.ocx"
  3. Begin VB.Form UserOpts 
  4.    AutoRedraw      =   -1  'True
  5.    BorderStyle     =   3  'Fixed Dialog
  6.    Caption         =   "用户选项"
  7.    ClientHeight    =   5730
  8.    ClientLeft      =   45
  9.    ClientTop       =   330
  10.    ClientWidth     =   7245
  11.    LinkTopic       =   "Form1"
  12.    MaxButton       =   0   'False
  13.    MinButton       =   0   'False
  14.    ScaleHeight     =   5730
  15.    ScaleWidth      =   7245
  16.    ShowInTaskbar   =   0   'False
  17.    StartUpPosition =   1  '所有者中心
  18.    Begin MSComDlg.CommonDialog CommonDialog1 
  19.       Left            =   4560
  20.       Top             =   5280
  21.       _ExtentX        =   847
  22.       _ExtentY        =   847
  23.       _Version        =   393216
  24.    End
  25.    Begin VB.CommandButton UsrDone 
  26.       Caption         =   "完成"
  27.       Height          =   375
  28.       Left            =   2640
  29.       TabIndex        =   25
  30.       Top             =   5280
  31.       Width           =   1575
  32.    End
  33.    Begin VB.Frame Frame1 
  34.       Caption         =   "安装"
  35.       Height          =   5175
  36.       Left            =   2520
  37.       TabIndex        =   4
  38.       Top             =   0
  39.       Width           =   4575
  40.       Begin VB.TextBox UsrName 
  41.          Appearance      =   0  'Flat
  42.          Height          =   285
  43.          Left            =   1080
  44.          TabIndex        =   27
  45.          Top             =   240
  46.          Width           =   2655
  47.       End
  48.       Begin VB.TextBox HomeDir 
  49.          Appearance      =   0  'Flat
  50.          Height          =   285
  51.          Left            =   1080
  52.          TabIndex        =   24
  53.          Top             =   960
  54.          Width           =   2655
  55.       End
  56.       Begin VB.TextBox Pword 
  57.          Appearance      =   0  'Flat
  58.          Height          =   285
  59.          Left            =   1080
  60.          TabIndex        =   21
  61.          Top             =   600
  62.          Width           =   2655
  63.       End
  64.       Begin VB.Frame frm1 
  65.          Caption         =   "文件/目录设置"
  66.          Height          =   3495
  67.          Left            =   120
  68.          TabIndex        =   5
  69.          Top             =   1560
  70.          Width           =   4335
  71.          Begin VB.CommandButton FDUpdate 
  72.             Caption         =   "更新"
  73.             Height          =   375
  74.             Left            =   1920
  75.             TabIndex        =   26
  76.             Top             =   3000
  77.             Width           =   735
  78.          End
  79.          Begin VB.CheckBox FRead 
  80.             Appearance      =   0  'Flat
  81.             Caption         =   "读"
  82.             ForeColor       =   &H80000008&
  83.             Height          =   255
  84.             Left            =   3000
  85.             TabIndex        =   17
  86.             Top             =   480
  87.             Width           =   855
  88.          End
  89.          Begin VB.CheckBox FWrite 
  90.             Appearance      =   0  'Flat
  91.             Caption         =   "写"
  92.             ForeColor       =   &H80000008&
  93.             Height          =   255
  94.             Left            =   3000
  95.             TabIndex        =   16
  96.             Top             =   720
  97.             Width           =   735
  98.          End
  99.          Begin VB.CheckBox FDelete 
  100.             Appearance      =   0  'Flat
  101.             Caption         =   "删除"
  102.             ForeColor       =   &H80000008&
  103.             Height          =   255
  104.             Left            =   3000
  105.             TabIndex        =   15
  106.             Top             =   960
  107.             Width           =   855
  108.          End
  109.          Begin VB.CheckBox FEx 
  110.             Appearance      =   0  'Flat
  111.             Caption         =   "运行"
  112.             ForeColor       =   &H80000008&
  113.             Height          =   255
  114.             Left            =   3000
  115.             TabIndex        =   14
  116.             Top             =   1200
  117.             Width           =   975
  118.          End
  119.          Begin VB.CheckBox DList 
  120.             Appearance      =   0  'Flat
  121.             Caption         =   "列表"
  122.             ForeColor       =   &H80000008&
  123.             Height          =   255
  124.             Left            =   3000
  125.             TabIndex        =   13
  126.             Top             =   1800
  127.             Width           =   855
  128.          End
  129.          Begin VB.CheckBox DMake 
  130.             Appearance      =   0  'Flat
  131.             Caption         =   "创建"
  132.             ForeColor       =   &H80000008&
  133.             Height          =   255
  134.             Left            =   3000
  135.             TabIndex        =   12
  136.             Top             =   2040
  137.             Width           =   735
  138.          End
  139.          Begin VB.CheckBox DRemove 
  140.             Appearance      =   0  'Flat
  141.             Caption         =   "移除"
  142.             ForeColor       =   &H80000008&
  143.             Height          =   255
  144.             Left            =   3000
  145.             TabIndex        =   11
  146.             Top             =   2280
  147.             Width           =   975
  148.          End
  149.          Begin VB.CheckBox DSub 
  150.             Appearance      =   0  'Flat
  151.             Caption         =   "替换"
  152.             ForeColor       =   &H80000008&
  153.             Height          =   255
  154.             Left            =   3000
  155.             TabIndex        =   10
  156.             Top             =   2520
  157.             Width           =   855
  158.          End
  159.          Begin VB.ListBox AccsList 
  160.             Appearance      =   0  'Flat
  161.             Height          =   2550
  162.             ItemData        =   "UserOpts.frx":0000
  163.             Left            =   120
  164.             List            =   "UserOpts.frx":0002
  165.             TabIndex        =   9
  166.             Top             =   240
  167.             Width           =   2655
  168.          End
  169.          Begin VB.CommandButton FDAdd 
  170.             Caption         =   "添加"
  171.             Height          =   375
  172.             Left            =   240
  173.             TabIndex        =   8
  174.             Top             =   3000
  175.             Width           =   615
  176.          End
  177.          Begin VB.CommandButton FDEdit 
  178.             Caption         =   "编辑"
  179.             Height          =   375
  180.             Left            =   1080
  181.             TabIndex        =   7
  182.             Top             =   3000
  183.             Width           =   615
  184.          End
  185.          Begin VB.CommandButton FDRemove 
  186.             Caption         =   "移除"
  187.             Height          =   375
  188.             Left            =   2880
  189.             TabIndex        =   6
  190.             Top             =   3000
  191.             Width           =   735
  192.          End
  193.          Begin VB.Label Label1 
  194.             Caption         =   "文件"
  195.             Height          =   255
  196.             Left            =   2880
  197.             TabIndex        =   19
  198.             Top             =   240
  199.             Width           =   495
  200.          End
  201.          Begin VB.Label Label2 
  202.             Caption         =   "目录"
  203.             Height          =   255
  204.             Left            =   2880
  205.             TabIndex        =   18
  206.             Top             =   1560
  207.             Width           =   975
  208.          End
  209.       End
  210.       Begin VB.Label Label5 
  211.          Caption         =   "本地路径:"
  212.          Height          =   255
  213.          Left            =   120
  214.          TabIndex        =   23
  215.          Top             =   960
  216.          Width           =   855
  217.       End
  218.       Begin VB.Label Label4 
  219.          Caption         =   "用户名:"
  220.          Height          =   255
  221.          Left            =   120
  222.          TabIndex        =   22
  223.          Top             =   240
  224.          Width           =   855
  225.       End
  226.       Begin VB.Label Label3 
  227.          Caption         =   "密码:"
  228.          Height          =   255
  229.          Left            =   120
  230.          TabIndex        =   20
  231.          Top             =   600
  232.          Width           =   855
  233.       End
  234.    End
  235.    Begin VB.Frame Frame2 
  236.       Caption         =   "用户"
  237.       Height          =   5175
  238.       Left            =   120
  239.       TabIndex        =   0
  240.       Top             =   0
  241.       Width           =   2295
  242.       Begin VB.CommandButton UsrRemove 
  243.          Caption         =   "移除"
  244.          Height          =   375
  245.          Left            =   1320
  246.          TabIndex        =   3
  247.          Top             =   4560
  248.          Width           =   855
  249.       End
  250.       Begin VB.CommandButton UsrAdd 
  251.          Caption         =   "添加"
  252.          Height          =   375
  253.          Left            =   120
  254.          TabIndex        =   2
  255.          Top             =   4560
  256.          Width           =   855
  257.       End
  258.       Begin VB.ListBox UserList 
  259.          Appearance      =   0  'Flat
  260.          Height          =   3990
  261.          ItemData        =   "UserOpts.frx":0004
  262.          Left            =   120
  263.          List            =   "UserOpts.frx":0006
  264.          TabIndex        =   1
  265.          Top             =   240
  266.          Width           =   2055
  267.       End
  268.    End
  269. End
  270. Attribute VB_Name = "UserOpts"
  271. Attribute VB_GlobalNameSpace = False
  272. Attribute VB_Creatable = False
  273. Attribute VB_PredeclaredId = True
  274. Attribute VB_Exposed = False
  275. Option Explicit
  276. Dim uItem As Integer
  277. Dim aItem As Integer
  278. Dim tStrng As String
  279. Dim uUser As Integer
  280. Dim Pcnt As Integer
  281. Private Type Priv
  282.   Path As String
  283.   Accs As String '[R]ead,[W]rite,[D]elete,e[X]ecute > Files
  284.                  '[L]ist,[M]ake,[K]ill,[S]ubs       > Dirs
  285. End Type
  286. Private Privs(20) As Priv
  287. Private Sub FDAdd_Click()
  288.   tStrng = Get_Path("")
  289.   If tStrng <> "" Then
  290.     AccsList.AddItem (tStrng)
  291.     Pcnt = Pcnt + 1
  292.     UserIDs.No(uUser).Priv(Pcnt).Path = tStrng
  293.     FDUpdate.Enabled = True
  294.     FDRemove.Enabled = True
  295.   End If
  296.   AccsList_False
  297. End Sub
  298. Private Sub FDEdit_Click()
  299.   tStrng = Get_Path(AccsList.Text)
  300.   If tStrng <> "" Then
  301.     AccsList.List(aItem) = tStrng
  302.     UserIDs.No(uUser).Priv(aItem + 1).Path = tStrng
  303.   End If
  304.   AccsList_False
  305. End Sub
  306. Private Sub FDRemove_Click()
  307. Dim z As Integer
  308.   For z = (aItem + 1) To UserIDs.No(uUser).Pcnt
  309.     UserIDs.No(uUser).Priv(z).Path = UserIDs.No(uUser).Priv(z + 1).Path
  310.     UserIDs.No(uUser).Priv(z).Accs = UserIDs.No(uUser).Priv(z + 1).Accs
  311.   Next
  312.   UserIDs.No(uUser).Pcnt = UserIDs.No(uUser).Pcnt - 1
  313.   AccsList.RemoveItem (aItem)
  314.   AccsList_False
  315. End Sub
  316. Private Sub FDUpdate_Click()
  317. Dim z As Integer, s As String
  318.   UserIDs.No(uUser).Name = UsrName
  319.   UserIDs.No(uUser).Pass = Pword
  320.   UserIDs.No(uUser).Home = HomeDir
  321.   UserIDs.No(uUser).Pcnt = Pcnt
  322.   s = ""
  323.   z = aItem + 1
  324.   If FRead.Value = 1 Then s = s & "R"
  325.   If FWrite.Value = 1 Then s = s & "W"
  326.   If FDelete.Value = 1 Then s = s & "D"
  327.   If FEx.Value = 1 Then s = s & "X"
  328.   If DList.Value = 1 Then s = s & "L"
  329.   If DMake.Value = 1 Then s = s & "M"
  330.   If DRemove.Value = 1 Then s = s & "K"
  331.   If DSub.Value = 1 Then s = s & "S"
  332.   Privs(z).Accs = s
  333.   UserIDs.No(uUser).Priv(z).Accs = s
  334.   AccsList_False
  335. End Sub
  336. Private Sub Form_Load()
  337. Dim x As Integer, y As Integer
  338.   y = UserIDs.Count
  339.   If (y > 0) Then
  340.     For x = 1 To UserIDs.Count
  341.       UserList.AddItem UserIDs.No(x).Name
  342.     Next
  343.   End If
  344.   aItem = -1
  345.   uItem = -1
  346.   AccsList_False
  347.   UserList_False
  348.   FDAdd.Enabled = False
  349. End Sub
  350. Private Sub Form_Terminate()
  351.   Unload Me
  352. End Sub
  353. Private Sub UserList_LostFocus()
  354.   ' If uItem >= 0 Then UserList_False
  355. End Sub
  356. Private Sub UsrDone_Click()
  357. Dim z As Integer
  358.   Form_Terminate
  359. End Sub
  360. Private Sub UsrRemove_Click()
  361. Dim z As Integer, i As Integer
  362.   z = UserIDs.Count
  363.   For i = uUser To z
  364.     UserIDs.No(i) = UserIDs.No(i + 1)
  365.   Next
  366.   UserList.RemoveItem (uItem)
  367.   UserIDs.Count = z - 1
  368.   AccsList.Clear
  369.   ClearAccs
  370.   UsrName = ""
  371.   Pword = ""
  372.   HomeDir = ""
  373.   aItem = -1
  374.   UserList_False
  375. End Sub
  376. Private Sub UsrAdd_Click()
  377. Dim i As Integer, S1 As String
  378.   S1 = "New User"
  379.   UsrName = S1
  380.   UserList.AddItem S1
  381.   i = UserIDs.Count + 1
  382.   UserIDs.No(i).Name = S1
  383.   UserIDs.Count = i
  384.   UserList_False
  385. End Sub
  386. Private Sub UserList_Click()
  387. Dim x As Integer, z As Integer
  388.   uItem = UserList.ListIndex
  389.   Debug.Print "User List Item = " & uItem
  390.   '[R]ead,[W]rite,[D]elete,e[X]ecute > Files
  391.   '[L]ist,[M]ake,[K]ill,[S]ubs       > Dirs
  392.   uUser = uItem + 1
  393.   AccsList.Clear
  394.   ClearAccs
  395.   Pword = ""
  396.   HomeDir = ""
  397.   aItem = -1
  398.   UserList_True
  399.   AccsList_False
  400.   FDAdd.Enabled = True
  401.   UsrName = UserIDs.No(uUser).Name
  402.   Pword = UserIDs.No(uUser).Pass
  403.   HomeDir = UserIDs.No(uUser).Home
  404.   Pcnt = UserIDs.No(uUser).Pcnt
  405.   For z = 1 To Pcnt
  406.     Privs(z).Path = UserIDs.No(uUser).Priv(z).Path
  407.     Privs(z).Accs = UserIDs.No(uUser).Priv(z).Accs
  408.     AccsList.AddItem Privs(z).Path
  409.   Next
  410. End Sub
  411. Private Sub AccsList_Click()
  412. Dim x As Integer, z As Integer
  413.   aItem = AccsList.ListIndex
  414.   Debug.Print "Access List Item = " & aItem
  415.   ClearAccs
  416.   AccsList_True
  417.   z = aItem + 1
  418.   Debug.Print UserIDs.No(uUser).Priv(z).Accs
  419.   If InStr(Privs(z).Accs, "R") Then
  420.     FRead.Value = 1
  421.   End If
  422.   If InStr(Privs(z).Accs, "W") Then
  423.     FWrite.Value = 1
  424.   End If
  425.   If InStr(Privs(z).Accs, "D") Then
  426.     FDelete.Value = 1
  427.   End If
  428.   If InStr(Privs(z).Accs, "X") Then
  429.     FEx.Value = 1
  430.   End If
  431.   If InStr(Privs(z).Accs, "L") Then
  432.     DList.Value = 1
  433.   End If
  434.   If InStr(Privs(z).Accs, "M") Then
  435.     DMake.Value = 1
  436.   End If
  437.   If InStr(Privs(z).Accs, "K") Then
  438.     DRemove.Value = 1
  439.   End If
  440.   If InStr(Privs(z).Accs, "S") Then
  441.     DSub.Value = 1
  442.   End If
  443. End Sub
  444. Private Sub AccsList_DblClick()
  445.   aItem = AccsList.ListIndex
  446.   tStrng = Get_Path(AccsList.Text)
  447.   If tStrng <> "" Then
  448.     AccsList.List(aItem) = tStrng
  449.     UserIDs.No(uUser).Priv(aItem + 1).Path = tStrng
  450.   End If
  451.   AccsList.Selected(aItem) = False
  452. End Sub
  453. Private Sub UserList_True()
  454.   UsrRemove.Enabled = True
  455. End Sub
  456. Private Sub UserList_False()
  457.   Debug.Print "uItem=" & uItem
  458.   UsrRemove.Enabled = False
  459.   If uItem >= 0 Then
  460.     UserList.Selected(uItem) = False
  461.     uItem = -1
  462.   End If
  463. End Sub
  464. Private Sub AccsList_True()
  465.   FDEdit.Enabled = True
  466.   FDRemove.Enabled = True
  467.   FDUpdate.Enabled = True
  468. End Sub
  469. Private Sub AccsList_False()
  470.   Debug.Print "aItem=" & aItem
  471.   FDEdit.Enabled = False
  472.   FDRemove.Enabled = False
  473.   FDUpdate.Enabled = False
  474.   If aItem >= 0 Then
  475.     AccsList.Selected(aItem) = False
  476.     aItem = -1
  477.   End If
  478. End Sub
  479. Private Sub ClearAccs()
  480.   FRead.Value = 0
  481.   FWrite.Value = 0
  482.   FDelete.Value = 0
  483.   FEx.Value = 0
  484.   DList.Value = 0
  485.   DMake.Value = 0
  486.   DRemove.Value = 0
  487.   DSub.Value = 0
  488. End Sub
  489. Function Get_Path(olds As String) As String
  490.   AddEditDir.DirPath = olds
  491.   AddEditDir.Show 1
  492.   If Tag <> "" Then
  493.     Get_Path = Tag
  494.     Tag = ""
  495.   End If
  496. End Function