<!--#include file="conn.asp" --> 

<%
Function GetClassName(CollectClass)'取分类名
	GetClassName=Eval(CollectClass)
End Function


Function MovieRegion(MovieRegionName,MovieRegionID)'显示地区列表
    dim bid,eid,j
	bid=split(AdminId,",")
	eid=ubound(bid)
    Response.Write"<select name='"&MovieRegionName&"' id='"&MovieRegionName&"'>"
	For j=0 to eid%>
	<option value="<%= bid(j) %>" <%if bid(j)=MovieRegionID then Response.Write("selected")%>><%= bid(j) %></option>
    <%
	Next
    Response.Write"</select>"
End Function

Function ClassTypeId(CollectTypeName)'转化分类
dim TypeRS
	Set TypeRS = Server.CreateObject(recordsStr)
	TypeRS.Open ("Select ClassId,ClassType From [Collect_ClassId] where ClassType='"&CollectTypeName&"'"), Connc, 1, 1
	If Not TypeRS.eof Then
	    ClassTypeId=TypeRS("ClassId")
	Else
	    ClassTypeId=0
	End If
	TypeRS.Close
	Set TypeRS = Nothing
End Function

Function EreaTypeId(CollectRegionName)'转化地区
dim RegionRS
	Set RegionRS = Server.CreateObject(recordsStr)
	RegionRS.Open ("Select EreaType,Ereaid From [Collect_EreaId] where EreaType='"&CollectRegionName&"'"), Connc, 1, 1
	if not RegionRS.eof then
	EreaTypeId=RegionRS("Ereaid")
	end if
	RegionRS.Close
	Set RegionRS = Nothing
End Function

Function Get_ClassCN(CollectClass)
    dim rs,sql
	set rs=server.createobject("adodb.recordset")
	sql="select t_name From tbl_type where t_id="&cint(CollectClass)
	rs.open sql,conn,1,3
	IF Not(Rs.Bof And Rs.Eof) Then
	response.write(""&RS("t_name")&"")
	Else
	response.write("<font color=red >没找到对应分类,请编辑。</font>")
	End IF
	RS.Close
	Set RS=Nothing
End Function

Function maxClassCN(CollectClass1)
	dim rs,sql
	sql="select t_name From tbl_type where t_id="&cint(CollectClass1)
	set rs = Database.GetRecordBySQL(sql)
	IF Not(Rs.Bof And Rs.Eof) Then 
	response.write(""&RS("t_name")&"")
	Else
	response.write("<font color=red >自定义分类</font>")
	End IF
	RS.Close
	Set RS=Nothing
End Function

Function isNul(str)
	if isnull(str) or str = ""  then isNul = true else isNul = false 
End Function

Sub die(str)
	if not isNul(str) then
		echo str
	end if	 
	response.End()
End Sub

Sub echo(str)
	response.write(str)
	response.Flush()
End Sub

Function Get_ClassCN1(ClassID)
	dim rs,sql
	sql="select t_name From tbl_type where t_id="&cint(ClassID)
	set rs = Database.GetRecordBySQL(sql)
	IF Not(Rs.Bof And Rs.Eof) Then
	response.write(""&RS("t_name")&"")
	Else
	response.write("<font color=red >没找到对应分类,导入此规则后请编辑</font>")
	End IF
	RS.Close
	Set RS=Nothing
End Function

function JoinChar(strUrl)
	if strUrl="" then
		JoinChar=""
		exit function
	end if
	if InStr(strUrl,"?")<len(strUrl) then 
		if InStr(strUrl,"?")>1 then
			if InStr(strUrl,"&")<len(strUrl) then 
				JoinChar=strUrl & "&"
			else
				JoinChar=strUrl
			end if
		else
			JoinChar=strUrl & "?"
		end if
	else
		JoinChar=strUrl
	end if
end function 

function ShowPage(sFileName,CurrentPage,TotalNumber,MaxPerPage,ShowTotal,ShowAllPages,strUnit)
	dim TotalPage,strTemp,strUrl,i
	if TotalNumber=0 or MaxPerPage=0 or isNull(MaxPerPage) then
		ShowPage=""
		exit function
	end if
	if totalnumber mod maxperpage=0 then
	 	TotalPage= totalnumber \ maxperpage
  	else
	 	TotalPage= totalnumber \ maxperpage+1
  	end if
	if CurrentPage>TotalPage then CurrentPage=TotalPage
  	strTemp= "<table align='center'><tr><td>"
	if ShowTotal=true then 
		strTemp=strTemp & "共 <b>" & totalnumber & "</b> " & strUnit & "&nbsp;&nbsp;"
	end if
	strUrl=JoinChar(sfilename)
  	if CurrentPage<2 then
	 	strTemp=strTemp & "首页 上一页&nbsp;"
  	else
	 	strTemp=strTemp & "<a href='" & strUrl & "page=1'>首页</a>&nbsp;"
	 	strTemp=strTemp & "<a href='" & strUrl & "page=" & (CurrentPage-1) & "'>上一页</a>&nbsp;"
  	end if

  	if CurrentPage>=TotalPage then
	 	strTemp=strTemp & "下一页 尾页"
  	else
	 	strTemp=strTemp & "<a href='" & strUrl & "page=" & (CurrentPage+1) & "'>下一页</a>&nbsp;"
	 	strTemp=strTemp & "<a href='" & strUrl & "page=" & TotalPage & "'>尾页</a>"
  	end if
		strTemp=strTemp & "&nbsp;页次：<strong><font color=red>" & CurrentPage & "</font>/" & TotalPage & "</strong>页 "
		  strTemp=strTemp & "&nbsp;<b>" & maxperpage & "</b>" & strUnit & "/页"
	if ShowAllPages=True then
		strTemp=strTemp & "&nbsp;&nbsp;转到第<input class='form' type='text' name='page' size='3' maxlength='5' value='" & CurrentPage & "' onKeyPress=""if (event.keyCode==13) window.location='" & strUrl & "page=" & "'+this.value;""'>页"
	end if
	strTemp=strTemp & "</td></tr></table>"
	ShowPage=strTemp
end function


Function GetHttpPage(HttpUrl,Cset)
	
	Dim Http
	Set Http=server.createobject(getXmlHttpVer())
	Http.open "GET",HttpUrl,False
	Http.Send()
	
	If Http.Readystate<>4 then
		Http.close
		Set Http=Nothing 
		GetHttpPage=False
		Exit function
	End if
	
	GetHttpPage=bytesToBSTR(Http.responseBody,Cset)
	Set Http=Nothing

End Function

Function BytesToBstr(Body,Cset)
	Dim Objstream
	Set Objstream = Server.CreateObject("adodb.stream")
	objstream.Type = 1
	objstream.Mode =3
	objstream.Open
	objstream.Write body
	objstream.Position = 0
	objstream.Type = 2
	objstream.Charset = Cset
	BytesToBstr = objstream.ReadText 
	objstream.Close
	set objstream = nothing
End Function

Function GetBody(ConStr,StartStr,OverStr)
	on error resume next
	   If ConStr=False or ConStr="" or IsNull(ConStr)=True Or StartStr="" or IsNull(StartStr)=True Or OverStr="" or IsNull(OverStr)=True Then
		  GetBody=False
	   Exit Function
	   End If
	   Dim ConStrTemp
	   Dim Start,Over
	   ConStrTemp=Lcase(ConStr)
	   StartStr=Lcase(StartStr)
	   OverStr=Lcase(OverStr)
	   Start = InStrB(1, ConStrTemp, StartStr, vbBinaryCompare)
	   If Start<=0 then
		  GetBody=False
		  Exit Function
	   Else
			 Start=Start+LenB(StartStr)
	   End If
	   Over=InStrB(Start,ConStrTemp,OverStr,vbBinaryCompare)
	   GetBody=MidB(ConStr,Start,Over-Start)
End Function

Function GetArray(Byval ConStr,StartStr,OverStr)
	on error resume next
	If ConStr=False or ConStr="" Or IsNull(ConStr)=True or StartStr="" Or OverStr="" or IsNull(StartStr)=True Or IsNull(OverStr)=True Then
	GetArray=False
	Exit Function
	End If
	Dim TempStr,TempStr2,objRegExp,Matches,Match
	TempStr=""
	Set objRegExp = New Regexp 
	objRegExp.IgnoreCase = True 
	objRegExp.Global = True
	objRegExp.Pattern = "("&StartStr&").+?("&OverStr&")"
	Set Matches =objRegExp.Execute(ConStr) 
	For Each Match in Matches
	TempStr=TempStr & "$Array$" & Match.Value
	Next 
	Set Matches=nothing
	If TempStr="" Then
	GetArray=False
	Exit Function
	End If
	TempStr=Right(TempStr,Len(TempStr)-7)
	objRegExp.Pattern =StartStr
	TempStr=objRegExp.Replace(TempStr,"")
	objRegExp.Pattern =OverStr
	TempStr=objRegExp.Replace(TempStr,"")
	Set objRegExp=nothing
	TempStr=Replace(TempStr,"""","")
	TempStr=Replace(TempStr,"'","")
	TempStr=Replace(TempStr," ","")
	If TempStr="" then
	GetArray=False
	Else
	GetArray=TempStr
	End if
End Function

Function DefiniteUrl(Byval PrimitiveUrl,Byval ConsultUrl)
	Dim ConTemp,PriTemp,Pi,Ci,PriArray,ConArray
	If PrimitiveUrl="" or ConsultUrl="" or PrimitiveUrl="$False$" or ConsultUrl="$False$" Then
	DefiniteUrl=False
	Exit Function
	End If
	If Left(Lcase(ConsultUrl),7)<>"http://" Then
	ConsultUrl= "http://" & ConsultUrl
	End If
	ConsultUrl=Replace(ConsultUrl,"\","/")
	ConsultUrl=Replace(ConsultUrl,"://",":\\")
	PrimitiveUrl=Replace(PrimitiveUrl,"\","/")
	If Right(ConsultUrl,1)<>"/" Then
	If Instr(ConsultUrl,"/")>0 Then
	If Instr(Right(ConsultUrl,Len(ConsultUrl)-InstrRev(ConsultUrl,"/")),".")>0 then 
	Else
	ConsultUrl=ConsultUrl & "/"
	End If
	Else
	ConsultUrl=ConsultUrl & "/"
	End If
	End If
	ConArray=Split(ConsultUrl,"/")
	If Left(LCase(PrimitiveUrl),7) = "http://" then
	DefiniteUrl=Replace(PrimitiveUrl,"://",":\\")
	ElseIf Left(PrimitiveUrl,1) = "/" Then
	DefiniteUrl=ConArray(0) & PrimitiveUrl
	ElseIf Left(PrimitiveUrl,2)="./" Then
	PrimitiveUrl=Right(PrimitiveUrl,Len(PrimitiveUrl)-2)
	If Right(ConsultUrl,1)="/" Then 
	DefiniteUrl=ConsultUrl & PrimitiveUrl
	Else
	DefiniteUrl=Left(ConsultUrl,InstrRev(ConsultUrl,"/")) & PrimitiveUrl
	End If
	ElseIf Left(PrimitiveUrl,3)="../" then
	Do While Left(PrimitiveUrl,3)="../"
	PrimitiveUrl=Right(PrimitiveUrl,Len(PrimitiveUrl)-3)
	Pi=Pi+1
	Loop 
	For Ci=0 to (Ubound(ConArray)-1-Pi)
	If DefiniteUrl<>"" Then
	DefiniteUrl=DefiniteUrl & "/" & ConArray(Ci)
	Else
	DefiniteUrl=ConArray(Ci)
	End If
	Next
	DefiniteUrl=DefiniteUrl & "/" & PrimitiveUrl
	Else
	If Instr(PrimitiveUrl,"/")>0 Then
	PriArray=Split(PrimitiveUrl,"/")
	If Instr(PriArray(0),".")>0 Then
	If Right(PrimitiveUrl,1)="/" Then
	DefiniteUrl="http:\\" & PrimitiveUrl
	Else
	If Instr(PriArray(Ubound(PriArray)-1),".")>0 Then 
	DefiniteUrl="http:\\" & PrimitiveUrl
	Else
	DefiniteUrl="http:\\" & PrimitiveUrl & "/"
	End If
	End If 
	Else
	If Right(ConsultUrl,1)="/" Then 
	DefiniteUrl=ConsultUrl & PrimitiveUrl
	Else
	DefiniteUrl=Left(ConsultUrl,InstrRev(ConsultUrl,"/")) & PrimitiveUrl
	End If
	End If
	Else
	If Instr(PrimitiveUrl,".")>0 Then
	If Right(ConsultUrl,1)="/" Then
	If right(LCase(PrimitiveUrl),3)=".cn" or right(LCase(PrimitiveUrl),3)="com" or right(LCase(PrimitiveUrl),3)="net" or right(LCase(PrimitiveUrl),3)="org" Then
	DefiniteUrl="http:\\" & PrimitiveUrl & "/"
	Else
	DefiniteUrl=ConsultUrl & PrimitiveUrl
	End If
	Else
	If right(LCase(PrimitiveUrl),3)=".cn" or right(LCase(PrimitiveUrl),3)="com" or right(LCase(PrimitiveUrl),3)="net" or right(LCase(PrimitiveUrl),3)="org" Then
	DefiniteUrl="http:\\" & PrimitiveUrl & "/"
	Else
	DefiniteUrl=Left(ConsultUrl,InstrRev(ConsultUrl,"/")) & "/" & PrimitiveUrl
	End If
	End If
	Else
	If Right(ConsultUrl,1)="/" Then
	DefiniteUrl=ConsultUrl & PrimitiveUrl & "/"
	Else
	DefiniteUrl=Left(ConsultUrl,InstrRev(ConsultUrl,"/")) & "/" & PrimitiveUrl & "/"
	End If 
	End If
	End If
	End If
	If Left(DefiniteUrl,1)="/" then
	DefiniteUrl=Right(DefiniteUrl,Len(DefiniteUrl)-1)
	End if
	If DefiniteUrl<>"" Then
	DefiniteUrl=Replace(DefiniteUrl,"//","/")
	DefiniteUrl=Replace(DefiniteUrl,":\\","://")
	Else
	DefiniteUrl=False
	End If
End Function

function getHTTPimg(url,TistUrlx)
	'on error resume next
	dim http,geturl,objStream,urlx
	urlx=DefiniteUrl(url,TistUrlx)
	if SaveFiles = 1 then
	ArrSaveFileName = Split(url,".")
		 strFileType=Lcase(ArrSaveFileName(Ubound(ArrSaveFileName)))
	RanNum=Int(900*Rnd)+100
		strFileName=year(now)&month(now)&day(now)&hour(now)&minute(now)&second(now)&ranNum & "." & strFileType
	set http=server.createobject(getXmlHttpVer())
		
	Http.open "GET",urlx,false
	Http.send()
	if Http.readystate<>4 then exit function
	getHTTPimg=Http.responseBody
	set http=nothing
	
	if err.number<>0 then err.Clear 
		Set objStream = Server.CreateObject("ADO"&"DB.Stream")
		objStream.Type =1
		objStream.Open
		objstream.write getHTTPimg
		objstream.SaveToFile server.MapPath(image_dir&strFileName),2
		objstream.Close()
		set objstream=nothing
		getHTTPimg=strFileName
	else
		getHTTPimg=urlx
	end if
    
end function

Function ScriptHtml(Byval ConStr,TagName,FType)
    Dim Re
    Set Re=new RegExp
    Re.IgnoreCase =true
    Re.Global=True
    Select Case FType
    Case 1
       Re.Pattern="<" & TagName & "([^>])*>"
       ConStr=Re.Replace(ConStr,"")
    Case 2
       Re.Pattern="<" & TagName & "([^>])*>.*?</" & TagName & "([^>])*>"
       ConStr=Re.Replace(ConStr,"") 
	Case 3
       Re.Pattern="<" & TagName & "([^>])*>"
       ConStr=Re.Replace(ConStr,"")
       Re.Pattern="</" & TagName & "([^>])*>"
       ConStr=Re.Replace(ConStr,"")
    End Select
    ScriptHtml=ConStr
    Set Re=Nothing
End Function

function nohtml(byval str)
	if isnull(str) or trim(str)="" then
		nohtml=""
		exit function
	end if
    dim re
    Set re=new RegExp
    re.IgnoreCase =true
    re.Global=True
    re.Pattern="(\<.[^\<]*\>)"
    str=re.replace(str,"")
    re.Pattern="(\<\/[^\<]*\>)"
    str=re.replace(str,"")
    set re=nothing
	str=replace(str,chr(34),"")
	str=replace(str,"'","")
    nohtml=str
end function

Function FpHtmlEnCode(fString)
   If IsNull(fString)=False or fString<>"" or fString<>False Then
   	   fString = Replace(fString," ","")
	   fString = Replace(fString,"&nbsp;"," ")
       fString = Replace(fString,"&nbsp;"," ")
       fString = Replace(fString,"&quot;","")
       fString = Replace(fString,"&#39;","")
       fString = replace(fString, ">", "")
       fString = replace(fString, "<", "")
       fString = Replace(fString, CHR(9), " ")
       fString = Replace(fString, CHR(10), "")
       fString = Replace(fString, CHR(13), "")
       fString = Replace(fString, CHR(34), "")
       fString = Replace(fString, CHR(32), " ")
       fString = Replace(fString, CHR(39), "")
       fString = Replace(fString, CHR(10) & CHR(10),"")
       fString = Replace(fString, CHR(10)&CHR(13), "")
       fString=Trim(fString)
       FpHtmlEnCode=fString
   Else
       FpHtmlEnCode=""
   End If
End Function

Function MakeRandom(ByVal maxLen)
  Dim strNewPass
  Dim whatsNext, upper, lower, intCounter
  Randomize
 For intCounter = 1 To maxLen
   upper = 57
   lower = 48
   strNewPass = strNewPass & Chr(Int((upper - lower + 1) * Rnd + lower))
 Next
   MakeRandom = strNewPass
End Function

Function Admin_ShowErr(ErrMsg,ErrorUrl,ErrType)
	dim ErrTitle,ErrLeft
	Select Case ErrType
	Case 0
	ErrTitle="操作失败"
	ErrLeft="×"
	Case 1
	ErrTitle="操作成功"
	ErrLeft="√"
	End Select
	Response.Write"<table width='100%'>" &vbcrlf
	Response.Write"<tr>" &vbcrlf 
	Response.Write"<td>" &vbcrlf
	Response.Write"<div class=""container"" id=""cpcontainer""><TABLE  class=""tb"">" &vbcrlf
	Response.Write"<TBODY>" &vbcrlf
	Response.Write"<TR class='thead'>" &vbcrlf
	Response.Write"<Th  colspan=3>"&ErrTitle&"</Th>" &vbcrlf
	Response.Write"</TR>" &vbcrlf
	Response.Write"<TR>" &vbcrlf
	Response.Write"<TD  width=""5%"" height=""10"" ><font style=""font-size:30px;color: #FF0000;""><strong>"&ErrLeft&"</strong></font></TD>" &vbcrlf
	Response.Write"<TD  align=""left"" height=""100"">"&ErrMsg&"<br><br><li><a href="&ErrorUrl&">返     回</a></li></TD>" &vbcrlf
	Response.Write"</TR>" &vbcrlf
	Response.Write"<TR>" &vbcrlf
	Response.Write"<TD  colSpan=3  colspan=2></TD>" &vbcrlf
	Response.Write"</TR>" &vbcrlf
	Response.Write"</TBODY>" &vbcrlf
	Response.Write"</TABLE></div>" &vbcrlf
	Response.Write"</td>" &vbcrlf
	Response.Write"</tr>" &vbcrlf
	Response.Write"</table>"
	response.end
End Function

Function NoSqlHack(inputStr)
	if inputStr="" then exit Function
	Dim f_NoSqlHack_AllStr,NoSqlHack_Str,NoSqlHack_i,Str_InputStr,NoSqlHack_AllStr
	Str_InputStr=inputStr
	NoSqlHack_AllStr="*|and |exec |insert |select |delete |update |count |master |truncate |declare |and	|exec	|insert	|select	|delete	|update	|count	|master	|truncate	|declare	|char(|mid(|chr(|and[|exec[|insert[|select[|delete[|update[|count[|master[|truncate[|declare[|set[|set |set	|where[|where |where	"
	NoSqlHack_Str = Split(NoSqlHack_AllStr,"|")
	For NoSqlHack_i=LBound(NoSqlHack_Str) To Ubound(NoSqlHack_Str)
		If Instr(LCase(Str_InputStr),NoSqlHack_Str(NoSqlHack_i))<>0 Then
			If NoSqlHack_Str(NoSqlHack_i)="'" Then NoSqlHack_Str(NoSqlHack_i)=" \' "
			Response.Write "<html><title>警告</title><body bgcolor=""EEEEEE"" leftmargin=""60"" topmargin=""30""><font style=""font-size:16px;font-weight:bolder;color:blue;""><li>您提交的数据有恶意字符</li></font><font style=""font-size:14px;font-weight:bolder;color:red;""><br><li>您的数据已经被记录!</li><br><li>您的IP："&Request.ServerVariables("Remote_Addr")&"</li><br><li>操作日期："&Now&"</li></font></body></html>"
			Response.End
		End if
	Next
	NoSqlHack = Str_InputStr
End Function

Function PageUrl(moveParam,removeList)
	dim strName
	dim KeepUrl,KeepForm,KeepMove
	removeList=removeList&","&moveParam
	KeepForm=""
	For Each strName in Request.Form 
		if not InstrRev(","&removeList&",",","&strName&",", -1, 1)>0 and Request.Form(strName)<>"" then
			KeepForm=KeepForm&"&"&strName&"="&Server.URLencode(Request.Form(strName))
		end if
		removeList=removeList&","&strName
	Next
	KeepUrl=""
	For Each strName In Request.QueryString
		If not (InstrRev(","&removeList&",",","&strName&",", -1, 1)>0) Then
			KeepUrl = KeepUrl & "&" & strName & "=" & Server.URLencode(Request.QueryString(strName))
		End If
	Next
	KeepMove=KeepForm&KeepUrl
	If (KeepMove <> "") Then 
	  KeepMove = Right(KeepMove, Len(KeepMove) - 1)
	  KeepMove = Server.HTMLEncode(KeepMove) & "&"
	End If
	'PageUrl = replace(Request.ServerVariables("URL"),"/Search.asp","/Search.html") & "?" & KeepMove & moveParam & "="
	PageUrl =  "?" & KeepMove & moveParam & "="
End Function 

Function fPageCount(Page_Rs,Page)
	Dim This_Func_Get_Html_,toPage_,p_,sp2_,I,tpagecount
	Dim NaviLength,StartPage,EndPage,showNumberLink_,showMorePageGo_Type_,nonLinkColor_
	Dim toF_,toP10_,toP1_,toN1_,toN10_,toL_,int_showNumberLink_
	showNumberLink_=10 
	showMorePageGo_Type_ = 0 
	nonLinkColor_="#999999" 
	toF_="<font face=webdings title=""首页"">9</font>"  		
	toP10_=" <font face=webdings title=""上十页"">7</font>"			
	toP1_=" <font face=webdings title=""上一页"">3</font>"			
	toN1_=" <font face=webdings title=""下一页"">4</font>"			
	toN10_=" <font face=webdings title=""下十页"">8</font>"			
	toL_="<font face=webdings title=""最后一页"">:</font>"
	This_Func_Get_Html_ = ""  : I = 1   
	NaviLength=showNumberLink_ 
	if IsEmpty(showMorePageGo_Type_) then showMorePageGo_Type_ = 1
	tpagecount=Page_Rs.pagecount
	If tPageCount<1 Then tPageCount=1 
	if not Page_Rs.eof or not Page_Rs.bof then
	toPage_ = PageUrl("Page","submit,GetType,no-cache,_")
	if Page=1 then 
		This_Func_Get_Html_=This_Func_Get_Html_& "<font color="&nonLinkColor_&" title=""首页"">"&toF_&"</font> " &vbNewLine
	Else 
		This_Func_Get_Html_=This_Func_Get_Html_& "<a href="&toPage_&"1 title=""首页"">"&toF_&"</a> " &vbNewLine
	End If 
	if Page<NaviLength then
		StartPage = 1
	else
		StartPage = fix(Page / NaviLength) * NaviLength	
	end if	
	EndPage=StartPage+NaviLength-1 
	If EndPage>tPageCount Then EndPage=tPageCount 
	If StartPage>1 Then 
		This_Func_Get_Html_=This_Func_Get_Html_& "<a href="&toPage_& Page - NaviLength &" title=""上"&int_showNumberLink_&"页"">"&toP10_&"</a> "  &vbNewLine
	Else 
		This_Func_Get_Html_=This_Func_Get_Html_& "<font color="&nonLinkColor_&" title=""上"&int_showNumberLink_&"页"">"&toP10_&"</font> "  &vbNewLine
	End If 
	If Page <> 1 and Page <>0 Then 
		This_Func_Get_Html_=This_Func_Get_Html_& "<a href="&toPage_&(Page-1)&"  title=""上一页"">"&toP1_&"</a> "  &vbNewLine
	Else 
		This_Func_Get_Html_=This_Func_Get_Html_& "<font color="&nonLinkColor_&" title=""上一页"">"&toP1_&"</font> "  &vbNewLine
	End If 
	For I=StartPage To EndPage 
		If I=Page Then 
			This_Func_Get_Html_=This_Func_Get_Html_& "<b>"&I&"</b>"  &vbNewLine
		Else 
			This_Func_Get_Html_=This_Func_Get_Html_& "<a href="&toPage_&I&">" &I& "</a>"  &vbNewLine
		End If 
		If I<>tPageCount Then This_Func_Get_Html_=This_Func_Get_Html_& vbNewLine
	Next 
	If Page <> Page_Rs.PageCount and Page <>0 Then 
		This_Func_Get_Html_=This_Func_Get_Html_& " <a href="&toPage_&(Page+1)&" title=""下一页"">"&toN1_&"</a> "  &vbNewLine
	Else 
		This_Func_Get_Html_=This_Func_Get_Html_& "<font color="&nonLinkColor_&" title=""下一页"">"&toN1_&"</font> "  &vbNewLine
	End If 
	If EndPage<tpagecount Then  
		This_Func_Get_Html_=This_Func_Get_Html_& " <a href="&toPage_& Page + NaviLength &"  title=""下"&int_showNumberLink_&"页"">"&toN10_&"</a> "  &vbNewLine
	Else 
		This_Func_Get_Html_=This_Func_Get_Html_& " <font color="&nonLinkColor_&"  title=""下"&int_showNumberLink_&"页"">"&toN10_&"</font> "  &vbNewLine
	End If 
	if Page_Rs.PageCount<>Page then  
		This_Func_Get_Html_=This_Func_Get_Html_& "<a href="&toPage_&Page_Rs.PageCount&" title=""尾页"">"&toL_&"</a>"  &vbNewLine
	Else 
		This_Func_Get_Html_=This_Func_Get_Html_& "<font color="&nonLinkColor_&" title=""尾页"">"&toL_&"</font>"  &vbNewLine
	End If 
	If showMorePageGo_Type_ = 1 then 
		Dim Show_Page_i
		Show_Page_i = Page + 1
		if Show_Page_i > tPageCount then Show_Page_i = 1
		This_Func_Get_Html_=This_Func_Get_Html_& "<input type=""text"" size=""4"" maxlength=""10"" name=""Func_Input_Page"" onmouseover=""this.focus();"" onfocus=""this.value='"&Show_Page_i&"';"" onKeyUp=""value=value.replace(/[^1-9]/g,'')"" onbeforepaste=""clipboardData.setData('text',clipboardData.getData('text').replace(/[^1-9]/g,''))"">" &vbNewLine _
			&"<input type=""button"" value=""Go"" onmouseover=""Func_Input_Page.focus();"" onclick=""javascript:var Js_JumpValue;Js_JumpValue=document.all.Func_Input_Page.value;if(Js_JumpValue=='' || !isNaN(Js_JumpValue)) location='"&topage_&"'+Js_JumpValue; else location='"&topage_&"1';"">"  &vbNewLine
	Else 
		This_Func_Get_Html_=This_Func_Get_Html_& " 跳转:<select NAME=menu1 onChange=""var Js_JumpValue;Js_JumpValue=this.options[this.selectedIndex].value;if(Js_JumpValue!='') location=Js_JumpValue;"">"
		for i=1 to tPageCount
			This_Func_Get_Html_=This_Func_Get_Html_& "<option value="&topage_&i
			if Page=i then This_Func_Get_Html_=This_Func_Get_Html_& " selected style='color:#FF0000'"
			This_Func_Get_Html_=This_Func_Get_Html_& ">第"&cstr(i)&"页</option>" &vbNewLine
		next
		This_Func_Get_Html_=This_Func_Get_Html_& "</select>" &vbNewLine
	End if
	This_Func_Get_Html_=This_Func_Get_Html_& p_&sp2_&" &nbsp;每页<b>"&Page_Rs.PageSize&"</b>个记录，现在是:<b><span class=""tx"">"&sp2_&Page&"</span>/"&tPageCount&"</b>页，共<b><span id='recordcount'>"&sp2_&Page_Rs.recordCount&"</span></b>个记录。"
	else
	end if
	fPageCount = This_Func_Get_Html_
End Function


Sub makeTypeOption(topId,separateStr)
	dim sqlStr,rsObj,span
	sqlStr= "select t_id,t_name from tbl_type order by t_sort asc"
	set rsObj = server.CreateObject("adodb.recordset")
	rsObj.open sqlStr,conn,1,1
	do while not rsObj.eof 
		if topId<>0 then span=span&separateStr
		response.Write "<option value='"&rsObj(0)&"'>"&span&"&nbsp;|—"&rsObj(1)&"</option>"
		rsObj.movenext
	loop
	if span<>"" then span = left(span,len(span)-len(separateStr))
	rsObj.close
	set rsObj = nothing

End Sub

Sub makeTypeOptionSelected(topId,separateStr,compareValue)
	dim sqlStr,rsObj,selectedStr,span
	sqlStr= "select t_id,t_name from tbl_type order by t_sort asc"
	set rsObj = server.CreateObject("adodb.recordset")
	rsObj.open sqlStr,conn,1,1
	do while not rsObj.eof 
		if clng(topId)<>0 then span=span&separateStr
		if clng(compareValue)=clng(rsObj("t_id")) then selectedStr=" selected" else selectedStr=""
		response.Write  "<option value='"&rsObj("t_id")&"' "&selectedStr&">"&span&"&nbsp;|—"&rsObj("t_name")&"</option>"
		
		rsObj.movenext
	loop
	if span<>""  then span = left(span,len(span)-len(separateStr))
	rsObj.close
	set rsObj = nothing
End Sub


Function isInstallObj(objname)
	dim isInstall,obj
	On Error Resume Next
	set obj=server.CreateObject(objname)
	if Err then 
		isInstallObj = false : err.clear 
	else 
		isInstallObj=true:set obj = nothing
	end if
End Function


Function getRealFrom(str)
	if(instr(str,"优酷")>0) then getRealFrom= "youku":exit function
	if(instr(str,"我乐")>0) then getRealFrom= "56":exit function
	if(instr(str,"FLV")>0) then getRealFrom= "flv":exit function
	if(instr(str,"土豆")>0) then getRealFrom= "tudou":exit function
	if(instr(str,"新浪")>0) then getRealFrom= "iask":exit function
	if(instr(str,"六间房")>0) then getRealFrom= "6rooms":exit function
	if(instr(str,"qq")>0) then getRealFrom= "qq":exit function
	if(instr(str,"酷6")>0) then getRealFrom= "ku6":exit function
	if(instr(str,"搜狐")>0) then getRealFrom= "sohu":exit function
	if(instr(str,"BOBO")>0) then getRealFrom= "bobo":exit function
	if(instr(str,"Ｑ播")>0) then getRealFrom= "qvod":exit function
	if(instr(str,"Real")>0) then getRealFrom= "real":exit function
	if(instr(str,"Media")>0) then getRealFrom= "media":exit function
	if(instr(str,"搜狐高清")>0) then getRealFrom= "sohuhd":exit function
	if(instr(str,"天线高清")>0) then getRealFrom= "openv":exit function
	if(instr(str,"土豆高清")>0) then getRealFrom= "tudouhd":exit function
	if(instr(str,"新浪高清")>0) then getRealFrom= "sinahd":exit function
	if(instr(str,"ku6高清")>0) then getRealFrom= "ku6hd":exit function
	if(instr(str,"迅雷Gvod")>0) then getRealFrom= "govd":exit function
	if(instr(str,"flash(swf)文件")>0) then getRealFrom= "swf":exit function

End Function

Function getViewFrom(str)
	if(instr(str,"youku")>0) then getViewFrom= "优酷":exit function
	if(instr(str,"56")>0) then getViewFrom= "我乐":exit function
	if(instr(str,"flv")>0) then getViewFrom= "FLV":exit function
	if(instr(str,"tudou")>0) then getViewFrom= "土豆":exit function
	if(instr(str,"iask")>0) then getViewFrom= "新浪":exit function
	if(instr(str,"6rooms")>0) then getViewFrom= "六间房":exit function
	if(instr(str,"qq")>0) then getViewFrom= "qq":exit function
	if(instr(str,"ku6")>0) then getViewFrom= "酷6":exit function
	if(instr(str,"sohu")>0) then getViewFrom= "搜狐":exit function
	if(instr(str,"bobo")>0) then getViewFrom= "BOBO":exit function
	if(instr(str,"qvod")>0) then getViewFrom= "Ｑ播":exit function
	if(instr(str,"real")>0) then getViewFrom= "Real":exit function
	if(instr(str,"media")>0) then getViewFrom= "Media":exit function
	if(instr(str,"sohuhd")>0) then getViewFrom= "搜狐高清":exit function
	if(instr(str,"openv")>0) then getViewFrom= "天线高清":exit function
	if(instr(str,"tudouhd")>0) then getViewFrom= "土豆高清":exit function
	if(instr(str,"sinahd")>0) then getViewFrom= "新浪高清":exit function
	if(instr(str,"ku6hd")>0) then getViewFrom= "ku6高清":exit function
	if(instr(str,"govd")>0) then getViewFrom= "迅雷Gvod":exit function
	if(instr(str,"swf")>0) then getViewFrom= "flash(swf)文件":exit function
	
End Function


Function  transferArea(area)
	dim area1,area2,area3,area4,area5,area6,i,areaStr,areaStrArray,j,flag
	area1="大陆,内地,国产,中国,华语"   '大陆
	area2="香港,港"    '香港
	area3="台湾,台"    '台湾
	area4="日本,日"    '日本
	area5="韩国,韩"    '韩国
	area6="欧美,欧,美" '欧美
	for i=1 to 6
		flag=false
		Execute("areaStr=area"&i)
		areaStrArray=split(areaStr,",")
		for j=0 to ubound(areaStrArray)
			if instr(area,areaStrArray(j))>0 then flag=true : Exit For
		next
		if flag=true then 
			select case i
				case 1 :  transferArea = "大陆" : Exit Function
				case 2 :  transferArea = "地区" : Exit Function
				case 3 :  transferArea = "地区" : Exit Function
				case 4 :  transferArea = "日韩" : Exit Function
				case 5 :  transferArea = "日韩" : Exit Function
				case 6 :  transferArea = "欧美" : Exit Function
				case else : transferArea = "未知" : Exit Function
			end select
		end if
	next
	transferArea = "其它"	
End Function

Sub isCurrentDay(timeStr)
	if isNul(timeStr) then echo "":Exit Sub
	dim timeStr2 : timeStr2=date
	if instr(timeStr,timeStr2)>0 then  echo "<span style='color:red;font-size:9px'>"&timeStr&"</span>" else echo "<span style='font-size:9px'>"&timeStr&"</span>"
End Sub

Function PE_CLng(ByVal str1)
    If IsNumeric(str1) Then
        PE_CLng = Fix(CDbl(str1))
    Else
        PE_CLng = 0
    End If
End Function
%>