frmregister.frm

多方讨价还价系统

VERSION 5.00
Begin VB.Form frmregister 
   BorderStyle     =   3  'Fixed Dialog
   Caption         =   "新用户注册"
   ClientHeight    =   2715
   ClientLeft      =   7245
   ClientTop       =   5430
   ClientWidth     =   5280
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   2715
   ScaleWidth      =   5280
   ShowInTaskbar   =   0   'False
   Begin VB.TextBox txtPassword2 
      Height          =   270
      IMEMode         =   3  'DISABLE
      Left            =   1560
      PasswordChar    =   "*"
      TabIndex        =   9
      Top             =   1200
      Width           =   2295
   End
   Begin VB.CommandButton cmdClear 
      Caption         =   "清空"
      Height          =   375
      Left            =   3360
      TabIndex        =   8
      Top             =   2160
      Width           =   1095
   End
   Begin VB.CommandButton cmdCancel 
      Caption         =   "取消"
      Height          =   375
      Left            =   1920
      TabIndex        =   7
      Top             =   2160
      Width           =   1095
   End
   Begin VB.CommandButton cmdOK 
      Caption         =   "确定"
      Height          =   375
      Left            =   480
      TabIndex        =   6
      Top             =   2160
      Width           =   1095
   End
   Begin VB.ComboBox combUsertype 
      Height          =   300
      ItemData        =   "frmregister.frx":0000
      Left            =   1560
      List            =   "frmregister.frx":000A
      TabIndex        =   4
      Top             =   1680
      Width           =   1815
   End
   Begin VB.TextBox txtPassword 
      Height          =   270
      IMEMode         =   3  'DISABLE
      Left            =   1560
      PasswordChar    =   "*"
      TabIndex        =   1
      Top             =   720
      Width           =   2295
   End
   Begin VB.TextBox txtUsername 
      Height          =   270
      Left            =   1560
      TabIndex        =   0
      Top             =   240
      Width           =   2295
   End
   Begin VB.Label Label4 
      Caption         =   "请再次输入密码"
      Height          =   255
      Left            =   120
      TabIndex        =   10
      Top             =   1200
      Width           =   1335
   End
   Begin VB.Label Label3 
      Caption         =   "请选择用户类型"
      Height          =   375
      Left            =   120
      TabIndex        =   5
      Top             =   1680
      Width           =   1335
   End
   Begin VB.Label Label2 
      Caption         =   "请输入密码"
      Height          =   255
      Left            =   120
      TabIndex        =   3
      Top             =   720
      Width           =   1335
   End
   Begin VB.Label Label1 
      Caption         =   "请输入用户名"
      Height          =   255
      Left            =   120
      TabIndex        =   2
      Top             =   240
      Width           =   1215
   End
End
Attribute VB_Name = "frmregister"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim UserType As LogonTypes

Private Sub cmdCancel_Click()
    Unload Me
End Sub

Private Sub cmdClear_Click()
    txtUsername = ""
    txtPassword = ""
    txtPassword2 = ""
End Sub

Private Sub cmdOK_Click()
    Dim flag As Boolean
    If txtUsername <> "" And txtPassword <> "" And combUsertype.Text <> "" Then
        Select Case combUsertype.Text
            Case "买家"
                UserType = JQL_BUYER
            Case "卖家"
                UserType = JQL_SALER
        End Select
        flag = ExistUser(txtUsername, UserType)
        If flag Then
             MsgBox "此用户名已存在，请重新输入！", vbInformation, "新用户注册"
        Else
            If txtPassword = txtPassword2 Then
                UserRegistor txtUsername, txtPassword, UserType
                MsgBox "注册成功！", vbOKOnly Or vbInformation, "新用户注册"
                frmLogon.txtUsername = txtUsername
                Unload Me
            Else
                MsgBox "两次输入的密码不一致，请重新输入！", vbInformation, "新用户注册"
            End If
        End If
    Else
        MsgBox "请输入注册信息！", vbOKOnly Or vbCritical, "新用户注册"
    End If
End Sub

Function ExistUser(uName As String, uType As LogonTypes) As Boolean
    Dim RS
    Set RS = CreateObject("ADODB.RecordSet")
    StrSQL = "select * from " & dbTableNames(uType) & " where username = '" & uName & "'"
    RS.Open StrSQL, ConnStr, 1, 1
    ExistUser = Not RS.EOF
    RS.Close
    Set RS = Nothing
End Function

Function UserRegistor(uName As String, uPass As String, uType As LogonTypes) As Boolean
    Dim RS
    Set RS = CreateObject("ADODB.RecordSet")
    StrSQL = "select * from " & dbTableNames(uType)
    RS.Open StrSQL, ConnStr, 1, 3
    RS.AddNew
    RS("username") = uName
    RS("password") = uPass
    RS.Update
    RS.Close
    
    StrSQL = "select * from " & dbTableNames(uType + 3)
    RS.Open StrSQL, ConnStr, 1, 3
    RS.AddNew
    RS("username") = uName
    RS("production") = ""
    RS("buyname") = ""
    RS.Update
    RS.Close
    Set RS = Nothing
    UserRegistor = True
End Function

Private Sub Form_KeyPress(KeyAscii As Integer)
    If KeyAscii = 13 Then
        cmdOK.Value = True
    End If
End Sub