procedure.asp

网站的后台管理代码......内容比较全面....新手比较适合

<%
'=========================================================
' 『动感在线』版权所有(C) Donggan.Net
' 您可以自由应用本程序于合法的个人或商业行为。
' 您必须保留版权信息。
'=========================================================
' Version:1.3
' Date: 2003-01-10
' Script Written by xubin
'=========================================================
' Copyright (C) 1999-2002 Donggan.Net. All rights reserved.
' Web: http://www.Donggan.net
' Email: [e-mail],[e-mail]
'=========================================================
%>
<%
Dim webname,weburl,filepath,Language,errortext
'显示网站基本信息 all page
Sub showwebdata()
	Set rs=Server.Createobject("adodb.recordset") 
	sql="select WebName,WebURL,FilePath,Language from Management" 
	rs.open sql,conn,1,1   
		WebName=rs("WebName")
		FilePath=rs("FilePath")
		WebURL=rs("WebURL")
		Language=rs("Language")
	rs.close
End Sub

'登陆超时或非法访问跳转页面
Sub loaderror()
	If Request.Cookies("Donggan")("mailadmin")<>"adminmaster" Then 
		Response.Redirect "error.asp"
		Response.End
	End If
End Sub

'检查EMAIL格式是否正确
Function IsValidEmail(email)
Dim names, name, i, c
IsValidEmail = TRUE
names = Split(email, "@")
If UBound(names) <> 1 Then
   IsValidEmail = FALSE
   Exit Function
End If
For Each name in names
   If Len(name) <= 0 Then
     IsValidEmail = FALSE
     Exit Function
   End If
   For i = 1 To Len(name)
     c = LCase(Mid(name, i, 1))
     'If InStr("`!@#$%^&*()+=|\?';:<>,。，~！·￥……—（）——、；：“’《》？", c) <> 0 AND NOT IsNumeric(c) Then	'支持中文格式地址
     If InStr("abcdefghijklmnopqrstuvwxyz_-.", c) <= 0 AND NOT IsNumeric(c) Then	'不支持中文格式地址
       IsValidEmail = FALSE
       Exit Function
     End If
   Next
   If Left(name, 1) = "." or Right(name, 1) = "." Then
      IsValidEmail = FALSE
      Exit Function
   End If
Next
If InStr(names(1), ".") <= 0 Then
   IsValidEmail = FALSE
   Exit Function
End If
i = Len(names(1)) - InStrRev(names(1), ".")
If i <> 2 AND i <> 3 Then
   IsValidEmail = FALSE
   Exit Function
End If
If InStr(email, "..") > 0 Then
   IsValidEmail = FALSE
End If
End Function

'生成随即字符串
Function makerndid(byVal maxLen)
	Dim strNewPass
	Dim whatsNext, upper, lower, intCounter
	RANdomize
	For intCounter = 1 To maxLen
	whatsNext = int(2 * Rnd)
	If whatsNext = 0 Then
		upper = 80 
		lower = 70
	Else
		upper = 48 
		lower = 39
	End If
	strNewPass = strNewPass & Chr(Int((upper - lower + 1) * Rnd + upper))
	Next
	makerndid = strNewPass
End Function

'检测生成随机字符串是否重复
Function IsqrRanid(ranid)
	IsqrRanid=FALSE
	Set rs=Server.Createobject("adodb.recordset") 
	sql="select * from tempmail where ranid='"&Ranid&"'"
	rs.open sql,conn,1,1
		If NOT(rs.bof AND rs.eof) Then
			IsqrRanid=TRUE
		End If
	rs.close
End Function

'检测EMAIL是否确认中，并读出确认随机字符串
Function IsqrEmail(email)
	IsqrEmail=FALSE
	Set rs=Server.Createobject("adodb.recordset") 
	sql="select * from tempmail where email='"&email&"'"
	rs.open sql,conn,1,1
		If NOT(rs.bof AND rs.eof) Then 
			ranid=rs("ranid")
			IsqrEmail=TRUE
		End If
	rs.close
End Function

'检测EMAIL是否已经成功订阅加入数据库
Function IsdyEmail(email)
	IsdyEmail=FALSE
	Set rs=Server.Createobject("adodb.recordset") 
	sql="select * from mail where mail='"&email&"'"
	rs.open sql,conn,1,1
		If NOT(rs.bof AND rs.eof) Then IsdyEmail=TRUE
	rs.close
End Function

'提示窗口1（返回访问页面） all page
Sub showerror1()
	Response.Write "<script>alert('"&errortext&"');history.back();</script>"
	Response.End
End Sub

'提示窗口2（仅仅提示） all page
Sub showerror2()
	Response.Write "<script>alert('"&errortext&"');</script>"
End Sub
%>