控制台编程

开发平台：
Visual Basic

frmPermission.frm：源码内容
							VERSION 5.00
Object = "{67397AA1-7FB1-11D0-B148-00A0C922E820}#6.0#0"; "MSADODC.OCX"
Object = "{F0D2F211-CCB0-11D0-A316-00AA00688B10}#1.0#0"; "MSDATLST.OCX"
Object = "{BDC217C8-ED16-11CD-956C-0000C04E4C0A}#1.1#0"; "TABCTL32.OCX"
Begin VB.Form frmPermission 
   BorderStyle     =   3  'Fixed Dialog
   Caption         =   "用户权限"
   ClientHeight    =   5295
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   8775
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   5295
   ScaleWidth      =   8775
   ShowInTaskbar   =   0   'False
   StartUpPosition =   1  '所有者中心
   Begin VB.Frame frame3 
      Caption         =   "现有用户信息"
      Height          =   5085
      Left            =   120
      TabIndex        =   3
      Top             =   120
      Width           =   3525
      Begin MSDataListLib.DataList DataList1 
         DataSource      =   "ado1"
         Height          =   4470
         Left            =   210
         TabIndex        =   4
         Top             =   330
         Width           =   3120
         _ExtentX        =   5503
         _ExtentY        =   7885
         _Version        =   393216
         ListField       =   "name"
      End
      Begin MSAdodcLib.Adodc ado1 
         Height          =   330
         Left            =   120
         Top             =   4680
         Visible         =   0   'False
         Width           =   2280
         _ExtentX        =   4022
         _ExtentY        =   582
         ConnectMode     =   0
         CursorLocation  =   3
         IsolationLevel  =   -1
         ConnectionTimeout=   15
         CommandTimeout  =   30
         CursorType      =   3
         LockType        =   3
         CommandType     =   2
         CursorOptions   =   0
         CacheSize       =   50
         MaxRecords      =   0
         BOFAction       =   0
         EOFAction       =   0
         ConnectStringType=   1
         Appearance      =   1
         BackColor       =   -2147483643
         ForeColor       =   -2147483640
         Orientation     =   0
         Enabled         =   -1
         Connect         =   "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=dbmaterialinfo2007.mdb;Persist Security Info=False"
         OLEDBString     =   "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=dbmaterialinfo2007.mdb;Persist Security Info=False"
         OLEDBFile       =   ""
         DataSourceName  =   ""
         OtherAttributes =   ""
         UserName        =   ""
         Password        =   ""
         RecordSource    =   "用户角色表"
         Caption         =   "adoXS"
         BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
            Name            =   "宋体"
            Size            =   9
            Charset         =   134
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         _Version        =   393216
      End
   End
   Begin VB.CommandButton Command3 
      Caption         =   "确定退出"
      Height          =   375
      Left            =   7080
      TabIndex        =   2
      Top             =   4800
      Width           =   1545
   End
   Begin VB.CommandButton Command2 
      Caption         =   "全不选"
      Height          =   375
      Left            =   5400
      TabIndex        =   1
      Top             =   4800
      Width           =   1620
   End
   Begin VB.CommandButton Command1 
      Caption         =   "全选"
      Height          =   375
      Left            =   3720
      TabIndex        =   0
      Top             =   4800
      Width           =   1620
   End
   Begin TabDlg.SSTab SSTab1 
      Height          =   4455
      Left            =   3720
      TabIndex        =   5
      Top             =   240
      Width           =   4935
      _ExtentX        =   8705
      _ExtentY        =   7858
      _Version        =   393216
      Tabs            =   1
      TabsPerRow      =   1
      TabHeight       =   520
      BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
         Name            =   "宋体"
         Size            =   9
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      TabCaption(0)   =   "用户权限设置"
      TabPicture(0)   =   "frmPermission.frx":0000
      Tab(0).ControlEnabled=   -1  'True
      Tab(0).Control(0)=   "Check1(0)"
      Tab(0).Control(0).Enabled=   0   'False
      Tab(0).Control(1)=   "Check1(1)"
      Tab(0).Control(1).Enabled=   0   'False
      Tab(0).Control(2)=   "Check1(2)"
      Tab(0).Control(2).Enabled=   0   'False
      Tab(0).Control(3)=   "Check1(3)"
      Tab(0).Control(3).Enabled=   0   'False
      Tab(0).Control(4)=   "Check1(4)"
      Tab(0).Control(4).Enabled=   0   'False
      Tab(0).ControlCount=   5
      Begin VB.CheckBox Check1 
         Caption         =   "Check1"
         Height          =   195
         Index           =   4
         Left            =   840
         TabIndex        =   10
         Top             =   3360
         Width           =   1875
      End
      Begin VB.CheckBox Check1 
         Caption         =   "Check1"
         Height          =   225
         Index           =   3
         Left            =   840
         TabIndex        =   9
         Top             =   2520
         Width           =   1875
      End
      Begin VB.CheckBox Check1 
         Caption         =   "Check1"
         Height          =   225
         Index           =   2
         Left            =   840
         TabIndex        =   8
         Top             =   1800
         Width           =   1875
      End
      Begin VB.CheckBox Check1 
         Caption         =   "Check1"
         Height          =   225
         Index           =   1
         Left            =   840
         TabIndex        =   7
         Top             =   1080
         Width           =   1875
      End
      Begin VB.CheckBox Check1 
         Caption         =   "Check1"
         Height          =   225
         Index           =   0
         Left            =   840
         TabIndex        =   6
         Top             =   480
         Width           =   1875
      End
   End
End
Attribute VB_Name = "frmPermission"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim rs1 As New ADODB.Recordset
Dim i As Integer
Function cnn() As ADODB.Connection
  Set cnn = New ADODB.Connection
  cnn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & App.Path & "dbmaterialinfo2007.mdb;Persist Security Info=False"
End Function
Private Sub Form_Activate()
   ado1.Refresh
   DataList1.SetFocus
End Sub
Private Sub Form_Load()
  ado1.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & App.Path & "dbmaterialinfo2007.mdb;Persist Security Info=False"
  Set DataList1.RowSource = ado1
  rs1.Open "用户角色表", cnn, adOpenKeyset, adLockOptimistic
  For i = 0 To Check1.UBound
      Check1(i).Caption = rs1.Fields(i).Name
  Next i
  rs1.Close
  DataList1.Text = ado1.Recordset.Fields("name")
  DataList1_Click
End Sub
Private Sub Command1_Click()     '全选
  For i = 0 To Check1.UBound
     Check1(i).Value = 1
  Next i
End Sub
Private Sub Command2_Click()     '全不选
  For i = 0 To Check1.UBound
     Check1(i).Value = 0
  Next i
End Sub
Private Sub Command3_Click()     '为操作员设置权限
  rs1.Open "select * from   用户角色表  where name='" & DataList1.BoundText & "'", cnn, adOpenKeyset, adLockOptimistic
  If rs1.RecordCount > 0 Then
    For i = 0 To Check1.UBound
       If Check1(i).Value = 1 Then rs1.Fields(i) = True Else rs1.Fields(i) = False
    Next i
   rs1.Update
  End If
  rs1.Close
  
 Unload Me
End Sub
Private Sub DataList1_Click()     '查看操作员权限
 rs1.Open "select * from 用户角色表 where name='" & DataList1.BoundText & "'", cnn, adOpenKeyset, adLockOptimistic
 SSTab1.Caption = "用户(" + Trim(DataList1.BoundText) + ")的权限设置"
 If rs1.RecordCount > 0 Then
  For i = 0 To Check1.UBound
    If rs1.Fields(i) = True Then Check1(i).Value = 1 Else Check1(i).Value = 0
  Next i
  rs1.Update
 End If
 rs1.Close
End Sub

						