www.gusucode.com > QQ空间互踩联盟源码程序asp编程 > class.asp

    <%

class cls_qzonev_com
	Public BaseUrl
	Public WebName,WebUrl,SysName,SysNameE,SysVersion,ip
	Public rs
	Private Sub Class_Initialize()
		WebName="一起踩QQ联盟"
		WebUrl="http://www.17caiqq.cn"
		SysName="一起踩QQ联盟"		
		SysNameE="一起踩QQ联盟"
		SysVersion="V2.2"
		BaseUrl = LCase(Replace(Request.ServerVariables("SERVER_NAME") & Request.ServerVariables("URL"),Split(request.ServerVariables("SCRIPT_NAME"),"/")(ubound(Split(request.ServerVariables("SCRIPT_NAME"),"/"))),""))
		ip=checkstr(request.ServerVariables("REMOTE_ADDR"),15)

		'初始化当天数据
		if application("CL_Date")<>Date() then
			init_data
		end if
	End Sub
	Private Sub class_terminate()
		If IsObject(Conn) Then 
			Conn.Close
			Set Conn = Nothing
		End If 
	End Sub

	Public Function Execute(Command)
		If Not IsObject(Conn) Then ConnectionDatabase	
		On Error Resume Next
		Set Execute = Conn.Execute(Command)
		If Err Then
			If IsDeBug = 1 Then
				Response.Write "你执行的语句是：" & Command
				Response.Write "<BR>错误信息为：" & Err.description
			Else
				Response.Write "查询数据的时候发现错误，请检查您的查询代码是否正确。"
			End If
			Err.Clear
			CloseDatabase
			Response.End
		End If	
	End Function

	Public Function Checkstr(Str,length)
		If Isnull(Str) Then
			CheckStr = ""
			Exit Function 
		End If
			CheckStr = trim(Replace(Str,"'","''"))
		if instr(Str,"%27") then
			CheckStr = trim(Replace(Str,"%27","''"))
		End if		
		if length>0 and strlength(CheckStr)>length then
				CheckStr=Strleft(CheckStr,length)
		End if
	End Function


	Public Function htmlencode2(str)
		htmlencode2=Server.Htmlencode(str)
		htmlencode2=replace(htmlencode2,chr(10),"&nbsp;")
		htmlencode2=replace(htmlencode2,chr(13),"&nbsp;")
		htmlencode2=replace(htmlencode2,chr(32),"&nbsp;")
	End Function
	
	Public Function Strlength(Str)
		dim Temp_Str,I,Test_Str
		Temp_Str=Len(Str)
		For I=1 To Temp_Str
			Test_Str=(Mid(Str,I,1))
			If Asc(Test_Str)>0 Then
				Strlength=Strlength+1
			Else
				Strlength=Strlength+2
			End If
		Next
	End Function
	
	Public Function Strleft(Str,L)
		dim Temp_Str,I,lens,Test_Str
		Temp_Str=Len(Str)
		For I=1 To Temp_Str
			Test_Str=(Mid(Str,I,1))
			Strleft=Strleft&Test_Str
			If Asc(Test_Str)>0 Then
				lens=lens+1
			Else
				lens=lens+2
			End If
				If lens>=L Then Exit For
		Next
	End Function

	Public Function isInteger(para)
		on error resume next
		dim str
		dim l,i
		if isNUll(para) then 
			isInteger=false
			exit function
		End if
		str=cstr(para)
		if trim(str)="" then
			isInteger=false
			exit function
		End if
		l=len(str)
		for i=1 to l
		if mid(str,i,1)>"9" or mid(str,i,1)<"0" then
			isInteger=false 
			exit function
			End if
		next
		isInteger=true
		if err.number<>0 then err.clear
	End Function

	Public Function showwebtype(id)
		dim rs
		set rs=execute("select name from Qzonev_Com_WebType where id="&id)
		if rs.eof then
			showwebtype="其它"
		else
			showwebtype=rs(0)
		End if
		set rs=nothing
	End Function

	Public Sub listwebtype(id)
	    response.write " <option  style=""color:#FF0033"""
		response.write ">"
		response.write "请选择所在地区"
		response.write "</option>"	    
		set rs=execute("select * from Qzonev_Com_WebType where cla > 100 and cla < 200 order by cla")
		do while not rs.eof
		response.write " <option value= " & rs("id")
		if int(rs("id"))=int(id) then response.write " selected"
		response.write ">"
		response.write rs("name")
		response.write "</option>"
		rs.movenext
		loop

	End Sub
	Public Sub ShowPageInfo(table,id,condition,PageNo,PageSize,LinkFile)
		dim strsql,TotalCount,TotalPageCount,OutStr
		strsql="SELECT count("&id&") FROM "&table&" "&condition&""
		Set rs = Execute(strsql)
		TotalCount=rs(0)
		rs.Close
		Set rs=Nothing
	'如果记录数为0，那么退出
	If TotalCount=0 Then
	Exit Sub
	End If
	'得到总页数
	If (TotalCount mod PageSize)=0 Then
		TotalPageCount=TotalCount\PageSize
	Else
		TotalPageCount=(TotalCount\PageSize)+1
	End If
	'防止提交的page参数大于第二次提交的总页数
	if PageNo>TotalPageCount then 
		PageNo=TotalPageCount
	End if
		OutStr = OutStr & "<font color='#99FF00'>"&TotalCount&"</font>&nbsp;条记录"
		OutStr = OutStr & "&nbsp;第<font color='#99FF00'>&nbsp;"&PageNo&"&nbsp;</font>页&nbsp;/&nbsp;共<font color='#99FF00'>&nbsp;"&TotalPageCount&"&nbsp;</font>页&nbsp;"
	If PageNo>1 Then
			OutStr = OutStr & "<a Href='?"&LinkFile&"&PageNo=1'>首页</a>&nbsp;"
		OutStr = OutStr & "<a Href='?"&LinkFile&"&PageNo="&PageNo-1&"'>上一页</a>&nbsp;"
	End If
	If PageNo<TotalPageCount Then
		OutStr = OutStr & "<a Href='?"&LinkFile&"&PageNo="&PageNo+1&"'>下一页</a>"
		OutStr = OutStr & "&nbsp;<a Href='?"&LinkFile&"&PageNo="&TotalPageCount&"'>尾页</a>"
	End If
		'OutStr = OutStr & "</P>"
		Response.Write(OutStr)
	End Sub
	
		Public Sub ShowPageInfo1(table,id,condition,PageNo,PageSize,LinkFile)
		dim strsql,TotalCount,TotalPageCount,OutStr
		strsql="SELECT count("&id&") FROM "&table&" "&condition&""
		Set rs = Execute(strsql)
		TotalCount=rs(0)
		rs.Close
		Set rs=Nothing
	'如果记录数为0，那么退出
	If TotalCount=0 Then
	Exit Sub
	End If
	'得到总页数
		OutStr = OutStr & ""&TotalCount&""
		'OutStr = OutStr & "</P>"
		Response.Write("<font color=""99FF00"">"&OutStr&"</font>")
	End Sub

	Public Sub ShowFooter()
		dim OutStr,username
		OutStr = OutStr & "<a href='http://qzone.ikoo8.cn/buyprocedures.asp' target='_blank'><u>Qzone"&"人气联盟 "&SysVersion&"</u></a>"			
		Response.Write(OutStr)
	End Sub
	
	Public Sub write_log(num)
		Execute("insert into Qzonev_Com_Log (username,ip,inout) values('"&username&"','"&ip&"',"&num&")")
	End Sub
	
	Public Function isrec(num)
		dim rs,username
		set rs=execute("select top 1 dateandtime from Qzonev_Com_Log where ip='"&ip&"' and username='"&username&"' and inout="&num&" order by id desc")
		if rs.eof then
			Call write_log(num)
			isrec=false
		elseif DateDiff("h",rs(0),now())>HitsTime then
			Call write_log(num)
			isrec=false
		else
			isrec=true				
		end if
	End Function
	
	Public Sub init_data
		dim sql	
		set rs=Server.CreateObject("ADODB.RecordSet")
		sql="select outc,outj,fromdate,inc,inj,indate from Qzonev_Com_Link order by indate desc"
		rs.open sql,conn,1,2
		do while not rs.eof
If DateDiff("d",rs("indate"),Date())<>0 then                
rs("inj")=0
rs("outj")=0
End If
			rs.update
			rs.movenext
		loop
		rs.close
		set rs = nothing
		application("CL_Date")=date()
	End Sub

	'网站名称过滤参数V1.85新加 09fyb.cn 2008-6-13修改过
	'以下是严格判断
	Public Function blnfilter(str) 
		if FilterWordQq <> "" then
		dim arrfilter,j
		arrfilter = split(FilterWordQq,"|")
		for j = 0 to ubound(arrfilter)
		if StrComp(str,arrfilter(j),0) =0 then
			blnfilter = true
			Exit Function
		end if
		next
		end if
		blnfilter = false
	End Function


	Public Function blnfilter1(str) 
		if FilterWordText <> "" then
		dim arrfilter,j
		arrfilter = split(FilterWordText,"|")
		for j = 0 to ubound(arrfilter)
		if instr(str,arrfilter(j))>0 then
			blnfilter1 = true
			Exit Function
		end if
		next
		end if
		blnfilter1 = false
	End Function	
	
End class

Class Cls_Cache
	Rem ==================使用说明=================================================================================
	Rem = 本类模块是Qzonev根据动网先锋(作者：迷城浪子)的缓存类模块修改而成。                                      =
	Rem = CacheName 缓存组的总名称，缺省值为"hx",如果一个站点中有超过一个缓存组，则需要外部改变这个值。           =
	Rem = qzonev_com V1.85新增类									              =
	Rem ===========================================================================================================
	Public Reloadtime,CacheName
	Private LocalCacheName,CacheData,DelCount
	Private Sub Class_Initialize()
		Reloadtime=14400
		CacheName="hx"
	End Sub
	Private Sub SetCache(SetName,NewValue)
		Application.Lock
		Application(SetName) = NewValue
		Application.unLock
	End Sub 
	Private Sub makeEmpty(SetName)
		Application.Lock
		Application(SetName) = Empty
		Application.unLock
	End Sub 
	Public  Property Let Name(ByVal vNewValue)
		LocalCacheName=LCase(vNewValue)
	End Property
	Public  Property Let Value(ByVal vNewValue)
		If LocalCacheName<>"" Then 
			CacheData=Application(CacheName&"_"&LocalCacheName)
			If IsArray(CacheData)  Then
				CacheData(0)=vNewValue
				CacheData(1)=Now()
			Else
				ReDim CacheData(2)
				CacheData(0)=vNewValue
				CacheData(1)=Now()
			End If
			SetCache CacheName&"_"&LocalCacheName,CacheData
		Else
			Err.Raise vbObjectError + 1, "hxCacheServer", " please change the CacheName."
		End If		
	End Property
	Public Property Get Value()
		If LocalCacheName<>"" Then 
			CacheData=Application(CacheName&"_"&LocalCacheName)	
			If IsArray(CacheData) Then
				Value=CacheData(0)
			Else
				Err.Raise vbObjectError + 1, "hxCacheServer", " The CacheData Is Empty."
			End If
		Else
			Err.Raise vbObjectError + 1, "hxCacheServer", " please change the CacheName."
		End If
	End Property
	Public Function ObjIsEmpty()
		ObjIsEmpty=True
		CacheData=Application(CacheName&"_"&LocalCacheName)
		If Not IsArray(CacheData) Then Exit Function
		If Not IsDate(CacheData(1)) Then Exit Function
		If DateDiff("s",CDate(CacheData(1)),Now()) < 60*Reloadtime  Then
			ObjIsEmpty=False
		End If
	End Function
	Public Sub DelCahe(MyCaheName)
		makeEmpty(CacheName&"_"&MyCaheName)
	End Sub

	
End Class
%>