<%

'================================================
'名称：eRead
'作用：读取数据单个
'参数：eTable表,eItemID索引,fItem字段值
'================================================
Function eRead(eTable,eItemID,fItem)
Dim eRs,eSql
if fItem="" then fItem="ItemNote"
Set eRs=server.CreateObject("adodb.recordset")  
eSql="Select "&fItem&" From ["&Prefix&eTable&"] where ItemID="&eItemID
eRs.Open eSql,Conn,0,1  
  If (eRs.Eof and eRs.Bof) Then
  eRead = false
  Else
  eRead = Trim(eRs(0))
  End If  
eRs.Close
Set eRs=nothing
End Function
'================================================
Function eHit(eTable,eItemID)
conn.execute("Update ["&Prefix&eTable&"] set ItemHit=ItemHit+1 where ItemID="&eItemID)
End Function

'================================================
'读取分类 - 下级2级分类
'================================================
Function SortNext(fParentID)
Set xRs=Server.CreateObject("Adodb.RecordSet")
xRs.Open "Select * From ["&Prefix&eims&"Sort] Where ParentID="&int(fParentID)&" Order By SortSeq",Conn,1,1
Sort2=int(fParentID)
While Not xRs.Eof
Sort2=Sort2&","&Int(xRs("ItemID"))
xRs.MoveNext
wend
xRs.close
Set xRs = Nothing
SortNext=Sort2
End Function

'================================================
'读取分类 - 下级全部分类
'================================================
fSortAll="" '初始化
Function SortAll(fParentID)
if Not isNumeric(fParentID) then exit function
if fParentID="" then fParentID=0
if fSortAll="" then fSortAll=fParentID
	Set xRs=Server.CreateObject("Adodb.RecordSet")
	xRs.Open "Select * From ["&Prefix&eims&"Sort] Where ParentID="&fParentID&" Order By SortSeq",Conn,1,1
	if Not xRs.Eof then
	While Not xRs.Eof
	fParentID=fParentID&","&Int(xRs("ItemID"))
	SortAll(Int(xRs("ItemID")))
	xRs.MoveNext
	wend
	end if
	xRs.close
	Set xRs = Nothing	
fSortAll=fSortAll&","&fParentID
SortAll = ReArr(fSortAll,",") '去掉重复
End Function
fSortAll="" '初始化

'================================================
'自动生成编号
'================================================
function CreNo(xeims,xnum)
if xnum="" or xnum<2 then xnum=6
Set aRs = Conn.Execute("Select top 1 ItemID From ["&Prefix&xeims&"] order by ItemID desc")
eNo = aRs(0)+1
	If Len(eNo)<Int(xnum) Then
	    ez = ""
		For i = 1 to (xnum - Len(eNo))
		ez = ez&"0"
		Next
	eNo = ez&eNo
	End If	
CreNo = Replace(fDate(Date()),"-","")&"-"&eNo
End function

'================================================
'生成排序
'================================================
function CreSeq(xeims)
Set tRs = Conn.Execute("Select top 1 ItemID From ["&Prefix&xeims&"] order by ItemID desc")
CreSeq = tRs(0)+1
End function

'================================================
'日期转换
'================================================
Function fDate(sDate)
	fYear = Year(sDate)
	fMonth = Month(sDate)
	If fMonth < 10 Then fMonth = "0"&fMonth
	fDay = Day(sDate)
	If fDay < 10 Then fDay = "0"&fDay
	fDate = fYear&"-"&fMonth&"-"&fDay
End Function

'================================================
'名称：Userip
'作用：取得IP地址
'================================================
Function UserIP()
Dim GetClientIP
GetClientIP = Request.ServerVariables("HTTP_X_FORWARDED_FOR")
If GetClientIP = "" or isnull(GetClientIP) or isempty(GetClientIP) Then GetClientIP = Request.ServerVariables("REMOTE_ADDR")
UserIP = GetClientIP
End Function

'==================================================
'函数名：RemoveHTML
'作  用：完全去除html标记
'参  数：strHTML ------ 要过滤的字符串
'==================================================
Function RemoveHTML(strHTML) 
Dim objRegExp, Match, Matches 
Set objRegExp = New Regexp

objRegExp.IgnoreCase = True 
objRegExp.Global = True 
'取闭合的<> 
objRegExp.Pattern = "<.+?>" 
'进行匹配 
Set Matches = objRegExp.Execute(strHTML)

' 遍历匹配集合，并替换掉匹配的项目 
For Each Match in Matches 
strHtml=Replace(strHTML,Match.Value,"") 
Next 
RemoveHTML=strHTML 
Set objRegExp = Nothing 
End Function

Function UnHtml(str)
	str = Replace(str, "&", "&amp;")
	str = Replace(str, "<", "&lt;")
	str = Replace(str, ">", "&gt;")
	str = Replace(str, """", "&quot;")
	str = Replace(str, CHR(32), "&nbsp;")
	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), "</P><P>")
	str = Replace(str, CHR(10), "<br>")
	UnHtml = str
End Function
Function EnHtml(str)
	str = Replace(str, "&amp;", "&")
	str = Replace(str, "&lt;", "<")
	str = Replace(str, "&gt;", ">")
	str = Replace(str, "&quot;", """")
	str = Replace(str, "&nbsp;", CHR(32))
	str = Replace(str, "&nbsp;", CHR(9))
	str = Replace(str, "&quot;", CHR(34))
	str = Replace(str, "&#39;", CHR(39))
	str = Replace(str, "", CHR(13))
	str = Replace(str, "</P><P>", CHR(10) & CHR(10))
	str = Replace(str, "<br>", CHR(10))
	str = Replace(str, "&#160;&#160;&#160;&#160;", CHR(9))
	EnHtml = str
End Function

'---通用出错提示信息
Function WtMsg(Message)
Response.Write "<script language='javascript'>alert('"&Message&"');history.go(-1);</script>"
Response.End
End Function

'---出错提示信息重载页面
Function ReLoadMsg(Message)
fUrl=request.ServerVariables("URL")
Url1=Split(fUrl,"/") : Url2=Url1((ubound(Url1))) '获取当前URL
if Url2<>"" then
Response.Write "<script language='javascript'>alert('"&Message&"');window.location.href='"&Url2&"'</script>"
else
response.Write "System Err"
end if
Response.End
End Function

'================================================
'检测数组并去掉重复项
'================================================
function ReArr(Str,Spt)
if isarray(Str) then exit function
if Str="" or isempty(Str) then exit function
Arr = Split(Str,Spt)
Str2 = Arr(0)
for i=1 to ubound(Arr)
if instr(Str2,Arr(i))=0 then Str2 = Str2&Spt&Arr(i)
next
ReArr = Str2
end function
'================================================
'检测数组并去掉重复项
'================================================
function ReUrl()
UrlX="" : ReUrl="?"
Url1=request.QueryString
Url2=request.Form
Url3=Url1&"&"&Url2 '获取页面传递字符
if len(Url3)>3 then
UrlArr=Split(Url3,"&")
	for i=0 to ubound(UrlArr)
	if trim(UrlArr(i))<>"" then
	if instr(trim(UrlArr(i)),"page")=0 then '去掉页码参数
	Url4="" : Url4=split(trim(UrlArr(i)),"=")
	UrlX=UrlX&","&Url4(0) '获取传递参数
	end if
	end if
	next
UrlX=Right(UrlX,len(UrlX)-1)
UrlX=ReArr(UrlX,",") : UrlX=Split(UrlX,",") '参数重组分解
ReUrl=ReUrl&trim(UrlX(0))&"="&trim(request(trim(UrlX(0))))
    if ubound(UrlX)>0 then '获取具体参数与值
	for i=1 to ubound(UrlX)
	if trim(request(trim(UrlX(i))))<>"" then ReUrl=ReUrl&"&"&trim(UrlX(i))&"="&trim(request(trim(UrlX(i))))
	next
	end if
end if
if trim(ReUrl)="?" then ReUrl=ReUrl&"1=l"
end function

'禁止灌水
function FbitWt(n)
n=Int(n)
if Request.Cookies("WtID")="" then Response.Cookies("WtID")=session.sessionid
	if Request.Cookies("WtTime")="" then 
	Response.Cookies("WtTime")=now
	exit function '第一次留言不限制
	end if
WtID=Request.Cookies("WtID")
WtTime=formatDatetime(Request.Cookies("WtTime"))
if Int(left(WtID,3))>0 then
	if datediff("n",WtTime,now)<n then
	WtMsg(n&"分钟内不能连续留言")
	else
	Response.Cookies("WtTime")=now 'Response.Cookies("WtTime").Expires=now-1	
	end if
end if
end function

%>