www.pudn.com > VBproject VCD.rar > MemberRE.frm, change:2003-06-06,size:19710b


VERSION 5.00 
Object = "{8ED8CCC1-8472-46D0-93E7-F66929B98442}#2.0#0"; "XPCMD.OCX" 
Begin VB.Form MemberRE  
   Caption         =   "会员注册" 
   ClientHeight    =   7815 
   ClientLeft      =   4860 
   ClientTop       =   1575 
   ClientWidth     =   6915 
   LinkTopic       =   "Form1" 
   ScaleHeight     =   7815 
   ScaleWidth      =   6915 
   Begin VB.TextBox TCardnum  
      BeginProperty Font  
         Name            =   "宋体" 
         Size            =   12 
         Charset         =   134 
         Weight          =   400 
         Underline       =   0   'False 
         Italic          =   0   'False 
         Strikethrough   =   0   'False 
      EndProperty 
      Height          =   375 
      Left            =   2040 
      TabIndex        =   6 
      Top             =   4440 
      Width           =   2295 
   End 
   Begin XPCmd.xpcmdbutton CancelBT  
      Height          =   495 
      Left            =   5040 
      TabIndex        =   12 
      Top             =   6840 
      Width           =   1095 
      _ExtentX        =   1931 
      _ExtentY        =   873 
      Caption         =   "   取  消" 
      BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}  
         Name            =   "宋体" 
         Size            =   9 
         Charset         =   134 
         Weight          =   400 
         Underline       =   0   'False 
         Italic          =   0   'False 
         Strikethrough   =   0   'False 
      EndProperty 
   End 
   Begin XPCmd.xpcmdbutton ClearBT  
      Height          =   495 
      Left            =   2880 
      TabIndex        =   11 
      Top             =   6840 
      Width           =   1095 
      _ExtentX        =   1931 
      _ExtentY        =   873 
      Caption         =   "   清  空" 
      BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}  
         Name            =   "宋体" 
         Size            =   9 
         Charset         =   134 
         Weight          =   400 
         Underline       =   0   'False 
         Italic          =   0   'False 
         Strikethrough   =   0   'False 
      EndProperty 
   End 
   Begin XPCmd.xpcmdbutton OkBT  
      Height          =   495 
      Left            =   720 
      TabIndex        =   10 
      Top             =   6840 
      Width           =   1095 
      _ExtentX        =   1931 
      _ExtentY        =   873 
      Caption         =   "   确  定" 
      BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}  
         Name            =   "宋体" 
         Size            =   9 
         Charset         =   134 
         Weight          =   400 
         Underline       =   0   'False 
         Italic          =   0   'False 
         Strikethrough   =   0   'False 
      EndProperty 
   End 
   Begin VB.TextBox TPostcode  
      BeginProperty Font  
         Name            =   "宋体" 
         Size            =   12 
         Charset         =   134 
         Weight          =   400 
         Underline       =   0   'False 
         Italic          =   0   'False 
         Strikethrough   =   0   'False 
      EndProperty 
      Height          =   375 
      Left            =   2040 
      TabIndex        =   8 
      Top             =   5640 
      Width           =   1095 
   End 
   Begin VB.TextBox TAddress  
      BeginProperty Font  
         Name            =   "宋体" 
         Size            =   12 
         Charset         =   134 
         Weight          =   400 
         Underline       =   0   'False 
         Italic          =   0   'False 
         Strikethrough   =   0   'False 
      EndProperty 
      Height          =   375 
      Left            =   2040 
      TabIndex        =   7 
      Top             =   5040 
      Width           =   3855 
   End 
   Begin VB.TextBox TPhone  
      BeginProperty Font  
         Name            =   "宋体" 
         Size            =   12 
         Charset         =   134 
         Weight          =   400 
         Underline       =   0   'False 
         Italic          =   0   'False 
         Strikethrough   =   0   'False 
      EndProperty 
      Height          =   375 
      Left            =   2040 
      TabIndex        =   5 
      Top             =   3840 
      Width           =   1935 
   End 
   Begin VB.TextBox TEmail  
      BeginProperty Font  
         Name            =   "宋体" 
         Size            =   12 
         Charset         =   134 
         Weight          =   400 
         Underline       =   0   'False 
         Italic          =   0   'False 
         Strikethrough   =   0   'False 
      EndProperty 
      Height          =   375 
      Left            =   2040 
      TabIndex        =   4 
      Top             =   3240 
      Width           =   1935 
   End 
   Begin VB.ComboBox ComboSex  
      Height          =   300 
      ItemData        =   "MemberRE.frx":0000 
      Left            =   2040 
      List            =   "MemberRE.frx":000A 
      TabIndex        =   3 
      Top             =   2760 
      Width           =   1335 
   End 
   Begin VB.TextBox TAge  
      BeginProperty Font  
         Name            =   "宋体" 
         Size            =   12 
         Charset         =   134 
         Weight          =   400 
         Underline       =   0   'False 
         Italic          =   0   'False 
         Strikethrough   =   0   'False 
      EndProperty 
      Height          =   375 
      Left            =   2040 
      TabIndex        =   2 
      Top             =   2160 
      Width           =   1335 
   End 
   Begin VB.TextBox Tname  
      BeginProperty Font  
         Name            =   "宋体" 
         Size            =   12 
         Charset         =   134 
         Weight          =   400 
         Underline       =   0   'False 
         Italic          =   0   'False 
         Strikethrough   =   0   'False 
      EndProperty 
      Height          =   375 
      Left            =   2040 
      TabIndex        =   1 
      Top             =   1560 
      Width           =   1335 
   End 
   Begin VB.TextBox TID  
      BeginProperty Font  
         Name            =   "宋体" 
         Size            =   12 
         Charset         =   134 
         Weight          =   400 
         Underline       =   0   'False 
         Italic          =   0   'False 
         Strikethrough   =   0   'False 
      EndProperty 
      Height          =   375 
      Left            =   2040 
      Locked          =   -1  'True 
      TabIndex        =   0 
      TabStop         =   0   'False 
      Top             =   960 
      Width           =   1335 
   End 
   Begin VB.Frame Frame1  
      Height          =   5655 
      Left            =   480 
      TabIndex        =   14 
      Top             =   600 
      Width           =   5895 
      Begin VB.TextBox TMoney  
         BeginProperty Font  
            Name            =   "宋体" 
            Size            =   12 
            Charset         =   134 
            Weight          =   400 
            Underline       =   0   'False 
            Italic          =   0   'False 
            Strikethrough   =   0   'False 
         EndProperty 
         Height          =   375 
         Left            =   4440 
         TabIndex        =   9 
         Top             =   5040 
         Width           =   975 
      End 
      Begin VB.Label Label11  
         AutoSize        =   -1  'True 
         Caption         =   "账户资金" 
         BeginProperty Font  
            Name            =   "宋体" 
            Size            =   12 
            Charset         =   134 
            Weight          =   400 
            Underline       =   0   'False 
            Italic          =   0   'False 
            Strikethrough   =   0   'False 
         EndProperty 
         ForeColor       =   &H00FF0000& 
         Height          =   240 
         Left            =   3240 
         TabIndex        =   25 
         Top             =   5100 
         Width           =   960 
      End 
      Begin VB.Label Label1  
         AutoSize        =   -1  'True 
         Caption         =   "会员编号" 
         BeginProperty Font  
            Name            =   "宋体" 
            Size            =   12 
            Charset         =   134 
            Weight          =   400 
            Underline       =   0   'False 
            Italic          =   0   'False 
            Strikethrough   =   0   'False 
         EndProperty 
         ForeColor       =   &H00FF0000& 
         Height          =   240 
         Left            =   360 
         TabIndex        =   23 
         Top             =   400 
         Width           =   960 
      End 
      Begin VB.Label Label2  
         AutoSize        =   -1  'True 
         Caption         =   "姓名" 
         BeginProperty Font  
            Name            =   "宋体" 
            Size            =   12 
            Charset         =   134 
            Weight          =   400 
            Underline       =   0   'False 
            Italic          =   0   'False 
            Strikethrough   =   0   'False 
         EndProperty 
         ForeColor       =   &H00FF0000& 
         Height          =   240 
         Left            =   600 
         TabIndex        =   22 
         Top             =   1000 
         Width           =   480 
      End 
      Begin VB.Label Label3  
         AutoSize        =   -1  'True 
         Caption         =   "年龄" 
         BeginProperty Font  
            Name            =   "宋体" 
            Size            =   12 
            Charset         =   134 
            Weight          =   400 
            Underline       =   0   'False 
            Italic          =   0   'False 
            Strikethrough   =   0   'False 
         EndProperty 
         ForeColor       =   &H00FF0000& 
         Height          =   240 
         Left            =   600 
         TabIndex        =   21 
         Top             =   1600 
         Width           =   480 
      End 
      Begin VB.Label Label4  
         AutoSize        =   -1  'True 
         Caption         =   "性别" 
         BeginProperty Font  
            Name            =   "宋体" 
            Size            =   12 
            Charset         =   134 
            Weight          =   400 
            Underline       =   0   'False 
            Italic          =   0   'False 
            Strikethrough   =   0   'False 
         EndProperty 
         ForeColor       =   &H00FF0000& 
         Height          =   240 
         Left            =   600 
         TabIndex        =   20 
         Top             =   2180 
         Width           =   480 
      End 
      Begin VB.Label Label5  
         AutoSize        =   -1  'True 
         Caption         =   "电子邮件" 
         BeginProperty Font  
            Name            =   "宋体" 
            Size            =   12 
            Charset         =   134 
            Weight          =   400 
            Underline       =   0   'False 
            Italic          =   0   'False 
            Strikethrough   =   0   'False 
         EndProperty 
         ForeColor       =   &H00FF0000& 
         Height          =   240 
         Left            =   360 
         TabIndex        =   19 
         Top             =   2700 
         Width           =   960 
      End 
      Begin VB.Label Label6  
         AutoSize        =   -1  'True 
         Caption         =   "电话" 
         BeginProperty Font  
            Name            =   "宋体" 
            Size            =   12 
            Charset         =   134 
            Weight          =   400 
            Underline       =   0   'False 
            Italic          =   0   'False 
            Strikethrough   =   0   'False 
         EndProperty 
         ForeColor       =   &H00FF0000& 
         Height          =   240 
         Left            =   600 
         TabIndex        =   18 
         Top             =   3300 
         Width           =   480 
      End 
      Begin VB.Label Label7  
         AutoSize        =   -1  'True 
         Caption         =   "联系地址" 
         BeginProperty Font  
            Name            =   "宋体" 
            Size            =   12 
            Charset         =   134 
            Weight          =   400 
            Underline       =   0   'False 
            Italic          =   0   'False 
            Strikethrough   =   0   'False 
         EndProperty 
         ForeColor       =   &H00FF0000& 
         Height          =   240 
         Left            =   360 
         TabIndex        =   17 
         Top             =   4500 
         Width           =   960 
      End 
      Begin VB.Label Label8  
         AutoSize        =   -1  'True 
         Caption         =   "邮编" 
         BeginProperty Font  
            Name            =   "宋体" 
            Size            =   12 
            Charset         =   134 
            Weight          =   400 
            Underline       =   0   'False 
            Italic          =   0   'False 
            Strikethrough   =   0   'False 
         EndProperty 
         ForeColor       =   &H00FF0000& 
         Height          =   240 
         Left            =   600 
         TabIndex        =   16 
         Top             =   5100 
         Width           =   480 
      End 
      Begin VB.Label Label10  
         AutoSize        =   -1  'True 
         Caption         =   "身份证号码" 
         BeginProperty Font  
            Name            =   "宋体" 
            Size            =   12 
            Charset         =   134 
            Weight          =   400 
            Underline       =   0   'False 
            Italic          =   0   'False 
            Strikethrough   =   0   'False 
         EndProperty 
         ForeColor       =   &H00FF0000& 
         Height          =   240 
         Left            =   240 
         TabIndex        =   15 
         Top             =   3900 
         Width           =   1200 
      End 
   End 
   Begin VB.Frame Frame2  
      Height          =   1095 
      Left            =   480 
      TabIndex        =   24 
      Top             =   6480 
      Width           =   5895 
   End 
   Begin VB.Label Label9  
      AutoSize        =   -1  'True 
      Caption         =   "会员信息注册" 
      BeginProperty Font  
         Name            =   "宋体" 
         Size            =   15 
         Charset         =   134 
         Weight          =   400 
         Underline       =   0   'False 
         Italic          =   0   'False 
         Strikethrough   =   0   'False 
      EndProperty 
      ForeColor       =   &H00FF00FF& 
      Height          =   300 
      Left            =   2400 
      TabIndex        =   13 
      Top             =   240 
      Width           =   1800 
   End 
End 
Attribute VB_Name = "MemberRE" 
Attribute VB_GlobalNameSpace = False 
Attribute VB_Creatable = False 
Attribute VB_PredeclaredId = True 
Attribute VB_Exposed = False 
Dim com As Command 
Dim rst As Recordset 
 
Private Sub CancelBT_Click() 
Unload Me 
End Sub 
 
Private Sub ClearBT_Click() 
For Each Control In MemberRE 
    If TypeOf Control Is TextBox Then 
      If Control <> TID Then 
        Control.Text = "" 
      End If 
    End If 
Next 
End Sub 
 
Private Sub Form_Load() 
Set com = New Command 
Set rst = New Recordset 
addid 
'MemberRE.Tname.SetFocus 
End Sub 
 
Private Sub OkBt_Click() 
For Each Control In MemberRE 
    If TypeOf Control Is TextBox Then 
     If Control <> TID Then 
        If Trim(Control.Text) = "" Then 
            MsgBox "请输入完整信息" 
            Exit Sub 
        End If 
      End If 
    End If 
Next 
 
If Len(Tname.Text) > 15 Then 
    MsgBox "姓名过长!请检查!" 
    Tname.SetFocus 
    Exit Sub 
End If 
If Asc(Trim(TAge.Text)) > 57 Or Asc(Trim(TAge.Text)) < 48 Then 
   MsgBox "您的年龄有问题!请输入数字!" 
   TAge.SetFocus 
    ElseIf Len(Trim(TAge.Text)) > 3 Then 
           MsgBox "您的年龄有那么大嘛!请检查!" 
           TAge.SetFocus 
   ElseIf Trim(TAge.Text) = 0 Then 
           MsgBox "0岁的您也能看电影嘛!" 
           TAge.SetFocus 
    Exit Sub 
End If 
If ComboSex.Text = "" Then 
   MsgBox "请选择您的性别!" 
   ComboSex.SetFocus 
End If 
If Len(Trim(TEmail.Text)) > 30 Then 
    MsgBox "电子邮件过长!请检查!" 
    TEmail.SetFocus 
    Exit Sub 
End If 
 
If MemberRE.checkemail(TEmail.Text) = 0 Then 
    MsgBox "电子邮件输入有误!请检查!" 
    TEmail.SetFocus 
    Exit Sub 
End If 
 
If Asc(Trim(TPhone.Text)) > 57 Or Asc(Trim(TPhone.Text)) < 48 Then 
    MsgBox "电话号码有误!请输入数字!" 
    TPhone.SetFocus 
    ElseIf Len(Trim(TPhone.Text)) > 13 Or Len(Trim(TPhone.Text)) < 8 Then 
            MsgBox "电话号码有误!请检查!" 
            TPhone.SetFocus 
    Exit Sub 
End If 
If Asc(Trim(TCardnum.Text)) > 57 Or Asc(Trim(TCardnum.Text)) < 48 Then 
    MsgBox "身份证号码有误!请输入数字!" 
    TCardnum.SetFocus 
    ElseIf Len(Trim(TCardnum.Text)) > 18 Or Len(Trim(TCardnum.Text)) < 15 Then 
            MsgBox "身份证号码有误!请检查!" 
            TCardnum.SetFocus 
    Exit Sub 
End If 
If Asc(Trim(TPostcode.Text)) > 57 Or Asc(Trim(TPostcode.Text)) < 48 Then 
          MsgBox "邮政编码有误!请输入数字!" 
          TPostcode.SetFocus 
    ElseIf Len(Trim(TPostcode.Text)) > 6 Then 
           MsgBox "邮编过长!请检查!" 
           TPostcode.SetFocus 
    Exit Sub 
End If 
Dim id, name, money, age, sex, email, address, postcode, phone, cardnum As String 
 
id = TID.Text 
name = Tname.Text 
age = TAge.Text 
sex = ComboSex.Text 
email = TEmail.Text 
address = TAddress.Text 
postcode = TPostcode.Text 
phone = TPhone.Text 
cardnum = TCardnum.Text 
money = TMoney.Text 
'On Error GoTo err 
'com.ActiveConnection = con 
rst.Open "insert Member values('" & id & "','" & name & "'," & money & ",'" & age & "','" & sex & "','" & email & "','" & _ 
address & "','" & postcode & "','" & phone & "','" & cardnum & "')", con, adOpenDynamic, adLockOptimistic 
MsgBox "您的信息注册成功!:)欢迎光临!" 
Unload Me 
Exit Sub 
err: 
MsgBox "请确认数据库是否连接!" 
End Sub 
 
Public Function checkemail(email As String) 
Dim a, b, n As Integer 
n = Len(email) 
a = 0 
b = 0 
For ctr = 1 To n 
    If Mid(email, ctr, 1) < "#" And Mid(email, ctr, 1) > "~" And Mid(email, ctr, 1) = "?" Then 
        checkemail = 0 
        Exit Function 
    End If 
    If Mid(email, ctr, 1) = "@" Then 
        a = a + 1 
    End If 
    If Mid(email, ctr, 1) = "." Then 
        b = 1 
    End If 
Next ctr 
    
    If a = 1 And b = 1 Then 
        checkemail = 1 
        Exit Function 
    End If 
    checkemail = 0 
 
End Function 
 
Public Sub addid() 
Dim id As String 
'Dim rst As Recordset 
'Set rst = New Recordset 
'On Error GoTo err 
com.ActiveConnection = con 
rst.Open "select cMemberId from Member", con, adOpenDynamic, adLockOptimistic 
If rst.EOF = True Then 
    id = "00001" 
Else 
    id = getid(Trim(rst!cMemberID)) 
    rst.MoveNext 
    Do While rst.EOF = False 
        If id = Trim(rst!cMemberID) Then 
            id = getid(Trim(rst!cMemberID)) 
            rst.MoveNext 
        Else 
            Exit Do 
        End If 
    Loop 
End If 
TID.Text = id 
'rst.MoveFirst 
rst.Close 
Exit Sub 
err: 
MsgBox "数据库还未连接!" 
Unload Me 
End Sub 
Private Function getid(temp As String) 
temp = temp + 1 
If temp < 10 Then 
    getid = "0000" & temp 
    Exit Function 
End If 
If temp < 100 Then 
    getid = "000" & temp 
    Exit Function 
End If 
If temp < 1000 Then 
    getid = "00" & temp 
    Exit Function 
End If 
If temp < 10000 Then 
    getid = "0" & temp 
    Exit Function 
Else 
    getid = temp 
End If 
End Function