' Author: loster (oicq:181306) [if reproduced please do not delete this information, thank you!] ]
' Function name: Chk_email ()
' Return value: Boolean (True to pass, false to failed)
' Parameters: Email (email to be judged, type: string) type_1 (whether to judge domain after @, type: Boolean)
' Type_2 (can only be a specific domain of e-mail registration, type: Boolean) type_3 (an e-mail can only register once, type: Boolean)
Const c_maildomain= ". Com,.com.cn,.net,.net.cn,.org,.org.cn,.gov,.gov.cn,.edu,.edu.cn,.cn,.cc,.biz,.info" ' e-mail acceptable in domain
Const c_lockdomain= "bit.edu.cn,loster.org" ' specific domain
Function Chk_email (Email,type_1,type_2,type_3)
Dim i,k
Dim at
Dim email_1,temp
If email= "" Then
Chk_email=false
Exit Function
End If
Email_1=cstr (Trim (email))
If Len (email_1) <5 Then
Chk_email=false
Exit Function
End If
At=false
For I=1 to Len (Email_1)
Temp=mid (email_1,i,1)
If temp= "@" Then
At=true
Exit for
End If
Next
If At=false Then
Chk_email=false
Exit Function
End If
K=0
For I=1 to Len (Email_1)
Temp=mid (email_1,i,1)
If temp= "." Then
K=k+1
End If
Next
If k=0 Or k>2 Then
Chk_email=false
Exit Function
End If
If type_1=true Then
For I=1 to Len (Email_1)
Temp=mid (email_1,i,1)
If temp= "@" Then
K=i
Exit for
End If
Next
For I=k to Len (Email_1)
Temp=mid (email_1,i,1)
If temp= "." Then
K=i
Exit for
End If
Next
Temp= ""
For I=k to Len (Email_1)
Temp=temp+mid (email_1,i,1)
Next
Temp=cstr (Trim (Temp))
At=false
For i=0 to R_reader (C_maildomain, ",")
If Temp=reader (i) Then
At=true
Exit for
End If
Next
Erase Reader
If At=false Then
Chk_email=false
Exit Function
End If
End If
If type_2=true Then
For I=1 to Len (Email_1)
Temp=mid (email_1,i,1)
If temp= "@" Then
K=i
Exit for
End If
Next
Temp= ""
For I=k+1 to Len (Email_1)
Temp=temp+mid (email_1,i,1)
Next
Temp=cstr (Trim (Temp))
At=false
For i=0 to R_reader (C_lockdomain, ",")
If Temp=reader (i) Then
At=true
Exit for
End If
Next
Erase Reader
If At=false Then
Chk_email=false
Exit Function
End If
End If
If type_3=true Then
Dim J
Call Greate_userdb ()
Call Create_rs ("Select * from User_basic_info where user_email= '" &Email_1& "", 1,1, "User")
If Rs.bof=false Then
Chk_email=false
Call Close_rs ()
Call Close_userdb ()
Exit Function
End If
Call Close_rs ()
Call Close_userdb ()
End If
Chk_email=true
End Function
Dim User_db,user_driver
Dim User_conn
user_db= "Data/userdata.mdb"
' The process of establishing user_conn
Sub Greate_userdb ()
User_driver= "Driver={microsoft Access Driver (*.mdb)}"
user_driver=user_driver& ";d bq=" &server.mappath (user_db)
' Response.Write (User_driver)
Set user_conn = Server.CreateObject ("ADODB. Connection ")
User_conn.open (User_driver)
End Sub
' Closing the User_conn process
Sub Close_userdb ()
User_conn.close
Set user_conn=nothing
End Sub
Dim Reader
Dim Rs
' Read constants and save each constant in the reader array, parameters: R_str (constant string), F_str (delimiter), return value: Index of reader array
Function R_reader (R_STR,F_STR)
Dim I
If r_str= "" Or f_str= "" Then
Exit Function
End If
Reader=split (R_STR,F_STR)
For i=0 to Ubound (reader,1)
Reader (i) =cstr (Trim (Reader (i))
Next
R_reader=ubound (reader,1)
End Function