<!--#include file="functions_md5.asp"-->
<%
'*************************************************************************
'**模 块 名：SiteFunctions->[jins/root/inc/class_functions.asp]
'**说    明：知诸网络::网聚购物系统::[dushdown(尘埃落地)] 版权所有2006 - 2007(C)
'**创 建 人：李蒙
'**日    期：2006-01-12 21:07:12
'**修 改 人：
'**日    期：
'**描    述：网站常用函数类
'**版    本：V1.04
'*************************************************************************
CLASS SiteFunctions
	Dim rs
	dim url_request
	dim file_request
	
	Private Sub Class_Initialize()
	    url_request = request.servervariables("QUERY_STRING")
	    file_request = request.servervariables("PATH_INFO")
	    if file_request<>"" then file_request=split(file_request,"/")(ubound(split(file_request,"/")))
		
		Set rs = server.CreateObject("adodb.recordset")
	End Sub
	
	Private Sub Class_Terminate() 
		set rs=nothing
	end sub

	'--------------------------------------------------------------------------------------分页函数::[thing_list(ar)]
	Function thing_list(ar)
	
		Dim num_pages, num_show, num_pepage, num_page, select_c, content_show, rs_list,n_id,ids, a(100), char_qu(100), error_show(100)
		num_pepage = ar(0)
		num_page = ar(1)
		select_c = ar(2)
		content_order = ar(3)
		content_h = ar(4)
		content_show = ar(5)
	    if ubound(ar)>5 then n_id=ar(6)
	
		'ar(5)="%\>"
		'response.write ar(5)&"hjhjh"&InStr(1,ar(5),"%\>")
		'response.end
		If select_c = "" Then
			response.write "<br><center>对不起，你所搜索的范围内暂时没有相关信息！！</center><br>"
			Exit Function
		End If
	
		Set rs_list = server.CreateObject("adodb.recordset")
		'response.write "dfdF"&select_c
		'response.flush
		rs_list.open select_c, conn, 1, 1
		num_all = rs_list.recordcount
		If num_all Mod num_pepage = 0 Then
			num_pages = num_all \ num_pepage
		Else
			num_pages = num_all \ num_pepage + 1
		End If
		
		if num_page>num_pages then num_page=1
		
		If Not rs_list.EOF Then
			rs_list.Move num_pepage * (num_page - 1)
		Else
			response.write "<br><center>对不起，你所搜索的范围内暂时没有相关信息！！</center><br>"
			Exit Function
		End If
		a_ = Split(content_show, "$$", -1, 1)
		n_a = UBound(a_)
		For num_a = 0 To n_a
			d = Split(a_(num_a), ",", -1, 1)
			n_d = UBound(d)
			a(num_a) = d(0)
			If n_d >= 1 Then char_qu(num_a) = d(1)
			If n_d >= 2 Then error_show(num_a) = Trim(d(2))
		Next
		'//////////排序栏
		If content_order <> "" Then
			url_request = Replace(url_request, "&n_page=" & request("n_page"), "")
			content_order = Split(content_order, ",")
			url_request=replace(url_request,"&order_name="&request("order_name"),"")
			url_request=replace(url_request,"order_name="&request("order_name"),"")
			url_request=replace(url_request,"&order_action="&request("order_action"),"")
			url_request=replace(url_request,"order_action="&request("order_action"),"")
			response.write "<form name=orderform action='' name=form1 method=post>"
			response.write " <table align=center cellpadding='0' cellspacing='0' width='98%' height='20'style='border: 1px solid #E3E3E3;'>"
			response.write " <tr>"
			response.write "     <td height='30' width='20%'align=left style='padding-left:5px'>·您可以对结果进行排序 >> 按 "
	
			'----排序属性
			content_order(0) = Split(content_order(0), "|")
			response.write "<select name=order_name>"
			For i = 0 To UBound(content_order(0))
				content_order(0)(i) = Split(content_order(0)(i), "$")
				response.write "<option value=" & content_order(0)(i)(1) & " "
				If i = 0 Then
					If Session("FB_EM_1_ACC_search_order_name") = "" Or Session("FB_EM_1_ACC_search_order_name") = content_order(0)(i)(1) Then response.write "selected"
				Else
					If Session("FB_EM_1_ACC_search_order_name") = content_order(0)(i)(1) Then response.write "selected"
				End If
				response.write ">" & content_order(0)(i)(0) & "</option>"
			Next
	
			response.write "</select>  的  "
	
			'----排序方式
			content_order(1) = Split(content_order(1), "|")
			response.write "<select name=order_action>"
			For i = 0 To UBound(content_order(1))
				content_order(1)(i) = Split(content_order(1)(i), "$")
				response.write "<option value='" & content_order(1)(i)(1) & "' "
				If Session("FB_EM_1_ACC_search_order_action") = content_order(1)(i)(1) Then response.write "selected"
				response.write ">" & content_order(1)(i)(0) & "</option>"
			Next
			response.write "</select>  排列  "
			'----
			response.write "<input type=button onclick='document.orderform.action="""&file_request&"?"&url_request&"""+""&order_name=""+orderform.order_name.value+""&order_action=""+orderform.order_action.value;document.orderform.submit();'  value=开始排列 >"
			'response.write "<input type=submit  value=开始排列 >"
			response.write "</td>"
			response.write " </tr>"
			response.write "</table></form>"
		End If
		'//////////表格头栏
		response.write content_h
	
		For num_show = 1 To num_pepage
			If Not rs_list.EOF Then
				if n_id<>"" then ids=ids&rs_list(n_id)&","
				content_show_list = content_show
				content_show_list=replace(content_show_list,"$num$",num_show-1)
				If n_a Mod 2 = 0 Then n_a = n_a - 1 Else n_a = n_a
				For num_a = 1 To n_a
				
					if instr(1,a_(num_a),"*")>0 then '删除所有html标记
						
						a(num_a)=replace(a(num_a),"*","")
						If rs_list(a(num_a)) <> "" Then
							content_show_list = Replace(content_show_list, "$$" & a_(num_a) & "$$", SafeCode(cuthtml(Trim(rs_list(a(num_a))),char_qu(num_a)),0))
						Else
							If error_show(num_a) <> "" Then
								content_show_list = Replace(content_show_list, "$$" & a_(num_a) & "$$", error_show(num_a))
							Else
								content_show_list = Replace(content_show_list, "$$" & a_(num_a) & "$$", "")
							End If
						End If
						
					else
						If rs_list(a(num_a)) <> "" Then
							If char_qu(num_a) <> "" Then
								content_show_list = Replace(content_show_list, "$$" & a_(num_a) & "$$", Left(SafeCode(Trim(rs_list(a(num_a))),0), char_qu(num_a)))
							Else
								content_show_list = Replace(content_show_list, "$$" & a_(num_a) & "$$", SafeCode(Trim(rs_list(a(num_a))),0))
							End If
						Else
							If error_show(num_a) <> "" Then
								content_show_list = Replace(content_show_list, "$$" & a_(num_a) & "$$", error_show(num_a))
							Else
								content_show_list = Replace(content_show_list, "$$" & a_(num_a) & "$$", "")
							End If
						End If
					end if
					num_a = num_a + 1
				Next

				ExecuteCode(content_show_list)
				rs_list.movenext
			Else
				Exit For
			End If
		Next
		if ids<>"" then
		ids=left(ids,len(ids)-1)
		response.write "<input name=ids_list value='"&ids&"' type=hidden>"
		end if
		rs_list.Close
		Set rs_list = Nothing
		thing_list = num_pages
		num_pepage = ""
		num_page = ""
		select_c = ""
		content_show = ""
		content_show_list = ""
	End Function
	'--------------------------------------------------------------------------------------包含函数::[include(filename)]
	Function EncodeMd5(str,bit)
	EncodeMd5=Md5(str,bit)
	End Function
	'--------------------------------------------------------------------------------------包含函数::[include(filename)]
	Function include(filename)
		Dim re, content, fso, f, aspStart, aspEnd
		Set fso = CreateObject("Scripting.FileSystemObject")
		if not fso.FileExists(server.mappath(filename)) then
		response.write "["&filename&"]文件缺失！"
		exit function
		end if
		Set f = fso.OpenTextFile(server.mappath(filename))
		content = f.ReadAll
		f.Close
		Set f = Nothing
		Set fso = Nothing
		Set re = New RegExp
		re.Pattern = "^\s*="
		aspEnd = 1
		aspStart = InStr(aspEnd, content, "<%") + 2
		Do While aspStart > aspEnd + 1
			Response.write Mid(content, aspEnd, aspStart - aspEnd - 2)
			aspEnd = InStr(aspStart, content, "%\>") + 2
			Execute (re.Replace(Mid(content, aspStart, aspEnd - aspStart - 2), "Response.Write "))
			aspStart = InStr(aspEnd, content, "<%") + 2
		Loop
		Response.write Mid(content, aspEnd)
		Set re = Nothing
	End Function
	'--------------------------------------------------------------------------------------发送邮件函数::[SendMail(topic,content)]
	Function ExecuteCode(c)
		Dim re,aspStart, aspEnd
		Set re = New RegExp
		re.Pattern = "^\s*="
		aspEnd = 1
		aspStart = InStr(aspEnd, c, "<%") + 2
		'response.flush
		Do While aspStart > aspEnd + 1
			Response.write Mid(c, aspEnd, aspStart - aspEnd - 2)
			aspEnd = InStr(aspStart, c, "%\>") + 2
			if aspEnd=2 then 
			   aspEnd = InStr(aspStart, c, "%\\>") + 4
			   Execute (re.Replace(Mid(c, aspStart, aspEnd - aspStart - 4), "Response.Write "))
			else
'response.write Mid(c, aspStart, aspEnd - aspStart - 2)
'response.flush
			   Execute (re.Replace(Mid(c, aspStart, aspEnd - aspStart - 2), "Response.Write "))
			end if
			aspStart = InStr(aspEnd, c, "<%") + 2
		Loop
		Response.write Mid(c, aspEnd)
		Set re = Nothing
	End Function
	'--------------------------------------------------------------------------------------发送邮件函数::[SendMail(topic,content)]
	Function SendMail(address, topic, content)
	
		Dim mail_address
		Dim mail_username
		Dim mail_userpass
		Dim mail_name
		Dim mail_send
		
		if not site.check.ObjCheck("JMail.Message") then
			SendMail = False
			Exit Function
		End If
		
		rs.Open "select * from jins_site_mail where mail_open=1 ", conn, 1, 1
	
		If rs.EOF or address=""  Then
		    rs.Close
			SendMail = False
			Exit Function
		End If
		
		if  topic<>"" then topic=topic else topic="来自"&site.info.sitename&"的邮件！"
						
		mail_address = rs("mail_address")
		mail_username = rs("mail_username")
		mail_userpassword = rs("mail_password")
		mail_name = rs("mail_name")
		mail_send = rs("mail_send")
	
		rs.Close
	
		'发送邮件
		Set jmail = Server.CreateObject("JMail.Message")
		jmail.Charset = "gb2312"
		jmail.ContentType = "text/html"
		jmail.From = mail_send
		jmail.silent = True
		jmail.Logging = True
		jmail.FromName = mail_name
		jmail.mailserverusername = mail_username
		jmail.mailserverpassword = mail_userpassword
		jmail.AddRecipient address
		jmail.body = content
		jmail.Subject = topic
	
		If Not jmail.Send(mail_address) Then
			SendMail = False
		Else
			SendMail = True
		End If
	
		Set jmail = Nothing
	
	End Function
	'--------------------------------------------------------------------------------------包含函数::[include(filename)]
	Function FormShow(cc, cname,cdefault) '0|cn|en|action|content
		Dim i
		dim c,name,default
		c=cc
		name=cname
		default=cdefault

		If c = "" Or name = "" Then Exit Function
	
		c = Split(c, "|")
	
		Select Case c(3)
	
		Case "1"
			response.write "<select  name="""&name&""" id="""&c(2)&""">"
			c(4) = Split(c(4), "&")
	
			If Default = "" Then
				response.write "<option value=" & c(4)(0) & " selected>" & c(4)(0) & "</option>"
		
				For i = 1 To UBound(c(4))
					response.write "<option value=" & c(4)(i) & " selected>" & c(4)(i) & "</option>"
				Next
			Else
				For i = 0 To UBound(c(4))
					If Default = c(4)(i) Then
						response.write "<option value=" & c(4)(i) & " selected>" & c(4)(i) & "</option>"
					Else
						response.write "<option value=" & c(4)(i) & " >" & c(4)(i) & "</option>"
					End If
				Next
			End If
	
			response.write "</select>"
	
		Case "2"
			'response.write "<input  name="""&name&"" type=""text"" id=""&c(2)&"">"
	
		Case "3"
			response.write "<input  name="""&name&""" type=""text"" id="""&c(2)&""" value='"&default&"'>"
	
		Case "4"
			'response.write "<input  name="""&reg_property(i_r)(2)&"" type=""text"" id=""&reg_property(i_r)(2)&"">"
	
		Case "5"
			'response.write "<input  name="""&reg_property(i_r)(2)&"" type=""text"" id=""&reg_property(i_r)(2)&"">"
	
		End Select
	End Function
	'--------------------------------------------------------------------------------------替换函数::[include(filename)]
	function ReplaceString(c,rs)
	dim a_
	dim n_a
	dim num_a
	dim a(100)
	dim n_d
	dim d,char_qu(100),error_show(100),content_show_list
	dim rs_list
	'dim c
	
	'c=cc
	rs_list=rs
	'set rs=nothing
	
	a_ = Split(c, "$$", -1, 1)
	n_a = UBound(a_)
	For num_a = 0 To n_a
		d = Split(a_(num_a), ",", -1, 1)
		n_d = UBound(d)
		a(num_a) = d(0)
		If n_d >= 1 Then char_qu(num_a) = d(1)
		If n_d >= 2 Then error_show(num_a) = Trim(d(2))
	Next
	
	If n_a Mod 2 = 0 Then n_a = n_a - 1 Else n_a = n_a
	For num_a = 1 To n_a+1
		'if isnull(c) or isnull(a_(num_a)) then exit for
		
		'response.Write a(num_a) 
		'response.Flush()
		If isnull(rs_list(a(num_a)))=false Then
			If char_qu(num_a) <> "" Then
				If isnull(rs_list(a(num_a)))=false Then c = Replace(c, "$$" & a_(num_a) & "$$", Left(Trim(rs_list(a(num_a))), char_qu(num_a)))
			Else
				If isnull(rs_list(a(num_a)))=false Then c = Replace(c, "$$" & a_(num_a) & "$$", Trim(rs_list(a(num_a))))
			End If
		Else
			If error_show(num_a) <> "" Then
				c = Replace(c, "$$" & a_(num_a) & "$$", error_show(num_a))
			Else
				c = Replace(c, "$$" & a_(num_a) & "$$", "")
			End If
		End If
		'response.write a(num_a)&"|"&rs_list(a(num_a))&";"
		num_a = num_a + 1
	Next
	ReplaceString=c
	set rs_list=nothing

end function

function ListDate(date_s,date_e,n) '年月日select

	dim i
	
	if n="" then n="year"
	
	select case n
	case"year"
		if date_s="" then date_s=1900
		if date_e="" then date_e=year(now())
	
	case"month"
		if date_s="" then date_s=1
		if date_e="" then date_e=12
	
	case"day"
		if date_s="" then date_s=1
		if date_e="" then date_e=30
	
	end select
	
	if date_s<>"" and date_e<>"" then
	
		for i=date_s to date_e
		response.write "<option value='"&i&"' >"&i&"</option>"
		next
	
	end if

end function

Function CutHtml(str,l) '去掉所有HTML标记
	Dim re 
	Set re=new RegExp 
	re.IgnoreCase =True 
	re.Global=true 
	re.Pattern="<([^<>]*?)>" 

	Do while re.Test(str) 
		str=re.Replace(str,"") 
	Loop 
	set re=Nothing 

	CutHtml=str
	CutHtml=Replace(CutHtml,chr(10),"") 
	CutHtml=Replace(CutHtml,chr(13),"") 
	if l="" then l=len(str)
	CutHtml=left(CutHtml,l)

End Function

function FormatMoney(str)

	if str="" then 
		FormatMoney=0
		exit function
	end if
	
	if str-int(str)>0 then FormatMoney=formatnumber(str,2) else FormatMoney=formatnumber(str,0)

end function

function TransForm(c)

	TransForm=c
	if c="" or isnull(c) then exit function
	
	TransForm=replace(TransForm,"<","&lt;")
	TransForm=replace(TransForm,">","&gt;")

end function

function SafeCode(s,n)

	dim str
	
	if s<>"" then 
		str=s
	else
		SafeCode=""
		exit function
	end if
	if n="" then n=0
	
	if n=0 then 
		str=replace(str,"<","&lt;")
		str=replace(str,">","&gt;")
	else
		str=replace(str,"<%","&lt;%")
		str=replace(str,"%/>","%&gt;")
		str=replace(str,"<script","&lt;script",1,-1,1)
		str=replace(str,"</script","&lt;/script",1,-1,1)
	end if
	
	SafeCode=str

end function

function executer(c)

	response.write c
	execute(c)
	response.end

end function


end class
%>