newuser.frm

这个是我以前做的一个客户管理系统.包内已经含有源码和所用到的控件.代码是用VB写的,数据库采用MSSQL的.

VERSION 5.00
Begin VB.Form frmNewUser 
   BorderStyle     =   3  'Fixed Dialog
   Caption         =   "用户设置"
   ClientHeight    =   2010
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   3555
   Icon            =   "NewUser.frx":0000
   KeyPreview      =   -1  'True
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   2010
   ScaleWidth      =   3555
   ShowInTaskbar   =   0   'False
   StartUpPosition =   3  '窗口缺省
   Begin VB.TextBox txtNewPass 
      Height          =   315
      IMEMode         =   3  'DISABLE
      Left            =   1230
      PasswordChar    =   "*"
      TabIndex        =   2
      Text            =   "Text3"
      Top             =   990
      Width           =   1845
   End
   Begin VB.TextBox txtOldPass 
      Height          =   315
      IMEMode         =   3  'DISABLE
      Left            =   1230
      PasswordChar    =   "*"
      TabIndex        =   1
      Text            =   "Text2"
      Top             =   540
      Width           =   1845
   End
   Begin VB.TextBox txtUserName 
      Height          =   315
      Left            =   1230
      TabIndex        =   0
      Text            =   "Text1"
      Top             =   120
      Width           =   1845
   End
   Begin VB.CommandButton cmdOK 
      Caption         =   "确定"
      Height          =   375
      Left            =   480
      TabIndex        =   3
      Top             =   1470
      Width           =   1125
   End
   Begin VB.CommandButton cmdCancel 
      Caption         =   "取消"
      Height          =   375
      Left            =   1890
      TabIndex        =   4
      Top             =   1470
      Width           =   1125
   End
   Begin VB.Label Label3 
      Caption         =   "新密码："
      Height          =   225
      Left            =   450
      TabIndex        =   7
      Top             =   1050
      Width           =   975
   End
   Begin VB.Label Label2 
      Caption         =   "旧密码："
      Height          =   225
      Left            =   450
      TabIndex        =   6
      Top             =   570
      Width           =   975
   End
   Begin VB.Label Label1 
      Caption         =   "用户名："
      Height          =   225
      Left            =   450
      TabIndex        =   5
      Top             =   180
      Width           =   975
   End
End
Attribute VB_Name = "frmNewUser"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

Public mUserID As Integer   '修改的用户编号
Public mbAddNew As Boolean  '是否是新增

Private Sub ShowOldUser(ByVal UserID As Integer)
'*****************************************
'检查输入的数据是否正确
'
'*****************************************
Dim Rs  As New ADODB.Recordset
Dim sSql As String

On Error GoTo Err_Handle
    
    sSql = "Select User_ID,UserName,UserPass from Users where User_ID=" & UserID
    Screen.MousePointer = vbHourglass
    Rs.Open sSql, CN
    Screen.MousePointer = vbDefault
    
    If Rs.EOF = False Then
        txtUserName.Tag = IIf(IsNull(Rs.Fields!User_ID), "", Rs.Fields!User_ID)
        txtUserName.Text = IIf(IsNull(Rs.Fields!UserName), "", Rs.Fields!UserName)
        txtOldPass.Text = IIf(IsNull(Rs.Fields!UserPass), "", Rs.Fields!UserPass)
        txtNewPass.Text = IIf(IsNull(Rs.Fields!UserPass), "", Rs.Fields!UserPass)
    End If
    Rs.Close
    
    txtUserName.Enabled = False
    
Exit Sub
Err_Handle:
    Screen.MousePointer = vbDefault
    gShowMsg "检查数据的正确性时出错，frmNewUser.ShowOldUser()"
End Sub
Private Function CheckInput() As Boolean
'*****************************************
'检查输入的数据是否正确
'
'*****************************************
    
    CheckInput = True

    If txtUserName = "" Then
        MsgBox "请输入用户名！", vbInformation, ""
        CheckInput = False
    ElseIf txtOldPass = "" Or txtNewPass = "" Then
        MsgBox "请输入密码！", vbInformation, ""
        CheckInput = False
    ElseIf txtOldPass <> txtNewPass Then
        MsgBox "两次输入的密码不一样，请重新输入！", vbInformation, ""
        CheckInput = False
    End If


End Function

Private Function AddNewUser() As Boolean
'*****************************************
'新增一个用户
'
'*****************************************
Dim Rs As New ADODB.Recordset
Dim sStr As String
Dim iUserID As Integer
    
On Error GoTo Err_Handle
    '检查数据正确性
    If CheckInput = False Then AddNewUser = False: Exit Function
    
    Screen.MousePointer = vbHourglass
    
    Rs.Open "Select max(User_ID) from Users", CN
    If IsNull(Rs.Fields(0)) Then
        iUserID = 1
    Else
        iUserID = Rs.Fields(0) + 1
    End If
    CN.Execute "Insert into Users(User_ID,UserName,UserPass) values(" & iUserID & ",'" & DoubleQuote(Trim(txtUserName)) & "','" & DoubleQuote(txtOldPass) & "')"
    
    Screen.MousePointer = vbDefault
    AddNewUser = True
    
Exit Function
Err_Handle:
    Screen.MousePointer = vbDefault
    AddNewUser = False
    gShowMsg "新增一个用户时出错，frmAddNewUser.AddNewUser()"

End Function

Private Function ModifyUser() As Boolean
'*****************************************
'修改用户
'
'*****************************************
    
On Error GoTo Err_Handle
    '检查数据正确性
    If CheckInput = False Then ModifyUser = False: Exit Function
    
    Screen.MousePointer = vbHourglass
    
    CN.Execute "Update  Users set UserPass='" & DoubleQuote(txtNewPass) & "' where User_ID=" & txtUserName.Tag
    
    Screen.MousePointer = vbDefault
    ModifyUser = True
    
Exit Function
Err_Handle:
    Screen.MousePointer = vbDefault
    ModifyUser = False
    gShowMsg "修改一个用户时出错，frmAddNewUser.ModifyUser()"

End Function

Private Sub cmdCancel_Click()
    Unload Me
End Sub

Private Sub cmdOK_Click()
    If mbAddNew Then
        If AddNewUser = True Then
            Call SendMessageToCtl(frmUser.lstUsers, WM_KEYDOWN, vbKeyF5, 0)
            Unload Me
        End If
    Else
        If ModifyUser = True Then
            Call SendMessageToCtl(frmUser.lstUsers, WM_KEYDOWN, vbKeyF5, 0)
            Unload Me
        End If
    End If
End Sub

Private Sub Form_KeyPress(KeyAscii As Integer)
If KeyAscii = vbKeyReturn Then
        KeyAscii = 0
        SendKeys "{tab}"
    ElseIf KeyAscii = vbKeyEscape Then
        KeyAscii = 0
        Unload Me
    End If
End Sub

Private Sub Form_Load()
    Center Me
    
    If mbAddNew Then
        txtUserName.Text = ""
        txtUserName.Tag = ""
        txtOldPass.Text = ""
        txtNewPass.Text = ""
    Else
        Call ShowOldUser(mUserID)
    End If
    
End Sub