控制台编程

开发平台：
Visual Basic

frmUser.frm：源码内容
							VERSION 5.00
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "mscomctl.ocx"
Begin VB.Form frmUser 
   Caption         =   "用户管理"
   ClientHeight    =   3945
   ClientLeft      =   45
   ClientTop       =   435
   ClientWidth     =   5160
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   3945
   ScaleWidth      =   5160
   StartUpPosition =   2  '屏幕中心
   Begin MSComctlLib.ImageList ImList 
      Left            =   4200
      Top             =   600
      _ExtentX        =   1005
      _ExtentY        =   1005
      BackColor       =   -2147483643
      ImageWidth      =   16
      ImageHeight     =   16
      MaskColor       =   12632256
      _Version        =   393216
      BeginProperty Images {2C247F25-8591-11D1-B16A-00C0F0283628} 
         NumListImages   =   5
         BeginProperty ListImage1 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "frmUser.frx":0000
            Key             =   ""
         EndProperty
         BeginProperty ListImage2 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "frmUser.frx":08DA
            Key             =   ""
         EndProperty
         BeginProperty ListImage3 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "frmUser.frx":11B4
            Key             =   ""
         EndProperty
         BeginProperty ListImage4 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "frmUser.frx":1A8E
            Key             =   ""
         EndProperty
         BeginProperty ListImage5 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "frmUser.frx":2368
            Key             =   ""
         EndProperty
      EndProperty
   End
   Begin VB.Frame Frame1 
      Caption         =   "用户列表"
      Height          =   2535
      Left            =   120
      TabIndex        =   7
      Top             =   1080
      Width           =   2295
      Begin VB.ListBox lstname 
         BackColor       =   &H00FFFFFF&
         ForeColor       =   &H00FF0000&
         Height          =   1860
         Left            =   120
         TabIndex        =   8
         Top             =   360
         Width           =   2055
      End
   End
   Begin VB.Frame Frame2 
      Caption         =   "添加新用户"
      Height          =   2535
      Left            =   2520
      TabIndex        =   0
      Top             =   1080
      Width           =   2535
      Begin VB.CommandButton CmdOK 
         Caption         =   "确定"
         Default         =   -1  'True
         Height          =   375
         Left            =   120
         Picture         =   "frmUser.frx":2C42
         Style           =   1  'Graphical
         TabIndex        =   4
         Top             =   2040
         Width           =   735
      End
      Begin VB.CommandButton CmdNO 
         Caption         =   "取消"
         Height          =   375
         Left            =   1680
         Picture         =   "frmUser.frx":2F4C
         Style           =   1  'Graphical
         TabIndex        =   3
         Top             =   2040
         Width           =   735
      End
      Begin VB.TextBox txtUser 
         Appearance      =   0  'Flat
         ForeColor       =   &H00FF0000&
         Height          =   375
         Left            =   1080
         TabIndex        =   2
         Top             =   480
         Width           =   1215
      End
      Begin VB.TextBox txtPassword 
         Appearance      =   0  'Flat
         ForeColor       =   &H00FF0000&
         Height          =   375
         IMEMode         =   3  'DISABLE
         Left            =   1080
         PasswordChar    =   "*"
         TabIndex        =   1
         Top             =   1200
         Width           =   1215
      End
      Begin VB.Label lb1 
         BackStyle       =   0  'Transparent
         Caption         =   "用户名："
         ForeColor       =   &H00FF0000&
         Height          =   255
         Left            =   120
         TabIndex        =   6
         Top             =   480
         Width           =   975
      End
      Begin VB.Label lb2 
         BackStyle       =   0  'Transparent
         Caption         =   "密  码："
         ForeColor       =   &H00FF0000&
         Height          =   372
         Left            =   120
         TabIndex        =   5
         Top             =   1200
         Width           =   852
      End
   End
   Begin MSComctlLib.Toolbar Tlbar 
      Align           =   1  'Align Top
      Height          =   570
      Left            =   0
      TabIndex        =   9
      Top             =   0
      Width           =   5160
      _ExtentX        =   9102
      _ExtentY        =   1005
      ButtonWidth     =   820
      ButtonHeight    =   953
      Appearance      =   1
      Style           =   1
      ImageList       =   "ImList"
      _Version        =   393216
      BeginProperty Buttons {66833FE8-8583-11D1-B16A-00C0F0283628} 
         NumButtons      =   7
         BeginProperty Button1 {66833FEA-8583-11D1-B16A-00C0F0283628} 
            Caption         =   "添加"
            Key             =   "Add"
            ImageIndex      =   1
         EndProperty
         BeginProperty Button2 {66833FEA-8583-11D1-B16A-00C0F0283628} 
            Caption         =   "删除"
            Key             =   "Del"
            ImageIndex      =   2
         EndProperty
         BeginProperty Button3 {66833FEA-8583-11D1-B16A-00C0F0283628} 
            Style           =   3
         EndProperty
         BeginProperty Button4 {66833FEA-8583-11D1-B16A-00C0F0283628} 
            Caption         =   "保存"
            Key             =   "Save"
            ImageIndex      =   3
         EndProperty
         BeginProperty Button5 {66833FEA-8583-11D1-B16A-00C0F0283628} 
            Caption         =   "撤销"
            Key             =   "Undo"
            ImageIndex      =   4
         EndProperty
         BeginProperty Button6 {66833FEA-8583-11D1-B16A-00C0F0283628} 
            Style           =   3
         EndProperty
         BeginProperty Button7 {66833FEA-8583-11D1-B16A-00C0F0283628} 
            Caption         =   "退出"
            Key             =   "Exit"
            ImageIndex      =   5
         EndProperty
      EndProperty
   End
   Begin VB.Label x 
      BackStyle       =   0  'Transparent
      Caption         =   "已启用"
      ForeColor       =   &H000000FF&
      Height          =   255
      Left            =   120
      TabIndex        =   10
      Top             =   3720
      Visible         =   0   'False
      Width           =   1575
   End
End
Attribute VB_Name = "frmUser"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Public dbs As Database
Public rec As Recordset
Public rec1 As Recordset
Sub save()
  If txtUser.Text = "" Then
  Exit Sub
  End If
  
  filename = App.Path & "dbmaterialinfo2007.mdb"
  Set dbs = OpenDatabase(filename)
  Set rec = dbs.OpenRecordset("用户信息表")
         rec.AddNew
         rec.Fields(0) = txtUser.Text
         rec.Fields(1) = txtPassword.Text
         rec.Update
                
  Set rec1 = dbs.OpenRecordset("用户角色表")
         rec1.AddNew
         rec1.Fields(5) = txtUser.Text
         rec1.Fields(6) = txtPassword.Text
         rec1.Update
         
         lstname.AddItem txtUser.Text
         txtUser.Text = ""
         txtPassword.Text = ""
         txtUser.SetFocus
End Sub
Private Sub CmdNO_Click()
Unload Me
End Sub
Private Sub CmdOK_Click()
save
End Sub
Private Sub Form_Load()
CmdOK.Enabled = False
txtUser.Enabled = False
txtPassword.Enabled = False
  
  filename = App.Path & "dbmaterialinfo2007.mdb"
  Set dbs = OpenDatabase(filename)
  Set rec = dbs.OpenRecordset("用户信息表")
  Set rec1 = dbs.OpenRecordset("用户角色表")
  
  If rec.RecordCount = 0 Then
  Exit Sub
  End If
  
  If rec1.RecordCount = 0 Then
  Exit Sub
  End If
  
  
Do While Not rec.EOF
   lstname.AddItem rec.Fields(0)
   rec.MoveNext
   rec1.MoveNext
Loop
     Tlbar.Buttons(2).Enabled = False
     Tlbar.Buttons(3).Enabled = False
     Tlbar.Buttons(4).Enabled = False
End Sub
Private Sub Tlbar_ButtonClick(ByVal Button As MSComctlLib.Button)
 Select Case Button.key
     Case "Add"
       Changed = False
       Tlbar.Buttons(5).Enabled = False
       txtUser.Enabled = True
       txtPassword.Enabled = True
       txtUser.Text = ""
       txtPassword.Text = ""
       txtUser.SetFocus
       CmdOK.Enabled = False
    Case "Undo"
       txtUser.Text = ""
       txtPassword.Text = ""
       Tlbar.Buttons(2).Enabled = False
       Tlbar.Buttons(3).Enabled = False
       Tlbar.Buttons(5).Enabled = False
    Case "Save"
        Tlbar.Buttons(2).Enabled = False
        save
    Case "Del"
        r = MsgBox("确定删除吗？(Y/N)", 1 + 64, "自动配料系统")
      If r = 1 Then
          dbs.Execute "DELETE * FROM " & "[用户信息表] WHERE name ='" & lstname.Text & "'"
          
          dbs.Execute "DELETE * FROM " & "[用户角色表] WHERE name ='" & lstname.Text & "'"
          
          txtUser.Text = ""
          lstname.RemoveItem lstname.ListIndex
          txtPassword.Text = ""
      End If
    Case "Exit"
          Unload Me
    End Select
End Sub
Private Sub txtPassword_Change()
  CmdOK.Enabled = True
  Tlbar.Buttons(4).Enabled = True
End Sub
Private Sub lstname_Click()
    If lstname.Text = "SuperUser" Then
       Tlbar.Buttons(2).Enabled = False
    Else
       Tlbar.Buttons(2).Enabled = True
    End If
End Sub

						