<%
'-------------------------------------
'ߣAlex   ԣ  ϵQQ:383614311
'ܣQzoneư QQռ˳
'ʾhttp://www.xnqzone.cn/
'-------------------------------------
%>
<%

class cls_smt_cn
	Public BaseUrl
	Public WebName,WebUrl,SysName,SysNameE,SysVersion,ip
	Public rs
	Private Sub Class_Initialize()
		WebName="Qzoneư"
		WebUrl="/"
		SysName="Qzoneư"		
		SysNameE="www.samate.cn"
		SysVersion="V7.0"
		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 smt_cn_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 smt_cn_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
		OutStr = OutStr & "<a href='http://www.samat"&"e.Cn/buyprocedures.asp' target='_blank'><u>Qzone"&"ư "&SysVersion&"</u></a>"			
		Response.Write(OutStr)
	End Sub
	
	Public Sub write_log(num)
		Execute("insert into smt_cn_Log (smtuser,ip,inout) values('"&smtuser&"','"&ip&"',"&num&")")
	End Sub
	
	Public Function isrec(num)
		dim rs
		set rs=execute("select top 1 smtdateandtime from smt_cn_Log where ip='"&ip&"' and smtuser='"&smtuser&"' 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 smtoutc,smtoutj,smtfromdate,smtinc,smtinj,smtindate from smt_cn_Link order by smtindate desc"
		rs.open sql,conn,1,2
		do while not rs.eof
If DateDiff("d",rs("smtindate"),Date())<>0 then                
rs("smtinj")=0
rs("smtoutj")=0
End If
			rs.update
			rs.movenext
		loop
		rs.close
		set rs = nothing
		application("CL_Date")=date()
	End Sub

	'վƹ˲V7.0 Alex 2008-8-31޸Ĺ
	'ϸж
	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_ms
	Rem ==================ʹ˵=================================================================================
	Rem = ģsamate.cmݶȷ(ߣԳ)Ļģ޸Ķɡ                                   =
	Rem = CacheName ƣȱʡֵΪ"hx",һվгһ飬Ҫⲿıֵ           =
	Rem = samate_cn v7.0									              =
	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
%> 
<!--#include file="Sql.asp"-->