www.gusucode.com > 易心博客[圣诞版] 3.5手动安装码程序 > Ex_Cls/Ex_CommonCls.asp

    <!--#include file="../inc/SN.asp"-->
<!--#include file="../inc/md5.asp"-->
<%
'*********************************************************
'文件名称: Ex_CommonCls.asp
'功能描述: 易心博客通用调用类
'程序制作:易心
'官方网站: http://www.ex123.net
'论坛支持:http://bbs.ex123.net
'程序演示:http://exblog.ex123.net
'Copyright (C) 2007 ex123.net All rights reserved.
'LastUpdate:    2007-4-21
'*********************************************************
class Ex_CommonCls
Public AdName,AdPwd,ShowName,BlogName,BlogUrl,LogoUrl,Placard,WordNum,LogNum,NewLog,NewMsg,NewCmt,LogCount,HidePwd
Public CmtCount,MsgCount,VisiteCount,BeiAn,CopyRight,LinkMode,HotTags,RunMode,Domain,DefaultSkin,Bottom
Private Rs,Re
private sub Class_Initialize
	Set Rs=Server.CreateObject("adodb.recordset")
	Set Re=new Regexp
	Re.ignorecase=True 
	Re.global=True 
	Re.multiline=True 
end sub
private sub Class_Terminate
	Set Rs=Nothing
	Set Re=Nothing 
end Sub
'**********************
'功能:检测易心博客系统是不是初次安装
'参数:str--要过滤得参数值
'**********************
Public Sub CheckInstall
	GetConfig
	Dim ExLocation,FsoCls
	Set FsoCls=new Ex_FsoCls
	ExLocation=GetDomain()&request.servervariables("script_name")
	If InStr(ExLocation,Application(Sn&"BlogUrl"))=0 And Application(Sn&"Domain")="否" Then
		If FsoCls.CheckExist("install.asp","file") Then
			Response.redirect("install.asp")
		Else
			Response.write "本次运行需要您从新安装博客。没有在您的空间中找到安装文件install.asp。&nbsp;&nbsp;<a href=""http://www.ex123.net"">点此下载</a><br>取消此提示请登录后台,把博客站点设置中的启用泛域名转向选是.<br>出现此提示可能是因为您博客更换了域名或初次安装。<a href=""http://bbs.ex123.net/dispbbs.asp?boardid=3&id=1438"">请上传安装文件install.asp进行安装。</a>"
		End if
	End If
End Sub
'**********************
'功能:静态模式的情况下 直接输入网址的 转向
'参数:无
'**********************
Public Sub GoIndex
	GetConfig
	Dim ExReferer
	ExReferer=request.servervariables("http_referer")
	'If InStr(ExReferer,BlogUrl)=0 And runmode="静态"  And request.querystring.count=0 And Application(Sn&"musictype")="" Then
	If InStr(ExReferer,BlogUrl)=0 And request.querystring.count=0 And Application(Sn&"musictype")<>"index.asp" Then
		Response.redirect(Application(Sn&"musictype"))
	End if
End Sub
'**********************
'功能:获取文件或文件夹占用空间情况
'参数:GetLocal--要获取的文件或文件夹路径 GetType--获取类型 folder or file
'*********************
Public Function GetTotalSize(GetLocal,GetType)
	Dim FSO
	Set FSO=Server.CreateObject("Scripting.FileSystemObject")
	IF Err<>0 Then
		Err.Clear
		GetTotalSize="服务器关闭FSO,查看占用空间失败"
	Else
		Dim SiteFolder
		IF GetType="Folder" Then
			Set SiteFolder=FSO.GetFolder(GetLocal) 
		Else
			Set SiteFolder=FSO.GetFile(GetLocal) 
		End IF
		GetTotalSize=SiteFolder.Size
		IF GetTotalSize>1024*1024 Then
		GetTotalSize=GetTotalSize/1024/1024
		IF inStr(GetTotalSize,".") Then GetTotalSize = Left(GetTotalSize,inStr(GetTotalSize,".")+2)
			GetTotalSize=GetTotalSize&" MB"
		Else
			GetTotalSize=Fix(GetTotalSize/1024)&" KB"
		End IF
		Set SiteFolder=Nothing
	End IF
	Set FSO=Nothing
End Function
'***********************
'功能:判断用户ip是否允许访问
'参数:无
'**********************
Public Sub  IsIpAllow
	If InStr(GetIpCache,GetIp)<>0 And GetIpCache<>"" Then
		Response.write "您的ip被禁止访问本站,请于管理员联系"
		Response.End 
	End if
End Sub

'**************************************************
'函数名:GetDoMain()
'作  用:取得当前网站访问地址 如:http://127.0.0.1
'参  数:无
'**************************************************
Public Function GetDomain()
	Dim TempPath
	If LCase(request.ServerVariables("HTTPS")) = "off" Then
		TempPath = "http://"
		Else
		TempPath = "https://"
		End If
	If Request.ServerVariables("SERVER_PORT") = "80" Then
		GetDomain = Request.ServerVariables("SERVER_NAME")
	Else
		GetDomain = Request.ServerVariables("SERVER_NAME") & ":" & Request.ServerVariables("SERVER_PORT")
	End If
	If Instr(UCASE(GetDomain),"/W3SVC")<>0 Then
		GetDomain=Left(GetDomain,Instr(GetDomain,"/W3SVC"))
	End If
		GetDomain = TempPath & GetDomain
End Function
'**************************************************
'函数名:GetIP
'作  用:取得正确的IP
'返回值:IP字符串
'**************************************************
Public Function GetIP() 
	Dim strIPAddr 
	If Request.ServerVariables("HTTP_X_FORWARDED_FOR") = "" Or InStr(Request.ServerVariables("HTTP_X_FORWARDED_FOR"), "unknown") > 0 Then 
		strIPAddr = Request.ServerVariables("REMOTE_ADDR") 
	ElseIf InStr(Request.ServerVariables("HTTP_X_FORWARDED_FOR"), ",") > 0 Then 
		strIPAddr = Mid(Request.ServerVariables("HTTP_X_FORWARDED_FOR"), 1, InStr(Request.ServerVariables("HTTP_X_FORWARDED_FOR"), ",")-1) 
	ElseIf InStr(Request.ServerVariables("HTTP_X_FORWARDED_FOR"), ";") > 0 Then 
		strIPAddr = Mid(Request.ServerVariables("HTTP_X_FORWARDED_FOR"), 1, InStr(Request.ServerVariables("HTTP_X_FORWARDED_FOR"), ";")-1)
	Else 
		strIPAddr = Request.ServerVariables("HTTP_X_FORWARDED_FOR") 
	End If 
	GetIP = Replace(Trim(Mid(strIPAddr, 1, 30)), "'", "")
End Function


 '编码转换
Private Function BytesToBstr(ByVal strBody,CodeBase)
       dim obj
       set obj=Server.CreateObject("Ad"&"odb.S"&"tr"&"eam")
       obj.Type=1
       obj.Mode=3
       obj.Open
       obj.Write strBody
       obj.Position=0
       obj.Type=2
       obj.Charset=CodeBase
       BytesToBstr=obj.ReadText
       obj.Close
       set obj=nothing
End Function
'获取服务器端数据
Public Function GetServerData(Url)
	Dim XmlHttp,xmlDNSTimeout,xmlCONTimeout,xmlSNDTimeout,xmlRCVTimeout
	xmlDNSTimeout = 10000      '解析 DNS 的超时时间,单位:毫秒 
	xmlCONTimeout = 10000      '建立连接的超时时间,单位:毫秒 
	xmlSNDTimeout = 30000      '发送数据的超时时间,单位:毫秒 
	xmlRCVTimeout = 30000      '接收数据的超时时间,单位:毫秒 
	On Error Resume Next 
	Set XmlHttp=Server.CreateObject("MSX"&"ML2.Se"&"rver"&"XM"&"LHTTP")
	XmlHttp.setTimeouts  xmlDNSTimeout, xmlCONTimeout, xmlSNDTimeout, xmlRCVTimeout 
	XmlHttp.Open "Get",Url,False 
	XmlHttp.Send()
	If XmlHttp.ReadyState<>4 Then 
		'ExComm.ShowMsg "获取数据失败,您的空间可能不支持在线安装等功能.如果经常获取数据失败,建议使用易心空间\n或者到官方网站下载升级包进行手动安装.","admin_config.asp"
		Response.Write("您的空间不支持在线升级等功能")
	End If 
	If XmlHttp.Status<>200 Or Err.number<>0 Then 
		Err.clear
		Set XmlHttp=Server.CreateObject("Micro"&"soft.X"&"ML"&"H"&"TT"&"P")
		XmlHttp.Open "Get",Url,False 
		XmlHttp.Send()
	End If 
	GetServerData=BytesToBstr(XmlHttp.ResponseBody,"Gb2312")
End Function  

'**************************************************
'函数名:ExNow
'作  用:
'返回值:指定格式的时间字符串
'**************************************************
Public Function ExNow()
	ExNow=Year(now)&"-"&Month(now)&"-"&Day(now)&" "&Hour(now)&":"&Minute(now)&":"&Second(now)
End Function 
'******************
'功能:显示操作信息 
'参数:msg--错误信息 url--操作后要转向的地址 如果为空表示返回
'******************
public sub ShowMsg(byval msg,byval url)
	Response.Write("<script>alert('"&msg&"')</script>")
	if url="" then
		Response.Write("<script>history.go(-1)</script>")
	else
		Response.Write("<script>window.location='"&url&"'</script>")
	End If
	response.end
End Sub

'*********************
'功能:判断管理员是否登陆 有提示
'参数:无  
'*********************
Public Sub IsAdLogin
	If session("AdLogin")<>Md5(SN) Then
		GetConfig
		If AdName<>Request.Cookies(Md5(SN))("AdName") Or AdPwd<>Request.Cookies(Md5(SN))("AdPwd") Then
			ShowMsg "您还没有登陆",Application(sn&"blogurl")&"admin_login.asp"
		End If
	End If
End Sub
'*********************
'功能:判断一组帐号和密码是不是匹配
'参数:uname upwd
'*********************
Public Function CheckUNP(ByVal uname,ByVal upwd)
	If Len(upwd)<=20 Then 
		upwd=md5(upwd)
	End If 
	If Conn.execute("select count(*) from Ex_user where username='"&uname&"' and userpwd='"&upwd&"' and lock=false")(0)=0 Then
		CheckUNP=CBool("false")
	Else
		CheckUNP=cbool("true")
	End if
End Function 
'*********************
'功能:判断是否登陆 无提示 返回 true or false
'参数:utype---类型  admin表示是管理员判断 User表示是用户判断
'*********************
Public Function IsLogin(utype)
	IsLogin=CBool("True")
	If utype="admin" Then 
		If session("AdLogin")<>Md5(SN) Then
			GetConfig
			If AdName<>(Request.Cookies(sn)("AdName")) Or AdPwd<>G(Request.Cookies(sn)("AdPwd")) Then
				IsLogin=CBool("false")
			Else 
				IsLogin=CBool("True")
			End If
		End If
	Else
		If session("user")="" Then 
			Dim username,userpwd,un
			username=UnDeCode(F(request.Cookies(Md5(sn))("uname")))
			userpwd=UnDeCode(F(request.Cookies(Md5(sn))("upwd")))
			un=Conn.execute("select count(*) as d from ex_user where username='"&trim(username)&"' and userpwd='"&Trim(userpwd)&"'")
			If un(0)<>0 Then
				session("user")=username
				IsLogin=CBool("True")
			ElseIf username="" Then 
				IsLogin=CBool("false")
			Else 
				IsLogin=CBool("false")
			End if
		End If 
	End If 
End Function
'************************
'在容器中插入html
'参数:id--容器id html--要输出的html代码
'*************************
Public Sub InnerHtml(id,html)
	response.write("<script>document.getElementById('"&id&"').innerHTML='"&html&"';</script>")
End Sub 
'*********************
'功能:获得网站配置信息
'参数:无
'*********************
Public Sub GetConfig()
	Dim I
	Rs.Open "select * from Ex_Config",Conn,1,1
	for I=0 to RS.fields.count-1
		Execute(RS.Fields(i).Name&"="""&ForValue(trim(RS.Fields(i).Value))&"""")
	Next
	Rs.Close
End Sub
Public Function ForValue(s)
	If IsNull(s) Then 
		s=""
	End If 
	ForValue=Replace(s,Chr(10)+Chr(13),"")
	ForValue=Replace(ForValue,Chr(10),"")
	ForValue=Replace(ForValue,Chr(13),"")
	ForValue=Replace(ForValue,"""","")
End Function
'*********************
'功能:获取栏目中日志的数量
'参数:栏目id
'*********************
Public Function  GetClassNum(id)
	GetClassNum=Conn.execute("select count(*) from Ex_Log where classid="&CInt(id))(0)
End Function 
'*********************
'功能:获取日志静态文件名 如果为空 返回日志id
'参数:日志id
'*********************
Public Function  GetLogName(id)
	Dim Temp
	Temp=Conn.execute("select file_name from Ex_Log where id="&CInt(id))(0)
	If Temp="" Or IsNull(Temp) Then 
		GetLogName=Id
	Else 
		GetLogName=Temp
	End If 
End Function 
'*********************
'功能:用户访问量统计
'参数:无
'*********************
Public Sub visitorCount
	If Request.Cookies(Md5(Sn))("visitorCount")<>"www.ex123.net" Then 
		Conn.execute("update Ex_Config set VisiteCount=VisiteCount+1")
		GetVisiteTotalCache
		Application.lock
		Application(sn&"visiteCount")=Application(sn&"visiteCount")+1
		Application.unlock
	End If 
	Response.Cookies(Md5(Sn))("visitorCount")="www.ex123.net"
End Sub

'*********************
'功能:构造底部信息
'参数:无
'*********************
Public Function BottomInfo
	Dim TempStr
	TempStr="<div align=""center"">"
	If Application(sn&"bottom")<>"" Then 
		TempStr=TempStr&Application(sn&"bottom")
	Else 
		TempStr=TempStr&"CopyRight&copy2008 "&Application(sn&"blogname")&" <a href=""http://www.miibeian.gov.cn/"">"&Application(sn&"beian")&"</a><br>"
		TempStr=TempStr&Application(Sn&"waithtml")
		TempStr=TempStr&"Powered By "&Application(Sn&"Version")&" Www.ex123.Net .<a href=""http://www.ex123.net""><img src=""images/admin/Exblog_powered.gif"" border=""0""></a>"
	End If 
	TempStr=TempStr&"</div>"&vbcrlf
	If Application(Sn&"RunMode")="静态" Then 
		TempStr=TempStr&"<script src=""JsInHtml.asp?action=calendar&c_year=$show_year$&c_month=$show_month$&c_day=$show_day$""></script>"&vbcrlf
		TempStr=TempStr&"<script src=""JsInHtml.asp?action=login""></script>"&vbcrlf
		TempStr=TempStr&"<script src=""JsInHtml.asp?action=info""></script>"&vbcrlf
		TempStr=TempStr&"<script src=""JsInHtml.asp?action=more&ids=$show_logids$""></script>"&vbcrlf
		TempStr=TempStr&"<script src=""autohtml.asp?id=$show_logids$""></script>"&vbcrlf
	End If 
	BottomInfo=TempStr
End Function 
'*****************************字符串处理部分开始***************************
'**************************************************
'函数名:CheckRe
'作  用:检测给定的字符串与正则匹配模式是否匹配
'参  数:str  ----要检测的字符串 pat---正则模式[多个模式间用%分割]
'返回值:匹配返回true 否则返回 false
'**************************************************
Public Function CheckRe(str,pat)
	Dim I
	If Trim(pat)<>"" Then 
		If InStr(pat,"%")<>0 Then 
			pat=Split(pat,"%")
			For I=0 To UBound(pat)
				Re.pattern=pat(I)
				If Re.Test(str) Then 
					CheckRe=CBool("true")
					Exit Function 
				Else
					CheckRe=CBool("false")
				End If 
			Next 
		Else 
			Re.pattern=pat
			If Re.Test(str) Then 
				CheckRe=CBool("true")
				Exit Function 
			Else
				CheckRe=CBool("false")
			End If 
		End If 
	Else 
		CheckRe=CBool("False")
	End If 
End Function

'**************************************************
'函数名:SubStr
'作  用:返回字符串中 给定开始字符串和结束字符串之间的子字符串 包括开始和结束字符串
'参  数:str  ----要检测的字符串 
'返回值:返回子字符串
'**************************************************
Public Function SubStr(Str,StartStr,EndStr)
	Dim StartNum,EndNum
	StartNum=InStr(Str,StartStr)
	EndNum=InStr(Str,EndStr)
	SubStr=Mid(Str,StartNum,EndNum+Len(EndStr)-2)
End Function 
'**************************************************
'函数名:ReReplace
'作  用:根据正则条件去除符合正则部分
'参  数:str  ----要检测的字符串 p---正则
'返回值:返回去除后的字符串
'**************************************************
Public Function ReReplace(Str,P)
	Re.pattern=P
	ReReplace=Re.replace(Str,"")
End Function 
'**************************************************
'函数名:Html2Js
'作  用:把html代码转换成js形式
'参  数:str  ----要转换的字符串 id---被输入容器的id
'返回值:转换后的字符串
'**************************************************
Public Function Html2Js(id,str)
	Dim Temp
	Temp=str
	Temp=Replace(Temp,"""","\""")
	Temp=Replace(Temp,"'","\'")
	Temp=Replace(Temp,"</script>","<\/script>")
	Temp=Replace(Temp,Chr(10),"<br>")
	Temp=Replace(Temp,Chr(13),"")
	If Trim(id)="" Then 
		Html2Js=Temp
	Else 
		Html2Js="if (chkdiv('"&id&"')) {document.getElementById('"&id&"').innerHTML='"&Temp&"';}"
	End If 
End Function
'**************************************************
'函数名:strLength
'作  用:求字符串长度。汉字算两个字符,英文算一个字符。
'参  数:str  ----要求长度的字符串
'返回值:字符串长度
'**************************************************
Public Function strLength(Str)
	Dim bolChinese
	bolChinese= (Len("易心") = 2)
	If bolChinese Then
		Dim intLen, intCount,intCode,intIndex
		intLen = Len(Str)
		intCount= l
		For intIndex = 1 To intLen
			intCode = Ascw(Mid(Str, intIndex, 1))
			If intCode > 255 Or intCode<0 Then
				intCount = intCount + 2
			Else
				intCount =intCount+1
			End If
		Next
		strLength = intCount
	Else
		strLength = Len(Str)
	End If
End Function
'*****************
'功能:字符串截取 返回截取的字符串
'参数:str---要截取的字符串 num---要截取的字符数
'*****************
public function CutStr(byval str,byval num)
	dim i,l,char,strTemp,ln
	'Str = Replace(Replace(Replace(Replace(Str, "&nbsp;", " "), "&quot;", Chr(34)), "&gt;", ">"), "&lt;", "<")
	l=len(str)
	ln=0
	for i=1 to l
		char=mid(str,i,1)
		if ascw(char)>=0 and ascw(char)<=255 then
			ln=ln+1
		else
			ln=ln+2
		end if
		strTemp=strTemp&Char
		if cint(ln)>=cint(num) then
			exit For 
		end if
	Next
	'strTemp = Replace(Replace(Replace(Replace(strTemp, " ", "&nbsp;"), Chr(34), "&quot;"), ">", "&gt;"), "<", "&lt;")
	CutStr=strTemp
end Function
'**********************
'功能:过滤获得的参数  返回过滤后的参数值
'参数:str--要过滤得参数值
'**********************
public function G(byval Str)
	if isnull(Str) then
	Str=""
	end If
	Str = replace(Str,"'","''")
	Re.Pattern="select"
	Str = Re.Replace(Str,"sel&#101;ct")
	Re.Pattern="join"
	Str = Re.Replace(Str,"jo&#105;n")
	Re.Pattern="union"
	Str = Re.Replace(Str, "un&#105;on")
	Re.Pattern="where"
	Str = Re.Replace(Str,"wh&#101;re")
	Re.Pattern="insert"
	Str = Re.Replace(Str,"ins&#101;rt")
	Re.Pattern="deleter"
	Str = Re.Replace(Str, "del&#101;te")
	Re.Pattern="update"
	Str = Re.Replace(Str, "up&#100;ate")
	Re.Pattern="like"
	Str = Re.Replace(Str, "lik&#101;")
	Re.Pattern="drop"
	Str = Re.Replace(Str, "dro&#112;")
	Re.Pattern="create"
	Str = Re.Replace(Str, "cr&#101;ate")
	Re.Pattern="modify"
	Str = Re.Replace(Str, "mod&#105;fy")
	Re.Pattern="rename"
	Str = Re.Replace(Str, "ren&#097;me")
	Re.Pattern="alter"
	Str = Re.Replace(Str, "alt&#101;r")
	Re.Pattern="cast"
	Str = Re.Replace(Str, "ca&#115;t")
	Re.pattern="\$show_"
	Str = Re.Replace(Str, "$&#115;how_")
	G=Str
end Function
'**************************
'功能:过滤表单内容 返回过滤后的值
'参数:str--要过滤的内容
'**************************
Public Function F(ByVal Str)
	Str=Server.htmlencode(Str)
	Str=G(str)
	F=Str
End Function 
'**************************************************
'纠正html代码中的连接地址 全部转换成相对路径
'参数:str--要转换的内容
'**************************************************
Function  DoUrl(ByVal str)
	Re.pattern="src=((?!""|'|ftp|http|https|mailto).*?)>"
	str=Re.Replace(str,"src="&Application(sn&"blogurl")&"$1>")
	Re.pattern="src='((?!""|ftp|http|https|mailto).*?)\'"
	str=Re.Replace(str,"src='"&Application(sn&"blogurl")&"$1'")
	Re.pattern="src=""((?!'|ftp|http|https|mailto).*?)"""
	str=Re.Replace(str,"src="""&Application(sn&"blogurl")&"$1""")
	Re.pattern="url\(((?!""|'|ftp|http|https|mailto).*?)\)"
	str=Re.Replace(str,"url\("&Application(sn&"blogurl")&"$1\)")
	Re.pattern="url\('((?!""|ftp|http|https|mailto).*?)\)"
	str=Re.Replace(str,"url\('"&Application(sn&"blogurl")&"$1\)")
	Re.pattern="url\(""((?!'|ftp|http|https|mailto).*?)""\)"
	str=Re.Replace(str,"url\("&Application(sn&"blogurl")&"$1\)")
	Re.pattern="href=((?!""|'|ftp|http|https|mailto).*?)>"
	str=Re.Replace(str,"href="&Application(sn&"blogurl")&"$1>")
	Re.pattern="href='((?!""|ftp|http|https|mailto).*?)'"
	str=Re.Replace(str,"href='"&Application(sn&"blogurl")&"$1'")
	Re.pattern="href=""((?!'|ftp|http|https|mailto).*?)"""
	str=Re.Replace(str,"href="""&Application(sn&"blogurl")&"$1""")
	Re.pattern="background=((?!""|'|ftp|http|https|mailto).*?)>"
	str=Re.Replace(str,"background="&Application(sn&"blogurl")&"$1>")
	Re.pattern="background='((?!""|ftp|http|https|mailto).*?)>"
	str=Re.Replace(str,"background='"&Application(sn&"blogurl")&"$1>")
	Re.pattern="background=""((?!'|ftp|http|https|mailto).*?)"""
	str=Re.Replace(str,"background="""&Application(sn&"blogurl")&"$1""")
	DoUrl=str
End Function
'**************************************************
'生成静态连接地址
'参数:t-返回数据类型[blogview folderpath filepath]
'classid--分类id或者分类目录名 logid--日志id或者自定义文件名 tags--tag名 page--分页 如果第一页 赋值为空 其它赋值为 -page
'**************************************************
Public Function CreateUrl(ByVal classid,ByVal logid,ByVal page)
	Dim Temp,ClassId2
	If IsNumeric(logid) Then
		If Trim(ClassId)="html" Then 
			ClassId2=Conn.Execute("select classid from Ex_log where id="&logid)(0)
		Else 
			ClassId2=ClassId
		End If 
		If Trim(page)="" Then 
			page="_1"
		End If 
		Temp=Application(sn&"blogurl")&classid&"/blogview-"&classid2&"-"&logid&page&".html"
	Else 
		Temp=Application(sn&"blogurl")&classid&"/"&logid&page&".html"
	End If 
	CreateUrl=Temp
End Function 
'**************************************************
'文本框输入的内容与html代码间常见字符转换
'参数:str--文本框中的内容
'**************************************************
Public Function Text2Html(ByVal str)
	Dim temp
	temp=Replace(str,Chr(10),"<br>")
	temp=Replace(temp,Chr(13),"")
	Text2Html=temp
End Function 
'****************************************************
'清除html标记
'参数 str----要清除的字符串
'****************************************************
Public Function clearHtml(ByVal str)
	re.pattern="(\<)(.*?)(\>)"
	re.IgnoreCase =false
	re.Global=True
	str=re.Replace(str,"")
	clearHtml=str
End Function
'**************************************************
'服务器端编码函数
'参数:str--要进行编码的内容
'**************************************************
function DeCode(ByVal str)
	Dim dei,detemp,dechar
	For dei=Len(str) To 1 Step -1
		dechar=Mid(str,dei,1)
		detemp=detemp&Ascw(dechar)
		If dei<>1 Then
			detemp=detemp&"a"
		End If 
	Next 
	DeCode=detemp
End Function 
'*************************************************
'服务器端解码函数
'参数:str--要进行解码的内容
'*************************************************
Public Function UnDeCode(ByVal str)
	Dim uni,untemp
	str=Split(str,"a")
	For uni=UBound(str) To 0 Step -1
		untemp=untemp&chrw(str(uni))
	Next 
	UnDeCode=untemp
End Function 
'*************************************************
'判断是不是oblog模板
'参数:无
'*************************************************
Public Function IsOblogSkin
	If IsCache("DefaultSkin")=False Then 
		GetConfigCache("DefaultSkin")
	End If 
	If IsNumeric(Application(sn&"DefaultSkin")) Then 
		IsOblogSkin=CBool("true")
	Else 
		IsOblogSkin=CBool("false")
	End If 
End Function 

'*****************************字符串处理部分结束***************************


'*****************************系统缓存部分开始**************************
'*********************
'功能:获取站点配置信息缓存值 默认缓存 博客名称 application(sn&"blogname") 管理员前台显示名 application(sn$"showname")
'博客地址 application(sn&"blogurl") logo地址 application(sn&"logourl")
'参数:CacheName--要获取的缓存名 多个缓存名之间用逗号割开 * 代表获取全部配置信息
'*********************
Public Function GetConfigCache(ByVal CacheName)
	Dim I,Arr
	Arr=Split(CacheName,",")
	If InStr(CacheName,",")<>0 Then 
		CacheName=""
		For I=0 To UBound(Arr)
			If IsCache(Arr(I))=False Then 
				CacheName=CacheName&Arr(I)&","
			End If 
		Next
		If InStr(CacheName,",")<>0 Then 
			CacheName=Left(CacheName,Len(CacheName)-1)
		End If 
	End If 
	If Trim(CacheName)<>"" Then 
		Application.Lock
		Rs.open "select "&CacheName&" from Ex_Config",Conn,1,1
		For I=0 To Rs.Fields.Count-1
			Execute("Application("""&SN&RS.Fields(i).Name&""")="""&ForValue(trim(RS.Fields(i).Value))&"""")
		Next
		Rs.close
		Application.UnLock
	End If 
End Function
 
'********************
'获取ip缓存
'参数:无
'*******************
Public Function GetIpCache
	If IsCache("ip")=False  Then
		Rs.open "select lockIp from Ex_LockIp",Conn,1,1
		If Not Rs.eof And Not Rs.bof Then
			Application.Lock
			Do While Not rs.eof 
				Application(sn&"ip")=Application(sn&"ip")&"|"&Rs(0)
				Application.UnLock
				rs.movenext
			loop
		End If
		Rs.close
	End If
	GetIpCache=Application(sn&"ip")
End Function
'********************
'获取分类缓存 把非转向分类缓存 分类之间用а隔开 分类与id之间用б隔开
'参数:无
'*******************
Public Sub  GetClassCache
	If IsCache("class")=False  Then
		Application.Lock
		Rs.open "select id,classx from Ex_Class where `default`=true",Conn,1,1
		If Not Rs.eof And Not Rs.bof Then
			Do While Not rs.eof
			Application(sn&"class")=Application(sn&"class")&"а"&Rs("id")&"б"&Rs("classx")
			rs.movenext
			loop
		End If
		Rs.close
		Application.UnLock
	End If
End Sub 
'********************
'获取分类缓存 把非转向分类缓存 分类之间用а隔开 分类与id之间用б隔开
'参数:无
'*******************
Public Sub  GetClassFolderCache
	If IsCache("classfolder")=False  Then
		Application.Lock
		Rs.open "select id,classfolder from Ex_Class where default=1",Conn,1,1
		If Not Rs.eof And Not Rs.bof Then
			Do While Not rs.eof
			Application(sn&"classfolder")=Application(sn&"classfolder")&"а"&Rs("id")&"б"&Rs("classfolder")
			rs.movenext
			loop
		End If
		Rs.close
		Application.UnLock
	End If
End Sub
'*************************************
'获得类静态目录
'参数:clsid--类的id
'*************************************
Public Function GetClassFolder(ByVal clsid)
	Dim myclass,classid,i
	GetClassFolderCache()
	myclass=application(sn&"classfolder")
	myclass=Split(myclass,"а")
	For i=1 To UBound(myclass)
		classid=Split(myclass(i),"б")
		If CInt(classid(0))=CInt(clsid) Then
			If Trim(classid(1))="" Or IsNull(Classid(1)) Then 
				GetClassFolder="html"
			Else 
				GetClassFolder=classid(1)
			End If 
			Exit Function 
		End if
	Next
End Function 
'*************************************
'获得类名称
'参数:clsid--类的id
'*************************************
Public Function GetClassName(ByVal clsid)
	Dim myclass,classid,i
	GetClassCache()
	myclass=application(sn&"class")
	myclass=Split(myclass,"а")
	For i=1 To UBound(myclass)
		classid=Split(myclass(i),"б")
		If CInt(classid(0))=CInt(clsid) Then
			GetClassName=classid(1)
			Exit Function 
		End if
	Next
End Function 
'********************
'获取分类缓存 以列表框形式
'参数:id--默认被选中项的id
'*******************
Public Function GetClassSelectCache(id)
		Dim myclass,classid,i
		GetClassCache
		myclass=Mid(application(sn&"class"),2,Len(application(sn&"class")))
		myclass=Split(myclass,"а")
		For i=0 To UBound(myclass)
			classid=Split(myclass(i),"б")
			If CInt(classid(0))=CInt(id) Then
				GetClassSelectCache=GetClassSelectCache&"<option value="""&classid(0)&""" selected>"&classid(1)&"</option>"
			Else
				GetClassSelectCache=GetClassSelectCache&"<option value="""&classid(0)&""">"&classid(1)&"</option>"
			End if
		Next
End Function
'********************
'获取相册分类缓存 分类之间用а隔开 分类与id之间用б隔开
'参数:无
'*******************
Public Sub  GetPhotoClassCache
	If IsCache("photoclass")=False  Then
		Application.Lock
		Rs.open "select id,clsname from Ex_PhotoCls",Conn,1,1
		If Not Rs.eof And Not Rs.bof Then
			Do While Not rs.eof
			Application(sn&"photoclass")=Application(sn&"photoclass")&"а"&Rs("id")&"б"&Rs("clsname")
			rs.movenext
			loop
		End If
		Rs.close
		Application.UnLock
	End If
End Sub 
'********************
'获取相册分类缓存 以列表框形式
'参数:id--默认被选中项的id
'*******************
Public Function GetPhotoClassSelectCache(id)
		Dim myclass,classid,i
		GetPhotoClassCache
		myclass=Mid(application(sn&"photoclass"),2,Len(application(sn&"photoclass")))
		myclass=Split(myclass,"а")
		For i=0 To UBound(myclass)
			classid=Split(myclass(i),"б")
			If CInt(classid(0))=CInt(id) Then
				GetPhotoClassSelectCache=GetPhotoClassSelectCache&"<option value="""&classid(0)&""" selected>"&classid(1)&"</option>"
			Else
				GetPhotoClassSelectCache=GetPhotoClassSelectCache&"<option value="""&classid(0)&""">"&classid(1)&"</option>"
			End if
		Next
End Function
'********************
'获取连接分类缓存 把非转向分类缓存 分类之间用а隔开 分类与id之间用б隔开
'参数:无
'*******************
Public Sub  GetLinksClassCache
	If IsCache("Linksclass")=False  Then
		Application.Lock
		Rs.open "select id,clsname from Ex_LinksCls order by orderx asc",Conn,1,1
		If Not Rs.eof And Not Rs.bof Then
			Do While Not rs.eof
			Application(sn&"Linksclass")=Application(sn&"Linksclass")&"а"&Rs("id")&"б"&Rs("clsname")
			rs.movenext
			loop
		End If
		Rs.close
		Application.UnLock
	End If
End Sub 
'********************
'获取连接分类缓存 以列表框形式
'参数:id--默认被选中项的id
'*******************
Public Function GetLinksClassSelectCache(id)
		Dim myclass,classid,i
		GetLinksClassCache
		myclass=Mid(application(sn&"Linksclass"),2,Len(application(sn&"Linksclass")))
		myclass=Split(myclass,"а")
		For i=0 To UBound(myclass)
			classid=Split(myclass(i),"б")
			If Not (IsNull(classid(0)) Or IsNull(id)) Then 
				If CInt(classid(0))=CInt(id) Then
					GetLinksClassSelectCache=GetLinksClassSelectCache&"<option value="""&classid(0)&""" selected>"&classid(1)&"</option>"
				Else
					GetLinksClassSelectCache=GetLinksClassSelectCache&"<option value="""&classid(0)&""">"&classid(1)&"</option>"
				End If
			Else 
				GetLinksClassSelectCache=GetLinksClassSelectCache&"<option value="""&classid(0)&""">"&classid(1)&"</option>"
			End If 
		Next
End Function

'*******************
'日志数量缓存
'参数:无
'********************
Public Function GetLogTotalCache()
	If IsCache("logtotal")=False Then
		Application.lock
		Application(sn&"logtotal")=Conn.Execute("select count(*) as n from Ex_log")(0)
		Application.unlock
	End If 
	GetLogTotalCache=Application(sn&"logtotal")
End Function
'*******************
'评论数量缓存
'参数:无
'********************
Public Function GetCmtTotalCache()
	If IsCache("cmttotal")=False Then
		Application.lock
		Application(sn&"cmttotal")=Conn.Execute("select count(*) as n from Ex_Comment")(0)
		Application.unlock
	End If 
	GetCmtTotalCache=Application(sn&"cmttotal")
End Function
'*******************
'留言数量缓存
'参数:无
'********************
Public Function GetMsgTotalCache()
	If IsCache("Msgtotal")=False Then
		Application.lock
		Application(sn&"msgtotal")=Conn.Execute("select count(*) as n from Ex_Message")(0)
		Application.unlock
	End If 
	GetMsgTotalCache=Application(sn&"Msgtotal")
End Function
'*******************
'访问数量缓存
'参数:无
'********************
Public Function GetVisiteTotalCache()
	If IsCache("VisiteCount")=False Then
		GetConfigCache("VisiteCount")
		Application.lock
		Application(sn&"VisiteCount")=Application(sn&"VisiteCount")
		Application.unlock
	End If 
	GetVisiteTotalCache=Application(sn&"VisiteCount")
End Function
'*******************
'注册用户数量缓存
'参数:无
'********************
Public Function GetUserTotalCache()
	If IsCache("Usertotal")=False Then
		Application.lock
		Application(sn&"Usertotal")=Conn.execute("select count(*) from Ex_user")(0)
		Application.unlock
	End If 
	GetUSERTotalCache=Application(sn&"Usertotal")
End Function
'********************
'清除缓存
'参数:MyCaheName-缓存名称
'*******************
Public Sub ClearCache(MyCaheName)
	Application.Lock
	Application.Contents.Remove(MyCaheName)
	Application.unLock
End Sub
'*********************
'取得缓存列表 
'参数 PreCacheName-前段匹配
'*********************
Public Function GetCacheList(PreCacheName)
	Dim Cacheobj
	For Each Cacheobj in Application.Contents
		If CStr(Left(Cacheobj,Len(PreCacheName)))=CStr(PreCacheName) Then
			GetCacheList=GetCacheList&Cacheobj&","
		End if
	Next
End Function
'*******************
'不提示,批量清除缓存
'参数 PreCacheName-前段匹配
'******************
Public Sub ClearCaches(PreCacheName)
	Dim i
	Dim CacheList
	CacheList=split(GetCacheList(PreCacheName),",")
	If UBound(CacheList)>1 Then
		For i=0 to UBound(CacheList)-1
			ClearCache CacheList(i)
		Next
	End IF
End Sub
'*******************
'判断缓存是否存在
'参数 CacheName-不带前导的缓存名
'******************
Public  Function IsCache(CacheName)
	If Application(sn&CacheName)="" Or IsEmpty(Application(sn&CacheName)) Or IsNull(Application(sn&CacheName)) Then
		IsCache=CBool("false")
	Else
		IsCache=CBool("true")
	End if
End Function 
'****************************系统缓存部分结束**************************
end class
%>