function.asp

留言 留言本采用asp+access数据结构

<%'    ==================================================
'//             粑粑工作室留言本
'//     程序版本:    粑粑工作室留言本 v2.1 
'//     技术支持:    www.gongliyi.cn
'//     程序演示:    www.gongliyi.cn/book2
'//     作    者:    龚礼仪（粑粑）
'//     文件信息:    fuction.asp(函数文件)
'//     最后修改:    2008.11.23   
'//     升级修改:    2008.03.13 
'    ==================================================
%>
<%
'------------------------------------
' 导航代码
'------------------------------------
sub menu
Response.Write("<ul>")
Response.Write("<li class='menuL'></li><li><a class='menuA' href='index.asp' title='本本首页'>网站首页</a></li><li class='menuDiv'></li>")
Response.Write("<li class='menuL'></li><li><a class='menuA' href='add.asp' title='添加留言'>添加留言</a></li><li class='menuDiv'></li>")
Response.Write("<li class='menuL'></li><li><a class='menuA' href='index.asp#main' title='查看留言'>查看留言</a></li><li class='menuDiv'></li>")
If Session("adminname") = "" Then 

Response.Write(" <li class='menuL'></li><li><a class='menuA' href='http://www.gongliyi.cn' title='进入博客' target='_blank'>官方博客</a></li><li class='menuDiv'></li>")
end if 
If Session("adminname") = "" Then 
Response.Write("<li class='menuL'></li><li><a class='menuA' href='admin_login.asp' title='管理登陆'>管理登陆</a></li><li class='menuDiv'></li>")
end if 
If Session("adminname") <> "" Then  
Response.Write("  <li class='menuL'></li><li><a class='menuA' href='admin_config.asp' title='修改配置'>系统设置</a></li><li class='menuDiv'></li> ")  
Response.Write(" <li class='menuL'></li><li><a class='menuA' href='gonggao.asp' title='公告管理'>公告管理</a></li><li class='menuDiv'></li> ")
Response.Write(" <li class='menuL'></li><li><a class='menuA' href='admin_gonggao.asp' title='添加公告'>添加公告</a></li><li class='menuDiv'></li> ")                      
Response.Write(" <li class='menuL'></li><li><a class='menuA' href='admin_password.asp' title='修改密码'>修改密码</a></li><li class='menuDiv'></li>")  
Response.Write(" <li class='menuL'></li><li><a class='menuA' href='admin_format.asp' title='系统初始化'>系统初始化</a></li><li class='menuDiv'></li> ")         
Response.Write(" <li class='menuL'></li><li><a class='menuA' href='admin_post.asp?action=login_out' title='退出系统'>退出系统</a></li><li class='menuDiv'></li>")      
end if 
Response.Write(" <li class='menuL'></li><li><a class='menuA' href='about.asp' title='关于程序'>关于程序</a></li>")
Response.Write("<li class='menuR'></li></ul>")
end sub

'------------------------------------
' 公告代码
'------------------------------------
sub gonggao
Response.Write("<font color='#cc0000'><b>公告：</b></font>")
set rs=server.CreateObject("adodb.recordset")
sql="select top 1 * from gonggao " 
rs.open sql,conn,1,3
if rs.eof then
response.write("暂无公告")
else
Response.Write("<a href='gshow.asp?id="&rs("id")&"'>"&rs("titles")&"</a>")
end if
rs.close
set rs=nothing
end sub

'------------------------------------
' 广告代码
'------------------------------------
sub ads
Response.Write("<img src='images/ad.gif' border='0'/>")
end sub


'------------------------------------
' 版权代码
'------------------------------------
sub copyright()
dim copy
  copy="Copyright 2007-2009 <a href='http://www.gongliyi.cn'>粑粑留言本</a> All Rights Reserved Powered by <a href='http://www.gongliyi.cn'>Baba-Book 2.1</a> Code "
  Response.Write(vbcrlf&copy)
end sub


'------------------------------------
' HTML代码转换
'------------------------------------
Function HTMLEncode(fString)
If Not IsNull(fString) And fString <> "" Then
	fString = Replace(fString, "&", "&amp;")
	fString = Replace(fString, ">", "&gt;")
	fString = Replace(fString, "<", "&lt;")
	fString = Replace(fString, Chr(32), "&nbsp;")
	fString = Replace(fString, Chr(9), "&nbsp;&nbsp;")
	fString = Replace(fString, Chr(34), "&quot;")
	fString = Replace(fString, Chr(39), "&#39;")
	fString = Replace(fString, Chr(13), "")
	fString = Replace(fString, Chr(10) & Chr(10), "</P><P>")
	fString = Replace(fString, Chr(10), "<BR>")
	fString = Replace(fString, Chr(255), "&nbsp;")
	HTMLEncode = fString
End If
End Function

'------------------------------------
'检测是否有效的E-mail地址
'------------------------------------
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("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

'------------------------------------
'简单检测是否有效的Http地址
'------------------------------------
Function IsValidUrl(Url)
	IsValidUrl = False
	Dim Domain,Domain1,Domain2
	Domain = Split(Url,"//"):Domain1= Split(Url,":"):Domain2= Split(Url,".")
	If UBound(Domain) > 0 and UBound(Domain1) > 0 and UBound(Domain2) > 0 then IsValidUrl = True
End Function

'------------------------------------
'检测是否有效的用户名
'------------------------------------
Function IsValidUserName(UserName)
	Dim i,c
	Dim VUserName
	IsValidUserName = True
	For i = 1 To Len(UserName)
		c = Lcase(Mid(UserName, i, 1))
		If InStr("$!<>?#^%@~`&*();:+='""