class.asp

鲁门网站系统

<Script language="VBScript" runat="server">
CONST sWebSite="1"    '新扬州总站
CONST iOpenCounterPointCount="1600"   '开设柜台需要的点数
CONST iOneProductPointCount="500"     '发布一件商品的点数
CONST iBoldPointCount="100"           '粗体显示的点数
CONST iFirstCommendPointCount="1000"  '新扬州首页推荐的点数
CONST iSecondCommendPointCount="400"  '购物频道首页推荐的点数
CONST iThirdCommendPointCount="200"   '购物频道子栏目首页推荐的点数

Class DataBase ' 操作数据库对象
	Public gDBConnStr '定义连接字符串
	Public gConn '定义连接对象 
	Public gRs '定义记录集 
	Public gRsWebSite '定义记录集分站 

	'实例化对象初始化
	Private Sub Class_Initialize
		On Error Resume Next
		Set gConn=Server.CreateObject("ADODB.Connection")
		gConn.open "driver={SQL Server};server=192.168.0.3;uid=sa;pwd=tpee;database=xinyzshop"		
		If Err.Number <> 0 Then
		    Response.write "数据库链接出错!"
		    Response.End()
		End If
	End Sub
	
	'查询记录总数
	Public Function getRecordCount(sSql)
		On Error Resume Next
		Dim CountNum,gRs
		Set gRs = Server.CreateObject("ADODB.Recordset")
		gRs.Open sSql,gConn,1,1
		If Not gRs.Eof Then
		    CountNum = gRs.RecordCount
		    gRs.close
		    If CountNum > 0 Then
		        getRecordCount = CountNum
		    Else
		        getRecordCount = 0
		    End If
		Else
		    getRecordCount = 0
		End If
		
		If Err.Number <> 0 Then Err.Clear()
	End Function
	
	'执行sSql语句
	Public Function RunSql(sSql)
		On Error Resume Next
		gConn.Execute(sSql)
		If Err.Number <> 0 Then
		  RunSql = False 
		  Response.Write err.number & err.description
		Else
		  RunSql = True
		End If
	End Function

	'返回记录集
	Public Function GetRecordSet(sSql)
		On Error Resume Next
		Set gRs = Server.CreateObject("ADODB.Recordset")
		gRs.Open sSql,gConn,3,1
		GetRecordSet = gRs
		If Err.Number <> 0 Then Err.Clear()
	End Function

	'返回记录集(分站)
	Public Function GetRecordSetWebSite(sSql)
		On Error Resume Next
		Set gRsWebSite = Server.CreateObject("ADODB.Recordset")
		gRsWebSite.Open sSql,gConn,3,1
		GetRecordSet = gRsWebSite
		If Err.Number <> 0 Then Err.Clear()
	End Function

	'纪录集分页
	Function ExportPageInfo(ByRef gRs,CurPage,i,LinkFile)
		Dim retval, j, PageNumber, BasePage
		
		retval = "第" & CurPage & "页/共" & gRs.PageCount & "页 " 
		retval = retval & "本页" & i & "条/共" & gRs.RecordCount & "条 "

		If CurPage = 1 Then              
		    retval = retval & "第一页 上一页 "
		Else             
		    retval = retval & "<a href='" & LinkFile & "Page=1'>第一页</a> <a href='" & LinkFile & "Page=" & cstr(CurPage - 1) & "'>上一页</a> "
		End If
		
		If CurPage = gRs.PageCount Then             
		    retval = retval & "下一页 最后一页"
		Else
		    retval = retval & "<a href='"& LinkFile &"Page="& cstr(CurPage + 1) &"'>下一页</a> <a href='" & LinkFile & "Page=" & cstr(gRs.PageCount) & "'>最后一页</a>"
		End If
	 
		BasePage = (CurPage \ 10) * 10
		
		If BasePage > 0 Then
			retval = retval & " <a href='" & LinkFile & "Page=" & (BasePage - 9) & "'>&lt;&lt;</a>"
		End if
		
		For j = 1 to 10
			PageNumber = BasePage + j
			If PageNumber > gRs.PageCount Then 
				Exit For
			End if
			
			If PageNumber = Cint(CurPage) Then
			    retval =  retval & " <font color='#FF0000'>" & PageNumber & "</font>"
			Else
			    retval =  retval & " <a href='" & LinkFile & "Page=" & PageNumber & "'>" & PageNumber & "</a>"
			End If
		Next
		
		If gRs.PageCount > BasePage Then
			retval = retval & " <a href='" & LinkFile & "Page=" & (BasePage + 11) & "'>&gt;&gt;</a>"
		End if

		ExportPageInfo = retval
	End Function

	'实例化对象终止 
	Private Sub Class_Terminate
		Set gRs = Nothing
		set gRsWebSite = nothing
		Set gConn = Nothing
	End Sub
End Class

Class StringObject '字符串对象
	'实例化对象初始化 
	Private Sub Class_Initialize
	End Sub

	'实例化对象终止
	Private Sub Class_Terminate
	End Sub

	Rem 过滤Sql非法字符
	Function checkSql(str)
		If isnull(str) then
			checkSql = ""
			Exit function 
		End If
		checkSql=replace(str,"'","''")
	End function

	'检测字符是否在什么的范围内
	Public Function IsValidRegExp(str,Patrn)
		Dim Re
		Set Re = New RegExp
		Re.Pattern = Patrn
		Re.IgnoreCase = True
		IsValidRegExp = Re.Test(str)
	End Function

	'检测字段是否为空值
	Public Function IsFieldNull(str)
		Dim Flag
		Flag = True
		If (Not IsEmpty(str)) and (Len(trim(str)) > 0) Then
		  Flag = False
		End If
		IsFieldNull = Flag
	End Function

	'出现错误窗口
	Public Sub Error(ErrorStr)
		Response.write("<table width=80% border=0 align=center cellpadding=4 cellspacing=2 bgcolor=efefef>")
		Response.Write("<tr>")
		Response.write("<td height=22 align=center><strong style=""font-size:14px"">错 误 窗 口</strong></td>")
		Response.Write("</tr>")
		Response.write("<tr>")
		Response.Write("<td height=140 bgcolor=ffffff valign=top style=""font-size:14px"">" + ErrorStr + "</td>")
		Response.write("</tr>")
		Response.write("<tr>")
		Response.write("<td height=22 align=center>")
		Response.Write("<a href=""Javascript:history.back()"" style=""font-size:14px"">返回上一页</a>")
		Response.Write("&nbsp;&nbsp;&nbsp;")
		Response.Write("<a href=""Javascript:self.close()"" style=""font-size:14px"">关闭窗口</a>")
		Response.Write("</td>")
		Response.write("</tr>")
		Response.Write("</table>")
		Response.End()
	End Sub

	'取出N个字符串
	Public Function LeftString(str,N)
		If Len(str) > N Then
			str = Left(str,N)
		End If
		LeftString = str
	End Function

	'ubb代码
	Public Function UBBCode(strContent)
		strContent =HtmlAn(strContent)
		dim re
		Set re=new RegExp
		re.IgnoreCase =true
		re.Global=True
		re.Pattern="(\[IMG\])(\S+?)(\[\/IMG\])"
		strContent=re.Replace(strContent,"<IMG SRC=""$2"" border=0 alt=按此在新窗口浏览图片 onload=""javascript:If(this.width>screen.width-333)this.width=screen.width-333"">")
		re.Pattern="(\[FLASH\])(.+?)(\[\/FLASH\])"
		strContent= re.Replace(strContent,"<OBJECT codeBase=http://download.macromedia.com/pub/shockwave/cabs/flash/swflash.cab#veRsion=4,0,2,0 classid=clsid:D27CDB6E-AE6D-11cf-96B8-444553540000 width=500 height=400><PARAM NAME=movie VALUE=""$2""><PARAM NAME=quality VALUE=high><embed src=""$2"" quality=high pluginspage='http://www.macromedia.com/shockwave/download/index.cgi?P1_Prod_Version=ShockwaveFlash' type='application/x-shockwave-flash' width=500 height=400>$2</embed></OBJECT>")
		re.Pattern="(\[URL\])(\S+?)(\[\/URL\])"
		strContent= re.Replace(strContent,"<A HREF=""$2"" TARGET=_blank>$2</A>")
		re.Pattern="(\[URL=(\S+?)\])(.+?)(\[\/URL\])"
		strContent= re.Replace(strContent,"<A HREF=""$2"" TARGET=_blank>$3</A>")

		re.Pattern="(\[EMAIL\])(\S+\@\S+?)(\[\/EMAIL\])"
		strContent= re.Replace(strContent,"<img align=absmiddle src=pic/email1.gIf><A HREF=""mailto:$2"">$2</A>")
		re.Pattern="(\[EMAIL=(\S+\@\S+?)\])(.+?)(\[\/EMAIL\])"
		strContent= re.Replace(strContent,"<img align=absmiddle src=pic/email1.gIf><A HREF=""mailto:$2"" TARGET=_blank>$3</A>")

		re.Pattern = "^(http://[A-Za-z0-9\./=\?%\-&_~`@':+!]+)"
		strContent = re.Replace(strContent,"<img align=absmiddle src=pic/url.gIf><a target=_blank href=$1>$1</a>")
		re.Pattern = "(http://[A-Za-z0-9\./=\?%\-&_~`@':+!]+)$"
		strContent = re.Replace(strContent,"<img align=absmiddle src=pic/url.gIf><a target=_blank href=$1>$1</a>")
		re.Pattern = "[^>=""](http://[A-Za-z0-9\./=\?%\-&_~`@':+!]+)"


		re.Pattern="(\[color=(.+?)\])(.+?)(\[\/color\])"
		strContent=re.Replace(strContent,"<font color=$2 style=""font-size:"&FontSize&"pt;line-height:"&FontHeight&"pt"">$3</font>")
		re.Pattern="(\[face=(.+?)\])(.+?)(\[\/face\])"
		strContent=re.Replace(strContent,"<font face=$2 style=""font-size:"&FontSize&"pt;line-height:"&FontHeight&"pt"">$3</font>")
		re.Pattern="(\[align=(.+?)\])(.+?)(\[\/align\])"
		strContent=re.Replace(strContent,"<div align=$2>$3</div>")

		re.Pattern="(\[QUOTE\])(.+?)(\[\/QUOTE\])"
		strContent=re.Replace(strContent,"<table cellpadding=0 cellspacing=0 border=0 WIDTH=94% bgcolor=#000000 align=center><tr><td><table width=100% cellpadding=5 cellspacing=1 border=0><TR><TD BGCOLOR='"&abgcolor&"'>$2</table></table><br>")
		re.Pattern="(\[fly\])(.+?)(\[\/fly\])"
		strContent=re.Replace(strContent,"<marquee width=90% behavior=alternate scrollamount=3>$2</marquee>")
		re.Pattern="(\[move\])(.+?)(\[\/move\])"
		strContent=re.Replace(strContent,"<MARQUEE scrollamount=3>$2</marquee>")	
		re.Pattern="\[GLOW=*([0-9]*),*(#*[a-z0-9]*),*([0-9]*)\](.[^\[]*)\[\/GLOW]"
		strContent=re.Replace(strContent,"<table width=$1 style=""filter:glow(color=$2, strength=$3)"">$4</table>")
		re.Pattern="\[SHADOW=*([0-9]*),*(#*[a-z0-9]*),*([0-9]*)\](.[^\[]*)\[\/SHADOW]"
		strContent=re.Replace(strContent,"<table width=$1 style=""filter:shadow(color=$2, strength=$3)"">$4</table>")

		re.Pattern="(\[i\])(.+?)(\[\/i\])"
		strContent=re.Replace(strContent,"<i>$2</i>")
		re.Pattern="(\[u\])(.+?)(\[\/u\])"
		strContent=re.Replace(strContent,"<u>$2</u>")
		re.Pattern="(\[b\])(.+?)(\[\/b\])"
		strContent=re.Replace(strContent,"<b>$2</b>")
		re.Pattern="(\[fly\])(.+?)(\[\/fly\])"
		strContent=re.Replace(strContent,"<marquee>$2</marquee>")

		re.Pattern="(\[size=1\])(.+?)(\[\/size\])"
		strContent=re.Replace(strContent,"<font size=1 style=""line-height:"&FontHeight&"pt"">$2</font>")
		re.Pattern="(\[size=2\])(.+?)(\[\/size\])"
		strContent=re.Replace(strContent,"<font size=2 style=""line-height:"&FontHeight&"pt"">$2</font>")
		re.Pattern="(\[size=3\])(.+?)(\[\/size\])"
		strContent=re.Replace(strContent,"<font size=3 style=""line-height:"&FontHeight&"pt"">$2</font>")
		re.Pattern="(\[size=4\])(.+?)(\[\/size\])"
		strContent=re.Replace(strContent,"<font size=4 style=""line-height:"&FontHeight&"pt"">$2</font>")

		re.Pattern="(\[center\])(.+?)(\[\/center\])"
		strContent=re.Replace(strContent,"<center>$2</center>")

		set re=Nothing
		UBBCode=strContent
	End function

	Rem 过滤HTML代码
	Public Function HtmlAn(str)
		If not isnull(str) then
			str = Replace(str, ">", "&gt;")
			str = Replace(str, "<", "&lt;")
			str = Replace(str, CHR(32), " ")
			str = Replace(str, CHR(9), "&nbsp;")
			str = Replace(str, CHR(34), "&quot;")
			str = Replace(str, CHR(39), "&#39;")
			str = Replace(str, CHR(13), "")
			str = Replace(str, CHR(10) & CHR(10), "</font></P><P style=""font-size:"&FontSize&"pt;line-height:"&FontHeight&"pt"">")
			str = Replace(str, CHR(10), "<BR> ")
			HtmlAn = str
		End If
	End function
End Class
</Script>