frmuser.frm

一个关于进销存的源代码

VERSION 5.00
Object = "{67397AA1-7FB1-11D0-B148-00A0C922E820}#6.0#0"; "msadodc.ocx"
Begin VB.Form frmuser 
   AutoRedraw      =   -1  'True
   BackColor       =   &H00FF8080&
   BorderStyle     =   3  'Fixed Dialog
   Caption         =   "添加"
   ClientHeight    =   3495
   ClientLeft      =   45
   ClientTop       =   435
   ClientWidth     =   3480
   Icon            =   "frmuser.frx":0000
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MDIChild        =   -1  'True
   MinButton       =   0   'False
   Moveable        =   0   'False
   ScaleHeight     =   3495
   ScaleWidth      =   3480
   ShowInTaskbar   =   0   'False
   Begin MSAdodcLib.Adodc Adodc1 
      Height          =   735
      Left            =   1440
      Top             =   3960
      Width           =   1575
      _ExtentX        =   2778
      _ExtentY        =   1296
      ConnectMode     =   0
      CursorLocation  =   3
      IsolationLevel  =   -1
      ConnectionTimeout=   15
      CommandTimeout  =   30
      CursorType      =   3
      LockType        =   3
      CommandType     =   8
      CursorOptions   =   0
      CacheSize       =   50
      MaxRecords      =   0
      BOFAction       =   0
      EOFAction       =   0
      ConnectStringType=   1
      Appearance      =   1
      BackColor       =   -2147483643
      ForeColor       =   -2147483640
      Orientation     =   0
      Enabled         =   -1
      Connect         =   ""
      OLEDBString     =   ""
      OLEDBFile       =   ""
      DataSourceName  =   ""
      OtherAttributes =   ""
      UserName        =   ""
      Password        =   ""
      RecordSource    =   ""
      Caption         =   "Adodc1"
      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
   Begin VB.CommandButton Command5 
      BackColor       =   &H00FF8080&
      Caption         =   "关闭"
      Height          =   495
      Left            =   2040
      TabIndex        =   6
      Top             =   2880
      Width           =   1335
   End
   Begin VB.CommandButton Command4 
      BackColor       =   &H00FF8080&
      Caption         =   "更改用户类型"
      Height          =   495
      Left            =   2040
      TabIndex        =   5
      Top             =   2280
      Width           =   1335
   End
   Begin VB.CommandButton Command3 
      BackColor       =   &H00FF8080&
      Caption         =   "更改密码"
      Height          =   495
      Left            =   2040
      TabIndex        =   4
      Top             =   1080
      Width           =   1335
   End
   Begin VB.CommandButton Command2 
      BackColor       =   &H00FF8080&
      Caption         =   "删除用户"
      Height          =   495
      Left            =   2040
      TabIndex        =   3
      Top             =   1680
      Width           =   1335
   End
   Begin VB.CommandButton Command1 
      BackColor       =   &H00FF8080&
      Caption         =   "添加用户"
      Height          =   495
      Left            =   2040
      TabIndex        =   2
      Top             =   480
      Width           =   1335
   End
   Begin VB.ListBox List1 
      BackColor       =   &H00FFC0C0&
      Height          =   2040
      ItemData        =   "frmuser.frx":030A
      Left            =   120
      List            =   "frmuser.frx":030C
      TabIndex        =   1
      Top             =   1320
      Width           =   1815
   End
   Begin VB.ComboBox Combo1 
      BackColor       =   &H00FF8080&
      Height          =   300
      Left            =   120
      Style           =   2  'Dropdown List
      TabIndex        =   0
      Top             =   480
      Width           =   1815
   End
   Begin VB.Label Label2 
      BackColor       =   &H00FF8080&
      Caption         =   "用户列表:"
      Height          =   255
      Left            =   120
      TabIndex        =   8
      Top             =   960
      Width           =   1455
   End
   Begin VB.Label Label1 
      BackColor       =   &H00FF8080&
      Caption         =   "用户类型:"
      Height          =   255
      Left            =   120
      TabIndex        =   7
      Top             =   120
      Width           =   1695
   End
End
Attribute VB_Name = "frmuser"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Sub Combo1_click()
        List1.Clear
            Dim rdst As New ADODB.Recordset
                rdst.Open "select * from userlist where 用户类型 = " & Combo1.ListIndex & "", g_conn
        Do While Not rdst.EOF
            List1.AddItem rdst!用户名, 0
            rdst.MoveNext
        Loop
End Sub
Private Sub Command1_Click()
    frmID.Show
End Sub
Private Sub Command2_Click()
        If List1.Text = "" Then Exit Sub
        If List1.Text = curuser Then
            tishi = MsgBox("不能删除当前记录！", vbOKOnly, "删除用户错误")
            Exit Sub
        End If
        Dim rdst As New ADODB.Recordset
        rdst.Open "delete * from userlist where 用户名 ='" & List1.Text & "'", g_conn
        tishi = MsgBox("已成功删除！", vbOKOnly, "删除记录")
End Sub
Private Sub Command3_Click()
    If List1.Text = "" Then
        tishi = MsgBox("请选择用户名！", vbOKOnly, "错误")
        Exit Sub
    End If
    frmmodipassword.Show
End Sub
Private Sub Command4_Click()
        If List1.Text = "" Then
            tishi = MsgBox("请选择用户名！", vbOKOnly, "错误")
            Exit Sub
        End If
        frmmodiusertype.Show
End Sub
Private Sub Command5_Click()
        Unload Me
End Sub
Private Sub Form_Load()
        
        Me.Left = 6000
        Me.Top = 3000
        Combo1.AddItem "管理人员", 0
        Combo1.AddItem "浏览人员", 1
        Combo1.ListIndex = 0
        List1.Clear
        Dim rdst As New ADODB.Recordset
            rdst.Open "select * from userlist where 用户类型 = " & Combo1.ListIndex & "", g_conn
        Do While Not rdst.EOF
            List1.AddItem rdst!用户名, 0
        rdst.MoveNext
        Loop
End Sub
Sub addid()
    Dim rdst As New ADODB.Recordset
        rdst.Open "select * from userlist where 用户名 = '" & id & "'", g_conn
        If rdst.EOF = False Then
                tishi = MsgBox("用户名重复！请重新添加", vbOKOnly, "用户添加")
        Else
           frmpassword.Show
        End If
End Sub