frmadduser.frm

旅行社管理信息系统主要实现旅游路线、景点、交通工具等的查询、修改和删除功能

VERSION 5.00
Begin VB.Form Frmadduser 
   BorderStyle     =   1  'Fixed Single
   Caption         =   "添加用户"
   ClientHeight    =   2430
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   2910
   Icon            =   "Frmadduser.frx":0000
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   2430
   ScaleWidth      =   2910
   StartUpPosition =   2  '屏幕中心
   Begin VB.TextBox Txtuser 
      Height          =   315
      Left            =   1080
      TabIndex        =   0
      Top             =   195
      Width           =   1665
   End
   Begin VB.TextBox Txtpass 
      Height          =   315
      IMEMode         =   3  'DISABLE
      Left            =   1080
      PasswordChar    =   "*"
      TabIndex        =   1
      Top             =   712
      Width           =   1665
   End
   Begin VB.CommandButton Cmdexit 
      Caption         =   "取消"
      Height          =   330
      Left            =   1590
      TabIndex        =   6
      Top             =   1890
      Width           =   855
   End
   Begin VB.CommandButton Cmdok 
      Caption         =   "确定"
      Height          =   330
      Left            =   360
      TabIndex        =   5
      Top             =   1890
      Width           =   855
   End
   Begin VB.TextBox Txtpass2 
      Height          =   315
      IMEMode         =   3  'DISABLE
      Left            =   1080
      PasswordChar    =   "*"
      TabIndex        =   2
      Top             =   1230
      Width           =   1665
   End
   Begin VB.Label Label1 
      Caption         =   "用 户 名："
      Height          =   165
      Left            =   165
      TabIndex        =   7
      Top             =   270
      Width           =   915
   End
   Begin VB.Label Label3 
      Caption         =   "确认密码："
      Height          =   165
      Left            =   165
      TabIndex        =   4
      Top             =   1305
      Width           =   915
   End
   Begin VB.Label Label2 
      Caption         =   "密    码："
      Height          =   165
      Left            =   165
      TabIndex        =   3
      Top             =   787
      Width           =   915
   End
End
Attribute VB_Name = "Frmadduser"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private strSQL As String
Public cnntemp As New ADODB.Connection
Public rstTemp As New ADODB.Recordset
Public rstlr As New ADODB.Recordset
Public bsfbcsj As Boolean

Private Sub CmdExit_Click()
    Unload Me
End Sub

Private Sub CmdOK_Click()
    Dim Ans%
    Dim pass1 As String
    Dim pass2 As String
    Dim passcomp As String

    If Trim(Txtuser.Text) = "" Then
        MsgBox "请填写用户名", vbInformation, "录入提示"
        Txtuser.Text = ""
        Txtuser.SetFocus
        Exit Sub
    End If
    
    If Trim(Txtpass.Text) = "" Then
        MsgBox "请填写密码！", vbInformation, "录入提示"
        Txtpass.SetFocus
        Exit Sub
    End If
    
    If Trim(Txtpass2.Text) = "" Then
        MsgBox "请填写确认密码！", vbInformation, "录入提示"
        Txtpass2.SetFocus
        Exit Sub
    End If
    
    If Trim(Txtpass.Text) <> "" And Trim(Txtpass2.Text) <> "" Then
        pass1 = Txtpass.Text
        pass2 = Txtpass2.Text
        passcomp = StrComp(pass1, pass2, vbTextCompare)
        If passcomp <> 0 Then
            MsgBox "两次输入的密码不同，请重新输入！", vbInformation, "录入提示"
            Txtpass.Text = ""
            Txtpass2.Text = ""
            Txtpass.SetFocus
            Exit Sub
        End If
    End If
    'On Error GoTo Rollback
    If bsfbcsj Then
        Ans = MsgBox("保存以上信息吗？", vbYesNo + vbQuestion, "提示")
        If Ans = vbYes Then
            strSQL = "select * from DB_User where username='" & Txtuser.Text & "'"
            Call DirectRecordset(strSQL, rstlr)
            If rstlr.RecordCount <> 0 Then
                MsgBox "已有此用户名，请不要重复录入", vbInformation, "录入提示"
                Txtuser.Text = ""
                Txtpass.Text = ""
                Txtpass2.Text = ""
                Txtuser.SetFocus
                Exit Sub
            Else
                cnntemp.BeginTrans
                
                    strSQL = "insert into DB_User (username,password1)"
                    strSQL = strSQL & " values ('" & _
                    Txtuser.Text & "','" & Txtpass.Text & "'"
                    strSQL = strSQL & ");"
                    cnntemp.Execute (strSQL)
   
                cnntemp.CommitTrans
                
                MsgBox "已成功添加用户！", vbInformation, "录入提示"
                bsfbcsj = False
                Unload Me
                
            End If
        Else
            If Ans = vbNo Then
                Txtuser.Text = ""
                Txtpass.Text = ""
                Txtpass2.Text = ""
                Txtuser.SetFocus
                bsfbcsj = False
            End If
        End If
    End If
    Exit Sub
Rollback:
    cnntemp.RollbackTrans
    If Err.Number <> 0 Then
        MsgBox Err.Description, vbExclamation, Me.Caption
        Exit Sub
    End If
    
On Error GoTo 0
End Sub

Private Sub Form_Load()
    Me.Show
    SetWindowPos Me.hwnd, HWND_TOPMOST, Me.Left / Screen.TwipsPerPixelX _
    , Me.Top \ Screen.TwipsPerPixelY, Me.Width \ Screen.TwipsPerPixelX, _
    Me.Height \ Screen.TwipsPerPixelY, 0
    
    On Error GoTo Err
    
    Set cnntemp = Nothing
    
    With cnntemp
        .Provider = "Microsoft.jet.OLEDB.4.0"
        .Open App.Path & "\travel.mdb", "admin"
    End With
    
'    Dim strConnect As String
'    strConnect = ServerIp
'
'    Set cnntemp = Nothing
'    With cnntemp
'        .Open strConnect
'    End With

    bsfbcsj = False
    
    Exit Sub
Err:
    If Err.Number <> 0 Then
            MsgBox Err.Description, vbExclamation, Me.Caption
    End If
        
    On Error GoTo 0
End Sub

Private Sub Txtpass_KeyPress(KeyAscii As Integer)
    If KeyAscii = 13 Then
        If Txtpass.Text = "" Then
            Txtpass.SetFocus
            Exit Sub
        Else
           SendKeys "{tab}"
        End If
    End If
End Sub

Private Sub Txtuser_KeyPress(KeyAscii As Integer)
    If KeyAscii = 13 Then
        If Txtuser.Text = "" Then
            Txtuser.SetFocus
            Exit Sub
        Else
           SendKeys "{tab}"
        End If
    End If
End Sub

Private Sub Txtpass2_KeyPress(KeyAscii As Integer)
    If KeyAscii = 13 Then
        If Txtpass2.Text = "" Then
            Txtpass2.SetFocus
            Exit Sub
        Else
           SendKeys "{tab}"
        End If
    End If
End Sub

Private Sub Txtuser_Change()
    CmdOk.Enabled = True
    bsfbcsj = True
End Sub

Private Sub Txtuser_Validate(Cancel As Boolean)
    strSQL = "select * from DB_User where username='" & Txtuser.Text & "'"
    Call DirectRecordset(strSQL, rstTemp)
    If rstTemp.RecordCount <> 0 Then
         MsgBox "已有此用户名，请不要重复录入", vbInformation, "录入提示"
         Txtuser.Text = ""
         Txtpass.Text = ""
         Txtpass2.Text = ""
         Txtuser.SetFocus
         Cancel = True
         Exit Sub
    End If
End Sub