frmsysuser.frm

一个资金管理系统的成品 开发环境：VB

      _ExtentX        =   2566
      _ExtentY        =   582
      _Version        =   393216
      Enabled         =   0   'False
      Text            =   "DataCombo1"
   End
   Begin VB.Label Labuseryhqx 
      BackStyle       =   0  'Transparent
      Caption         =   "用户权限"
      BeginProperty Font 
         Name            =   "MS Sans Serif"
         Size            =   12
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   375
      Left            =   240
      TabIndex        =   4
      Top             =   840
      Width           =   1215
   End
   Begin VB.Label Labuseryhkl 
      BackStyle       =   0  'Transparent
      Caption         =   "用户口令"
      BeginProperty Font 
         Name            =   "MS Sans Serif"
         Size            =   12
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   375
      Left            =   3360
      TabIndex        =   2
      Top             =   240
      Width           =   1095
   End
   Begin VB.Label Labuseryhmc 
      BackStyle       =   0  'Transparent
      Caption         =   "用户名称"
      BeginProperty Font 
         Name            =   "MS Sans Serif"
         Size            =   12
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   375
      Left            =   240
      TabIndex        =   0
      Top             =   240
      Width           =   1095
   End
End
Attribute VB_Name = "frmsysuser"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim addrecord As Variant
Dim conn As New ADODB.Connection
Dim rscompanyuser As New ADODB.Recordset
Dim rsusertype As New ADODB.Recordset

'设置系统用户管理中按钮的状态
Private Sub setbuttons(bval As Boolean)
    For i = 0 To 5
       cmduser(i).Enabled = bval
    Next i
    cmduser(6).Enabled = Not bval
    dacomyhmc.Enabled = Not bval
    Dacomyhkl.Enabled = Not bval
    Dalistyhqx.Enabled = Not bval
    DataGrid1.Enabled = bval
    If bval Then
       cmduser(7).Caption = "退出"
    Else
       cmduser(7).Caption = "取消"
    End If
    Exit Sub
End Sub
'系统用户管理中记录增加或修改后的字段检验
Private Function usercheck() As Boolean
   Dim id As Integer
   Dim str As String
   Dim note(3) As String
   note(0) = "用户名称不能为空！"
   note(1) = "用户权限不能为空！"
   note(2) = "该用户名称已经存在！"
   usercheck = False
   Set rstemp = conn.Execute("select * from companyuser")
   If dacomyhmc.Text = "" Then
       MsgBox note(0)
       dacomyhmc.SetFocus
       Exit Function
   End If
   If Dalistyhqx.Text = "" Then
       MsgBox note(1)
       Dalistyhqx.SetFocus
       Exit Function
   End If
   id = rscompanyuser.Fields("xuhao")
   If addrecord = True Then
       str = "select * from companyuser where yhmc='" & dacomyhmc.Text & "'"
       Set rs = conn.Execute(str)
   Else
      str = "select * from companyuser where yhmc='" & dacomyhmc.Text _
       & "' and xuhao <> '" & id & "'"
      Set rs = conn.Execute(str)
   End If
   If rs.EOF Then
      usercheck = True
   Else
     MsgBox note(2)
     dacomyhmc.SetFocus
   End If
   Exit Function
End Function
Private Sub cmduser_Click(Index As Integer)
  Dim i As Integer
Dim result As Boolean
Dim m_name As String
Dim bookmark As Variant
On Error GoTo adderr
Select Case Index
  Case 0  '添加按钮
       addrecord = True
       rscompanyuser.AddNew
       setbuttons False
       dacomyhmc.SetFocus
       Exit Sub
  Case 1   '修改按钮
       addrecord = False
       setbuttons False
       dacomyhmc.SetFocus
       Exit Sub
  Case 2   '查询按钮
      bookmark = rscompanyuser.bookmark
      m_name = InputBox("请输入用户名称", "按用户名称搜索")
      If m_name = "" Then
         Exit Sub
      End If
      rscompanyuser.MoveFirst
      rscompanyuser.Find "yhmc like '%" & m_name & "%'"
      If rscompanyuser.EOF Then
         MsgBox "没有该用户！"
         rscompanyuser.bookmark = bookmark
      End If
      Exit Sub
  Case 3   '删除按钮
      If MsgBox("你确认要删除该条记录吗？", vbexclaimation + vbOKCancel, "记录删除") = vbCancel Then
          Exit Sub
      End If
      With rscompanyuser
         '删除该纪录
          .Delete
          .UpdateBatch adAffectCurrent
          'conn.Execute ("update companyuser set xuhao=xuhao-1 where xuhao>" & i)
          'If .RecordCount <= 0 Then
          '   Adodc1.Enabled = False
          '   Exit Sub
          'End If
          '移到下一条
          .MoveNext
          '如果到文件尾，移到最后一条
          If .EOF Then .MoveLast
      End With
      Exit Sub
   Case 4   '下一条
     rscompanyuser.MoveNext
     If rscompanyuser.EOF Then
        MsgBox "这是最后一个记录！"
        rscompanyuser.MovePrevious
     End If
     Exit Sub
  Case 5   '上一条
     rscompanyuser.MovePrevious
     If rscompanyuser.BOF Then
        MsgBox "这是第一个记录！"
        rscompanyuser.MoveNext
     End If
     Exit Sub
  Case 6  '保存按钮
       result = usercheck()
       If result = True Then
           rscompanyuser.UpdateBatch adAffectCurrent
           setbuttons True
           MsgBox "保存成功！"
       End If
       Exit Sub
  Case 7   ' 退出或取消按钮
       If cmduser(Index).Caption = "退出" Then
         Unload Me
       Else
         rscompanyuser.CancelUpdate
         setbuttons True
         Exit Sub
       End If
End Select
Exit Sub
adderr:
  MsgBox Err.Description
  Unload Me
End Sub

Private Sub Form_Load()
Dim fieldname(4) As Variant
Dim wide(4) As Variant
Dim str As String
fieldname(0) = "序号"
fieldname(1) = "用户名称"
fieldname(2) = "用户口令"
fieldname(3) = "用户级别"
wide(0) = 400
wide(1) = 1400
wide(2) = 1400
wide(3) = 1400
'connstring = "Provider=SQLOLEDB.1;Password=db0822;Persist Security Info=True;User ID=sa;Initial Catalog=promotetest;Server=192.168.1.123"
str = "Provider=SQLOLEDB.1;Password=090309;Persist Security Info=True;User ID=cw;Initial Catalog=ysgl2004;Data Source=CWSERVER"
If conn.State <> 1 Then
    conn.CursorLocation = adUseClient
    conn.Open nowconnectstring
End If
rscompanyuser.Open "select * from companyuser", conn, adOpenDynamic, adLockBatchOptimistic
rsusertype.Open "select * from usertype", conn, adOpenDynamic, adLockBatchOptimistic
Set DataGrid1.DataSource = rscompanyuser
rscompanyuser.MoveNext
For i = 0 To 3
    DataGrid1.Columns(i).Caption = fieldname(i)
    DataGrid1.Columns(i).Width = wide(i)
    DataGrid1.Columns(i).DataField = rscompanyuser.Fields(i).Name
Next i
Set dacomyhmc.DataSource = rscompanyuser
dacomyhmc.DataField = rscompanyuser.Fields("yhmc").Name
Set Dacomyhkl.DataSource = rscompanyuser
Dacomyhkl.DataField = rscompanyuser.Fields("yhkl").Name
Set Dalistyhqx.DataSource = rscompanyuser
Dalistyhqx.DataField = rscompanyuser.Fields("yhjb").Name
Set Dalistyhqx.RowSource = rsusertype
Dalistyhqx.ListField = rsusertype.Fields("yhjb").Name
End Sub

Private Sub Form_Unload(Cancel As Integer)
'rs.Close
conn.Close
End Sub