<%
'=========================================================
Class Cls_Sys
Private LocalCacheName,Cache_Data,IsGetJsPage
Public Reloadtime,CacheName,System_sn,CacheData,SqlQueryNum,ScriptName
Public Sys_Setting,PathInfo,ErrCodes,RootAspFileFolder,RootAspFile,IndexHtmlFile

Private Sub Class_Initialize()
CacheName=Replace(Replace(Replace(Server.MapPath("search.asp"),"search.asp",""),":",""),"\","")
System_sn=Replace(CacheName,"_","")
Dim TempStr
TempStr=Request.ServerVariables("PATH_INFO")
TempStr=Split(TempStr,"/")
ScriptName=Lcase(TempStr(UBound(TempStr)))
TempStr=Empty
Reloadtime=14400
SqlQueryNum=0
RootAspFileFolder="RootAspFile/" '从根目录移走多余的ASP文件到此目录，以"/"结束
RootAspFile="index.asp" '从根目录移走多余的ASP文件
End Sub

Private Sub class_terminate()
If IsObject(Conn) Then Conn.Close:Set Conn = Nothing
End Sub

Public Property Get CookiesPath()
CookiesPath=Request.ServerVariables("PATH_INFO")
CookiesPath=Left(CookiesPath,InstrRev(CookiesPath,"/"))
End Property

Public Property Let Name(ByVal vNewValue)
LocalCacheName = LCase(vNewValue)
End Property

Public Property Let Value(ByVal vNewValue)
If LocalCacheName<>"" Then
ReDim Cache_Data(2)
Cache_Data(0)=vNewValue
Cache_Data(1)=Now()
Application.Lock
Application(CacheName & "_" & LocalCacheName) = Cache_Data
Application.unLock
Else
Err.Raise vbObjectError + 1, "ElookCacheServer", " please change the CacheName."
End If
End Property

Public Property Get Value()
If LocalCacheName<>"" Then
Cache_Data=Application(CacheName & "_" & LocalCacheName)
If IsArray(Cache_Data) Then
Value=Cache_Data(0)
Else
Err.Raise vbObjectError + 1, "ElookCacheServer", " The Cache_Data("&LocalCacheName&") Is Empty."
End If
Else
Err.Raise vbObjectError + 1, "ElookCacheServer", " please change the CacheName."
End If
End Property

Public Function ObjIsEmpty()
ObjIsEmpty=True
Cache_Data=Application(CacheName & "_" & LocalCacheName)
If Not IsArray(Cache_Data) Then Exit Function
If Not IsDate(Cache_Data(1)) Then Exit Function
If DateDiff("s",CDate(Cache_Data(1)),Now()) < (60*Reloadtime) Then ObjIsEmpty=False
End Function

Public Sub DelCache(MyCaheName)
Application.Lock
Application.Contents.Remove(CacheName&"_"&MyCaheName)
Application.unLock
End Sub

Public Sub DelAllCache()
Dim cachelist,i
Cachelist=split(GetallCache(),",")
If UBound(cachelist)>1 Then
For i=0 to UBound(cachelist)-1
Call DelCache(Cachelist(i))
Next
End If
End Sub

Public Function GetallCache()
Dim Cacheobj
For Each Cacheobj in Application.Contents
If CStr(Left(Cacheobj,Len(CacheName)+1))=CStr(CacheName&"_") Then
GetallCache=GetallCache&Mid(Cacheobj,Len(CacheName)+2)&","
End If
Next
End Function

Public Sub GetSys_Setting()
Name="Setup"
If ObjIsEmpty() Then ReloadSetup()
CacheData=Value

Name="Date"
If ObjIsEmpty() Then Value=Date()
Name="Date"
If Cstr(Value) <> Cstr(Date()) Then
'If IsNumeric(CacheData(3,0)) Then
Dim Hits
If Not IsObject(Conn) Then ConnectionDatabase
'Execute("Update [Elook_Setup] Set Hits=" & CLng(CacheData(3,0)))
Hits=Conn.Execute("Select SUM(hits) from [Elook_Article]",0,1)(0)
Execute("Update [Elook_Setup] Set Hits = " & Hits)
'End If
Call DelAllCache()
Name="setup"
Call ReloadSetup()
CacheData=Value
Sys_Setting=CacheData(1,0)
Sys_Setting=Split(Sys_Setting,"|")
IndexHtmlFile=Sys_Setting(40) & Sys_Setting(39)
'Response.WRite Sys_Setting(27) & "<br>" & Cint(CacheData(6,0))
If Sys_Setting(27)="1" And Sys_Setting(33)="1" And Cint(CacheData(6,0))=0 Then '关键句：And Cint(CacheData(6,0))=0，如果没有该句，则程序将陷入死循环-_-
If InStr(ScriptName,"getjs.asp")>0 Then IsGetJsPage=1 Else IsGetJsPage=0 End If
Call BuildHtml(0,0)
End If
Name="Date"
Value=Date()
Else
Sys_Setting=CacheData(1,0)
Sys_Setting=Split(Sys_Setting,"|")
IndexHtmlFile=Sys_Setting(40) & Sys_Setting(39)
If Sys_Setting(27)="1" And Sys_Setting(33)="1" And Cint(CacheData(6,0))=1 And Request.Form(System_sn & "IsBingHtml")<>"1" Then
If InStr(ScriptName,"getjs.asp")>0 Then IsGetJsPage=1 Else IsGetJsPage=0 End If
Call BuildHtml(0,0)
End If
'Response.WRite Sys_Setting(27) & "<br>" & Cint(CacheData(6,0))
End If
If Sys_Setting(27)="1" Then
PathInfo="您的位置：<a href="""&IndexHtmlFile&""">首页</a>"
Else
PathInfo="您的位置：<a href=""index.asp"">首页</a>"
End if

End Sub

'作用：显示网站顶部的导航菜单
Public Sub ShowTopNav()
Name="TopNav"
If ObjIsEmpty() Then
Dim SqlMenu,RsMenu,ArrayMenu,RowNum,RsRow,TmpStr
TmpStr=TmpStr & "&nbsp;&nbsp;&nbsp;&nbsp;<a href="""
If Sys_Setting(27)="1" Then
TmpStr=TmpStr & IndexHtmlFile
Else
TmpStr=TmpStr & "index.asp"
End if
TmpStr=TmpStr & """ target=""_self"" class=""px_13nav"">首页</a>"
SqlMenu="Select ClassID,ClassName,Readme,ForeignLink From [Elook_Class] Where ParentID=0 Order By RootID"
Set RsMenu=Execute(SqlMenu)
If Not RsMenu.Eof Then
ArrayMenu=RsMenu.GetRows(-1)
Set RsMenu=Nothing
RsRow=UBound(ArrayMenu,2)
For RowNum=0 To RsRow
TmpStr=TmpStr & " <img src=""IMAGES/NARROW.GIf"" align=""absmiddle""> <a href="""
If ArrayMenu(3, RowNum)<>"" Then
TmpStr=TmpStr & ArrayMenu(3, RowNum)
Else
If Sys_Setting(27)="1" Then
TmpStr=TmpStr & "Class" & ArrayMenu(0, RowNum) & Sys_Setting(39)
Else
TmpStr=TmpStr & "Class.asp?classid="&ArrayMenu(0, RowNum)
End if
End if
TmpStr=TmpStr & """ Title="""&ArrayMenu(2, RowNum)&""" class=""px_13nav"">"
TmpStr=TmpStr & ArrayMenu(1,RowNum)
TmpStr=TmpStr & "</a>"
Next
Else
Set RsMenu=Nothing
TmpStr="导航栏目不存在"
End If
Value=TmpStr
End If
Response.Write Value
End Sub

'作用：显示搜索
Public Sub ShowSearch(ShowType)
'ShowType：1，简洁模式（迷你门户使用）；2，全功能模式（首页使用）；3，全功能模式（分类文章、搜索文章使用）
Dim Action,Target,IsHaveGoogle,IsBothSearch,Radio,GoogleHiddenValue1,GoogleHiddenValue2,Result
IsHaveGoogle="true"
IsBothSearch="false"
If Sys_Setting(37)="0" Then
If Sys_Setting(35)="1" Then
Action="http://www.google.com/search"
Target="_blank"
ElseIf Sys_Setting(35)="2" Then
Action="http://www.google.com/custom"
Target="_blank"
End If
GoogleHiddenValue1="<INPUT TYPE=""hidden"" name=""GoogleHiddenValue"" value="""&Sys_Setting(35)&""">"
GoogleHiddenValue2=Sys_Setting(36)
Else
Action="search.asp"
Target="_self"
If Sys_Setting(35)="0" Then
IsHaveGoogle="false"
Else
IsBothSearch="true"
Radio="<input type=""radio"" name=""isgoogle"" value=""0"""
If Sys_Setting(41)="0" Or Request("isgoogle")="0" Then Radio=Radio & " checked"
Radio=Radio & ">"
Radio=Radio & "Google&nbsp;<input type=""radio"" name=""isgoogle"" value=""1"""
If Sys_Setting(41)="1" Or ShowType=1 Or Request("isgoogle")="1" Then Radio=Radio & " checked"
Radio=Radio & ">本站"
GoogleHiddenValue1="<input type=""hidden"" name=""googlehiddenvalue"" value="""&Sys_Setting(35)&""">"
GoogleHiddenValue2=Sys_Setting(36)
End If
End if
If ShowType=1 Then Target="_blank"
Result=Radio & GoogleHiddenValue1 & GoogleHiddenValue2

Response.Write "<table border=""0"" cellspacing=""0"" cellpadding=""0"">"&_
"<form method=""Get"" name=""search"" target="""&Target&""" action="""&Action&""" onSubmit=""return checkSearch(this,"& IsHaveGoogle & "," & IsBothSearch & ");""><tr>"
If ShowType=1 Then
Response.Write "<td width=""5""></td><td><input type=""hidden"" name=""showtype"" value=""1"">"&_
"<INPUT TYPE=""hidden"" name=""IsMiniSearch"" value=""true""><input type=""text"" name=""q"" size=""12"" maxlength=""40"" value=""请输入关键字"" onMouseOver=""this.focus()"" onblur=""if (this.value ==''){this.value=this.defaultValue}"" onFocus=""this.select()"" onClick=""if(this.value==this.defaultValue)this.value=''"" class=""ClassSearch"">"&_
Result & "&nbsp;<input type=""image"" src=""images/go.gif"" border=""0"" align=""absmiddle""></td>"
ElseIf Showtype=2 Then
Response.Write "<td><input type=""hidden"" name=""ShowType"" value=""2"">"&_
"<select name=""Condition""><option value=""0"" selected>标题</option><option value=""1"">内容</option><option value=""2"">作者</option></select>&nbsp;"&_
"<select name=""ClassID""><option value=0>所有栏目</option>"
Call ShowTreeNav(0)
Response.Write "</select>"&_
"&nbsp;<input type=""text"" name=""q"" size=""18"" maxlength=""40"" value=""请输入关键字"" onMouseOver=""this.focus()"" onblur=""if (this.value ==''){this.value=this.defaultValue}"" onFocus=""this.select()"" onClick=""if(this.value==this.defaultValue)this.value=''"">"&_
Result & "&nbsp;<input type=""submit"" name=""Submit"" value=""搜索""></td>"
ElseIf Showtype=3 Then
Response.Write "<td><input type=""hidden"" name=""ShowType"" value=""3"">"&_
"<select name=""Condition"" class=""ClassSearch""><option value=""0"" selected>标题</option><option value=""1"">内容</option><option value=""2"">作者</option></select>&nbsp;"&_
"<select name=""ClassID"" class=""ClassSearch""><option value=0>所有栏目</option>"
Call ShowTreeNav(0)
Response.Write "</select>"&_
"&nbsp;<input type=""text"" name=""q"" size=""18"" maxlength=""40"" value="""
If Request("q")<>"" Then
Response.Write Request("q")
Else
Response.Write "请输入关键字"
End if
Response.Write """ onMouseOver=""this.focus()"" onblur=""if (this.value ==''){this.value=this.defaultValue}"" onFocus=""this.select()"" onClick=""if(this.value==this.defaultValue)this.value=''"" class=""ClassSearch"">"&_
"&nbsp;</td><td>" & Result & "&nbsp;<INPUT TYPE=""image"" src=""Images/go.gif"" border=""0"" align=""absMiddle""></td>"
End If
Response.Write "</tr></form></table>"
End Sub

Public Sub ReloadSetup()
Dim SqlConst,RsConst
Dim Sys_Setting
SqlConst="Select Top 1 ID,Sys_Setting,ArticleNum,Hits,AdminNum,SysVerSion,IsBingHtml From [Elook_Setup]"
Set RsConst=Execute(SqlConst)
Value=RsConst.Getrows(1)
Set RsConst=nothing
End sub

'作用：生成树状栏目
'VarType：0，生成搜索里的栏目选择选项；1，生成首页的树状栏目导航
Public Sub ShowTreeNav(VarType)
Name="TreeNav"
If ObjIsEmpty() Then
Dim RsClass,SqlClass,TmpData
SqlClass="Select ClassID,ClassName,Depth,ChIld,PrevID,NextID,ForeignLink From [Elook_Class] Order By RootID,OrderID"
Set RsClass=Execute(SqlClass)
If RsClass.Eof Then
Value=""
Else
TmpData=RsClass.GetString(,-1,"|||","@@@","")
TmpData=Left(TmpData,Len(TmpData)-3)
Value=TmpData
End If
Set RsClass=Nothing
End If
Dim TmpArray,RsArray,RsRow,RowNum,StrTemp,TmpDepth,I
Name="TreeNav"
TmpArray=Value
If TmpArray="" Then
If VarType=0 Then
StrTemp="<optIon value="""">栏目不存在。</optIon>"
ElseIf VarType=1 Then
StrTemp="栏目不存在。"
End if
Else
Dim ArrShowLIne(20)
For I=0 To Ubound(ArrShowLIne)
ArrShowLIne(I)=False
Next
TmpArray=Split(TmpArray,"@@@")
RsRow=UBound(TmpArray,1)
If VarType=0 Then
For RowNum=0 To RsRow
RsArray=Split(TmpArray(RowNum),"|||")
TmpDepth=CInt(RsArray(2))
If RsArray(5)>0 Then
ArrShowLIne(TmpDepth)=True
Else
ArrShowLIne(TmpDepth)=False
End If
If RsArray(6)<>"" Then
StrTemp=StrTemp & "<optIon value=""-9"">"
Else
StrTemp=StrTemp & "<optIon value=""" & RsArray(0) & """" & ">"
End if
If TmpDepth>0 Then
For I=1 To TmpDepth
StrTemp=StrTemp & "&nbsp;&nbsp;"
If I=TmpDepth Then
If RsArray(5)>0 Then
StrTemp=StrTemp & "├&nbsp;"
Else
StrTemp=StrTemp & "└&nbsp;"
End If
Else
If ArrShowLIne(I)=True Then
StrTemp=StrTemp & "│"
Else
StrTemp=StrTemp & "&nbsp;"
End If
End If
Next
End If
If RsArray(6)<>"" Then
StrTemp=StrTemp & RsArray(1) & "(外)"
Else
StrTemp=StrTemp & RsArray(1)
End if
StrTemp=StrTemp & "</optIon>"
Next
ElseIf VarType=1 Then
For RowNum=0 To RsRow
RsArray=Split(TmpArray(RowNum),"|||")
TmpDepth=CInt(RsArray(2))
If (TmpDepth+1)<=Cint(Sys_Setting(24)) Then
If RsArray(5)>0 Then
ArrShowLIne(TmpDepth)=True
Else
ArrShowLIne(TmpDepth)=False
End If
If TmpDepth>0 Then
For I=1 To TmpDepth
StrTemp=StrTemp & "&nbsp;&nbsp;"
If I=TmpDepth Then
If RsArray(5)>0 Then
StrTemp=StrTemp & "├&nbsp;"
Else
StrTemp=StrTemp & "└&nbsp;"
End If
Else
If ArrShowLIne(I)=True Then
StrTemp=StrTemp & "│"
Else
StrTemp=StrTemp & "&nbsp;"
End If
End If
Next
End If
StrTemp=StrTemp & "<a href="""
If RsArray(6)<>"" Then
StrTemp=StrTemp & RsArray(6)
Else
If Sys_Setting(27)="1" Then
StrTemp=StrTemp & "class" & RsArray(0) & Sys_Setting(39)
Else
StrTemp=StrTemp & "class.asp?classid=" & RsArray(0)
End if
End if
StrTemp=StrTemp & """ target=""_self"">" & RsArray(1) & "</a><br>"
End If
Next
End if
End if
Response.Write StrTemp
End Sub

'作用：一个过程完成所有文章标题列表显示（除分页外）
Public Sub ShowRs(StrCacheName,StrSql,RowLoopNum,DotType,Target,TitleLen,ShowAuthor,ShowTime,ShowHits,ShowNew,ShowBest,ShowHot)
'StrCacheName：0，禁止使用缓存；非0的字符串，则生成缓存
If Cstr(StrCacheName)<>"0" Then
Name=StrCacheName
Else
Name="ItIsEmptyCache"
End If
If ObjIsEmpty() Then
Dim Rs,RsArray,RsRow,RowNum,TemStr
Set Rs=Execute(StrSql)
If Not Rs.Eof Then
RsArray=Rs.GetRows(-1)
Set Rs=Nothing
RsRow=UBound(RsArray,2)
If RsRow>RowLoopNum-1 Then RsRow=RowLoopNum-1
For RowNum=0 To RsRow
If DotType=0 Then
TemStr=TemStr & "<img src=""images/icon0.gif"" align=absmiddle border=0>"
ElseIf DotType=1 Then
TemStr=TemStr & "<img src=""images/icon1.gif"" align=absmiddle border=0>"
End If
'TemStr=TemStr & "<a href=""Article.asp?articleid="&RsArray(0,RowNum)&""" title=""标题："&Server.HtmlEncode(RsArray(1,RowNum)) & VbCrlf & "作者："&Server.HtmlEncode(RsArray(7,RowNum)) & VbCrlf & "发表："& RsArray(4,RowNum) & VbCrlf & "人气："&RsArray(3,RowNum) & """"
TemStr=TemStr & "<a href=""Article.asp?articleid="&RsArray(0,RowNum)&""" title="""&Server.HtmlEncode(RsArray(1,RowNum))&""""
If Target=0 Then
TemStr=TemStr & " target=_self>"
ElseIf Target=1 Then
TemStr=TemStr & " target=_blank>"
End If
If RsArray(10,RowNum)=1 Then
TemStr=TemStr & "<font color=""#FF0000"">" & CutTopic(RsArray(1,RowNum),TitleLen) & "</font></a>"
ElseIf RsArray(10,RowNum)=2 Then
TemStr=TemStr & "<font color=""#00FF00"">" & CutTopic(RsArray(1,RowNum),TitleLen) & "</font></a>"
ElseIf RsArray(10,RowNum)=3 Then
TemStr=TemStr & "<font color=""#0000FF"">" & CutTopic(RsArray(1,RowNum),TitleLen) & "</font></a>"
ElseIf RsArray(10,RowNum)=4 Then
TemStr=TemStr & "<font color=""#FF00FF"">" & CutTopic(RsArray(1,RowNum),TitleLen) & "</font></a>"
Else
TemStr=TemStr & CutTopic(RsArray(1,RowNum),TitleLen)
End If
TemStr=TemStr & "</a>"
If ShowAuthor=1 Or ShowTime=1 Or ShowHits=1 Then
TemStr=TemStr & "(<font class=""grey"">"
If ShowAuthor=1 Then TemStr=TemStr & RsArray(7,RowNum)
If ShowTime=1 Then
If ShowAuthor=1 Then TemStr=TemStr & "，"
If StrCacheName="NewArticle" Then
TemStr=TemStr & Format_Time(RsArray(4,RowNum),8)
Else
TemStr=TemStr & FormatDateTime(RsArray(4,RowNum),2)
End If
End If
If ShowHits=1 Then
If ShowAuthor=1 Or ShowTime=1 Then TemStr=TemStr & "，"
TemStr=TemStr & RsArray(3,RowNum)
End If
TemStr=TemStr & "</font>)"
End If
If ShowNew=1 And Cint(Sys_Setting(20))<>0 And DateDiff("d",RsArray(4,RowNum),Date())<Cint(Sys_Setting(20)) Then TemStr=TemStr & " <img src=""images/new_icon.gif"" title=""最新文章"">"
If ShowBest=1 And RsArray(9,RowNum)=1 Then TemStr=TemStr & " <img src=""images/icon_best.gif"" title=""推荐文章"">"
If ShowHot=1 And Cint(Sys_Setting(19))<>0 And RsArray(3,RowNum)>=Cint(Sys_Setting(19)) Then TemStr=TemStr & " <img src=""images/icon_hot.gif"" title=""热门文章"">"
TemStr=TemStr & "<br>"
Next
Else
Set Rs=Nothing
'DotType：-1，表示生成前/后文章标题
If DotType=-1 Then
TemStr="没有了"
Else
TemStr="相关文章不存在。"
End If
End if
If Cstr(StrCacheName)<>"0" Then Value=TemStr
End If
If Cstr(StrCacheName)<>"0" Then
Response.Write Value
Else
Response.Write TemStr
End If
End Sub

'作用：显示分页的文章标题列表
Public Sub ShowPagRs(RsCountCacheName,SqlRsCount,PerPage,SqlRsShow,RowLoopNum,DotType,Target,TitleLen,ShowAuthor,ShowTime,ShowHits,ShowNew,ShowBest,ShowHot)
'SqlRsCount:0，搜索时使用；非0的字符串，则根据SQL语句生成记录（一般文章分页使用）
If Cstr(SqlRsCount)="0" Then
RsCount=1
Else
Dim TemRsCount
'RsCountCacheName：0，禁止使用缓存；非0的字符串，则生成记录总数缓存
If Cstr(RsCountCacheName)<>"0" Then
Name=RsCountCacheName
Else
Name="ItIsEmptyCache"
End If
If ObjIsEmpty() Then
If Not IsObject(Conn) Then ConnectionDatabase
'获取分页所需记录总数
TemRsCount=Conn.Execute(SqlRsCount,0,1)(0)
SqlQueryNum=SqlQueryNum+1
If Cstr(RsCountCacheName)<>"0" Then Value=TemRsCount
End If
If Cstr(RsCountCacheName)<>"0" Then
Name=RsCountCacheName
RsCount=Value
Else
RsCount=TemRsCount
End If
End If
If RsCount>0 Then
Dim Rs,RsRow,RowNum
Set Rs=Server.CreateObject("ADODB.Recordset")
If Not IsObject(Conn) Then ConnectionDatabase
Rs.Open SqlRsShow,Conn,1,1
SqlQueryNum=SqlQueryNum+1
If Cstr(SqlRsCount)="0" Then RsCount=Rs.Recordcount
If Not Rs.Eof Then
'TotalPage = abs(int(-abs(RsCount/PerPage)))
If RsCount Mod PerPage=0 Then
TotalPage= RsCount\PerPage
Else
TotalPage= RsCount\PerPage+1
End If
If CurrentPage>TotalPage Then
CurrentPage=TotalPage
End if
'Response.Write RsCount & "<br>" & TotalPage & "<br>"
Rs.AbsolutePosition=(CurrentPage-1)*PerPage+1
For RowNum=1 To RowLoopNum
If Rs.Eof Then Exit For
If DotType=0 Then
Response.Write "<img src=""images/icon0.gif"" align=absmiddle border=0>"
ElseIf DotType=1 Then
Response.Write "<img src=""images/icon1.gif"" align=absmiddle border=0>"
End If
'Response.Write "<a href=""Article.asp?articleid="&Rs(0)&""" title=""标题："&Server.HtmlEncode(Rs(1)) & VbCrlf & "作者："&Server.HtmlEncode(Rs(7)) & VbCrlf & "发表："& Rs(4) & VbCrlf & "人气："&Rs(3) & """"
Response.Write "<a href=""Article.asp?articleid="&Rs(0)&""" title="""&Server.HtmlEncode(Rs(1))& VbCrlf &""""
If Target=0 Then
Response.Write " target=_self>"
ElseIf Target=1 Then
Response.Write " target=_blank>"
End If
If Rs(10)=1 Then
Response.Write "<font color=""#FF0000"">" & CutTopic(Rs(1),TitleLen) & "</font></a>"
ElseIf Rs(10)=2 Then
Response.Write "<font color=""#00FF00"">" & CutTopic(Rs(1),TitleLen) & "</font></a>"
ElseIf Rs(10)=3 Then
Response.Write "<font color=""#0000FF"">" & CutTopic(Rs(1),TitleLen) & "</font></a>"
ElseIf Rs(10)=4 Then
Response.Write "<font color=""#FF00FF"">" & CutTopic(Rs(1),TitleLen) & "</font></a>"
Else
Response.Write CutTopic(Rs(1),TitleLen)
End If
Response.Write "</a>"
If ShowAuthor=1 Or ShowTime=1 Or ShowHits=1 Then
Response.Write "(<font class=""grey"">"
If ShowAuthor=1 Then Response.Write Rs(7)
If ShowTime=1 Then
If ShowAuthor=1 Then Response.Write "，"
Response.Write FormatDateTime(Rs(4),2)
End If
If ShowHits=1 Then
If ShowAuthor=1 Or ShowTime=1 Then Response.Write "，"
Response.Write Rs(3)
End If
Response.Write "</font>)"
End If
If ShowNew=1 And Cint(Sys_Setting(20))<>0 And DateDiff("d",Rs(4),Date())<Cint(Sys_Setting(20)) Then Response.Write " <img src=""images/new_icon.gif"" title=""最新文章"">"
If ShowBest=1 And Rs(9)=1 Then Response.Write " <img src=""images/icon_best.gif"" title=""推荐文章"">"
If ShowHot=1 And Cint(Sys_Setting(19))<>0 And Rs(3)>=Cint(Sys_Setting(19)) Then Response.Write " <img src=""images/icon_hot.gif"" title=""热门文章"">"
Response.Write "<br>"
Rs.MoveNext
Next
Else
Response.Write "相关文章不存在。"
End if
Rs.Close
Set Rs=Nothing
Else
Response.Write "相关文章不存在。"
End If
End Sub

' ============================================
' 格式化时间(显示)
' 参数：n_Flag
' 1:"yyyy-mm-dd hh:mm:ss"
' 2:"yyyy-mm-dd"
' 3:"hh:mm:ss"
' 4:"yyyy年mm月dd日"
' 5:"yyyymmdd"
' 6:"yy-mm-dd"
' 7:mm-dd hh:mm
' 8:mm-dd
' ============================================
Function Format_Time(s_Time, n_Flag)
Dim y, m, d, h, mi, s
Format_Time = ""
If IsDate(s_Time) = False Then Exit Function
y = cstr(year(s_Time))
m = cstr(month(s_Time))
If len(m) = 1 And n_Flag<>8 Then m = "0" & m
d = cstr(day(s_Time))
If len(d) = 1 And n_Flag<>8 Then d = "0" & d
h = cstr(hour(s_Time))
If len(h) = 1 Then h = "0" & h
mi = cstr(minute(s_Time))
If len(mi) = 1 Then mi = "0" & mi
s = cstr(second(s_Time))
If len(s) = 1 Then s = "0" & s
Select Case n_Flag
Case 1
' yyyy-mm-dd hh:mm:ss
Format_Time = y & "-" & m & "-" & d & " " & h & ":" & mi & ":" & s
Case 2
' yyyy-mm-dd
Format_Time = y & "-" & m & "-" & d
Case 3
' hh:mm:ss
Format_Time = h & ":" & mi & ":" & s
Case 4
' yyyy年mm月dd日
Format_Time = y & "年" & m & "月" & d & "日"
Case 5
' yyyymmdd
Format_Time = y & m & d
Case 6
If Len(y)=4 Then y=Right(y,2)
' yyyy-mm-dd
Format_Time = y & "-" & m & "-" & d
Case 7
' mm-dd hh:mm
Format_Time = m & "-" & d & " " & h & ":" & mi
Case 8
' mm-dd
Format_Time = m & "-" & d
End Select
End Function

'作用：是否禁止网页被保存，是否禁止内容被复制
Public Sub ShowBody(StrType,VarType)
Select Case StrType
Case "IsForbidCopy"
If Cint(Sys_Setting(10))>0 Then
If Cint(VarType)<=Cint(Sys_Setting(10)) Then Response.Write " oncontextmenu=""return false"" onselectstart=""return false"""
End If
If Sys_Setting(34)="1" And Instr(ScriptName,"admin_index.asp")=0 And Instr(ScriptName,"miniportal.asp")=0 Then Response.Write " onload=""loadBar(0)"""
Case "IsForbidSave"
If Cint(Sys_Setting(11))>0 Then
If Cint(VarType)<=Cint(Sys_Setting(11)) Then Response.Write VbNewLine &"<noscript><iframe src=""*.htm""></noscript>"
End if
Case "IsShowLeader"
If Sys_Setting(34)="1" Then
Response.Write vbNewLine & "<script language=""javascript"" src=""Script/loadbar.js""></script>" & vbNewLine
Response.Write "<div id=""loader"" style=""Z-INDEX: 100;position:absolute;display:none"">" & vbNewLine
Response.Write "<table style=""FILTER: Alpha(opacity=90);"" border=""0"" cellpadding=""5"" cellspacing=""1"" bgcolor=""#bbbbb"" onClick=""loadBar(0)""><tr><td bgcolor=""#FFFFFF"" align=""left""><p><img src=""images/load.gif"" align=""left"" style=""margin:3px"" alt=""请等待""><strong>数据载入中...</strong><br><span style=""font-size:8pt;"">Please wait until this screen is completely loaded.</span></p></td></tr></table>" & vbNewLine
Response.Write "</div>" & vbNewLine
Response.Write "<script type=""text/javascript"" language=""javascript"">loadBar(1);</script>"
End If
End Select
End Sub

Public Function Execute(Command)
If Not IsObject(Conn) Then ConnectionDatabase
If Not IsDeBug Then
On Error Resume Next
Set Execute = Conn.Execute(Command)
If Err Then
Err.Clear
Set Conn = Nothing
Response.Write "查询数据的时候发现错误，请检查您的查询代码是否正确。"
Response.End
End If
Else
'Response.Write command & "<br>"
Set Execute = Conn.Execute(Command)
End If
SqlQueryNum = SqlQueryNum+1
End Function

Public Function ReloadSetupCache(MyValue,N)
CacheData(N,0) = MyValue
Name="setup"
Value=CacheData
End Function

'作用：获取路径等相关信息
'VarType：0,分类文章使用；1，搜索使用
Public Sub GetPathInfo(VarType)
Dim TmpData,TmpArray
'获取分类父路径
Name="CClassID"&ClassID
If ObjIsEmpty() Then
Dim SqlCClass,RsCClass
SqlCClass="Select ClassID,ClassName,ParentPath,RootID,Child,ForeignLink From [Elook_Class] Where ClassID=" & ClassID
Set RsCClass=Execute(SqlCClass)
If Not RsCClass.Eof Then
Value=RsCClass.GetString(,1,"|||","","")
Else
Call ShowErrMsg(1)
End If
Set RsCClass=Nothing
End If
Dim CCArray
Name="CClassID"&ClassID
CCArray=Value
CCArray=Split(CCArray,"|||")
If (VarType=0) Then
'获取分类路径
Dim CClassID
'如果该栏目为外部栏目则直接导向(有问题)
'If CCArray(5)<>"" Then Response.Redirect CCArray(5)

CClassID=CCArray(2)
ClassName=CCArray(1)
Name="CPathInfo"&ClassID
If ObjIsEmpty() Then
Dim SqlPath,RsPath
SqlPath="Select ClassID,ClassName From [Elook_Class] Where ClassID IN(" & CClassID & ") Order By Depth"
Set RsPath=Execute(SqlPath)
If Not RsPath.Eof Then
TmpData=RsPath.GetString(,-1,"|||","@@@","")
TmpData=Left(TmpData,Len(TmpData)-3)
Value=TmpData
Else
Value=""
End If
Set RsPath=Nothing
End If
Dim ArrayPath,RowNum,RsRow
Name="CPathInfo"&ClassID
TmpArray=Value
If TmpArray<>"" Then
TmpArray=Split(TmpArray,"@@@")
RsRow=UBound(TmpArray,1)
For RowNum=0 To RsRow
ArrayPath=Split(TmpArray(RowNum),"|||")
PathInfo=PathInfo & "&nbsp;-&gt;&nbsp;<a href="""
If Sys_Setting(27)="1" Then
PathInfo=PathInfo & "Class" & ArrayPath(0) & Sys_Setting(39)
Else
PathInfo=PathInfo & "Class.asp?classid="&ArrayPath(0)
End if
PathInfo=PathInfo & """>" & ArrayPath(1)&"</a>"
Next
End If
PathInfo=PathInfo & "&nbsp;-&gt;&nbsp;<a href="""
If Sys_Setting(27)="1" Then
PathInfo=PathInfo & "Class" & CCArray(0) & Sys_Setting(39)
Else
PathInfo=PathInfo & "Class.asp?classid="&CCArray(0)
End if
PathInfo=PathInfo & """>" & CCArray(1)&"</a>"
End if
'获取分类（包括子分类）ClassID
InClassID=ClassID
If Cint(CCArray(4))>0 Then
Name="CInClassID"&ClassID
If ObjIsEmpty() Then
Dim ClaRs
Set ClaRs=Execute("SELECT ClassID From [Elook_Class] Where RootID="&Cint(CCArray(3))&" And ParentPath Like '"&CCArray(2)& "," &InClassID& "%' Order By OrderID")
If Not ClaRs.Eof Then
TmpData=ClaRs.GetString(,-1,"|||","@@@","")
TmpData=Left(TmpData,Len(TmpData)-3)
Value=TmpData
Else
Value=""
End If
Set ClaRs=Nothing
End If
Dim ClaArray,ClaRow,ClaRowNum
Name="CInClassID"&ClassID
TmpArray=Value
If TmpArray<>"" Then
TmpArray=Split(TmpArray,"@@@")
ClaRow=UBound(TmpArray,1)
For ClaRowNum=0 To ClaRow
ClaArray=Split(TmpArray(ClaRowNum),"|||")
InClassID=InClassID & "," & ClaArray(0)
Next
End If
End If
'Response.Write InClassID & "<br>"
End Sub

Public Sub ShowErrMsg(ErrCode)
Response.Redirect "showerr.asp?ErrCode=" & ErrCode
Response.end
End Sub

Public Sub Footer()
Dim Endtime,ProcessTime,QueryNum
Response.Write "<table width=""100%"" cellspacing=""0"" align=""center"" border-width:1 cellpadding=""3"" border=""0""><tr><td align=""center""><font color=""#734c00"">" & Sys_Setting(21) &"<a href=""http://www.elook.net.cn/"" target=""_blank"">" & CacheData(5,0) &"</a>。"
If Sys_Setting(23)=1 Then
Endtime = Timer()
If CacheData(6,0)=1 Or Request.Form(System_sn & "IsBingHtml")="1" Then
ProcessTime="0"
QueryNum="0"
Else
ProcessTime=CCur(FormatNumber((Endtime-StarTime)*1000,1,-1))
QueryNum=SqlQueryNum
End if
Response.Write "耗时" & ProcessTime & "毫秒，查询数据库" & QueryNum & "次。"
End If
Response.Write "</font></td></tr></table>"
Response.Write "</BODY></HTML>"
End Sub

'防注入
Public Function ChkRequest(RequestData,ParaType)
Dim IsSafe
IsSafe=True
If RequestData<>"" Then
If ParaType=1 Then
If Not IsNumeric(RequestData) Then IsSafe=False
Else
RequestData=Lcase(RequestData)
If Instr(RequestData,"'")>0 Or (Instr(RequestData,"select")>0 And Instr(RequestData,"from")>0) Or Instr(RequestData,";")>0 Then IsSafe=False
End If
If IsSafe=False Then
Call ShowErrMsg(0)
Else
ChkRequest=RequestData
End If
End If
End function

'防刷新
Public Sub PreRefresh()
Dim TmpArray,TmpFile,IsTrue
IsTrue=False
TmpArray=Split(Request.ServerVariables("PATH_INFO"),"/")
TmpFile=TmpArray(Ubound(TmpArray))
If Instr(Lcase(Sys_Setting(30)),Lcase(TmpFile))>0 Then IsTrue=True
If IsEmpty(Session(System_sn & "Refresh")) and Cint(Sys_Setting(29))>0 And IsTrue Then
Session(System_sn & "Refresh")=Now()
Session.TimeOut=5
ElseIf Cint(Sys_Setting(29))>0 And IsTrue Then
'Response.Write VarType(Session(System_sn & "Refresh"))
'Response.End
If DateDiff("s",Session(System_sn & "Refresh"),Now())<Clng(Sys_Setting(29)) And IsTrue Then
Response.Write "<META http-equiv=Content-Type content=text/html; charset=gb2312><meta HTTP-EQUIV=REFRESH CONTENT="&Cint(Sys_Setting(29))&"><span style=""font-size:12px""><br>本页面起用了防刷新机制，请不要在"&Sys_Setting(29)&"秒内连续刷新本页面<BR>正在打开页面，请稍后……</span>"
Response.End
Else
Session(System_sn & "Refresh")=Now()
End If
End If
End Sub

Public Function IsObjInstalled(strClassString)
On Error Resume Next
IsObjInstalled = False
Err = 0
Dim xTestObj
Set xTestObj = Server.CreateObject(strClassString)
If 0 = Err Then IsObjInstalled = True
Set xTestObj = Nothing
Err = 0
End Function

Public Function CutTopic(Str,Strlen)
If Str="" Then
CutTopic=""
Exit function
End If
Dim L,T,C,I
Dim TmpStr
L=Len(Str)
T=0
For I=1 to L
C=Abs(Asc(Mid(Str,I,1)))
If C>255 Then
T=T+2
Else
T=T+1
End If
If T>=Strlen Then
TmpStr=Left(Str,I) & "…"
Exit For
Else
TmpStr=Str
End If
Next
CutTopic=TmpStr
End function

Public Function StrLength(str)
ON ERROR RESUME NEXT
dim WINNT_CHINESE
WINNT_CHINESE =(len("例子")=2)
If WINNT_CHINESE Then
dim l,t,c
dim i
l=len(str)
t=l
for i=1 to l
c=asc(Mid(str,i,1))
If c<0 Then c=c+65536
If c>255 Then
t=t+1
End If
next
strLength=t
Else
strLength=len(str)
End If
If err.number<>0 Then err.clear
End function

Public Function ReplaceBadChar(strChar)
If strChar="" Then
ReplaceBadChar=""
Else
strChar=Replace(strChar,"'","")
strChar=Replace(strChar,"*","")
strChar=Replace(strChar,"?","")
strChar=Replace(strChar,"(","")
strChar=Replace(strChar,")","")
strChar=Replace(strChar,"<","")
strChar=Replace(strChar,".","")
strChar=Replace(strChar,";","")
strChar=Replace(strChar,Chr(0),"")
ReplaceBadChar=strChar
End If
End function

Public Sub CheckRemoteSubmit
If InStr(Request.ServerVariables("HTTP_REFERER"),"http://"&_
Request.ServerVariables("HTTP_HOST"))=0 Then
Call ShowErrMsg(4)
End If
End Sub

Public Function CheckStr(str)
If Isnull(Str) Then
CheckStr=""
Exit Function
End If
Str=Replace(Str,Chr(0),"")
CheckStr=Replace(Str,"'","''")
End function

'作用：用正则表达式过滤字符
Public Function GetRegExp(str,Pat)
Dim ObjRegExp,Match,Matches
Set ObjRegExp=New RegExp
ObjRegExp.IgnoreCase=True
ObjRegExp.Global=True
ObjRegExp.Pattern=Pat
Set Matches=ObjRegExp.Execute(str)
For Each Match In Matches
str=Replace(str,Match.Value,"")
Next
Set ObjRegExp=Nothing
GetRegExp=str
End Function

Private Function GetScriptNameUrl()
Dim sPATH_INFO,sScript_Name,sTemp
sPATH_INFO=Request.ServerVariables("PATH_INFO")
sTemp=Split(sPATH_INFO,"/")
sScript_Name=Lcase(sTemp(UBound(sTemp)))
If Request.servervariables("SERVER_PORT")="80" Then
GetScriptNameUrl="http://" & Request.servervariables("server_name")&replace(lcase(sPATH_INFO),sScript_Name,"")
Else
GetScriptNameUrl="http://" & Request.servervariables("server_name")&":"&Request.servervariables("SERVER_PORT")&Replace(Lcase(Request.servervariables("script_name")),sScript_Name,"")
End If
End Function

'作用： 生成HTML页
'参数： VarType：0，前台使用；1，后台使用
' BuildType：0，只更新首页；1，更新首页和栏目页
Public Sub BuildHtml(VarType,BuildType)
Dim TmpXmlText
Dim Sql,Rs
Dim SiteUrl
SiteUrl=GetScriptNameUrl
'Response.Write SiteUrl

If Not ELOOK.IsObjInstalled("Scripting.FileSystemObject") Then
If VarType=1 Then
ErrCodes = ErrCodes & "<li>您的服务器不支持FileSystemObject组件！</li><br><li>无法使用生成HTML文件功能。</li><br>"
FoundErr=True
End if
Exit Sub
Else
If VarType=0 Then
If IsGetJsPage=1 Then
Response.Write "showDataStat.innerHTML='<br>正在更新文章数据,请稍等...';"
Else
Dim ScriptName
ScriptName=Request.ServerVariables("Script_Name")
If Request.ServerVariables("QUERY_STRING")<>"" Then
Session("ComeUrl")=ScriptName&"?"&Request.ServerVariables("QUERY_STRING")
Else
Session("ComeUrl")=ScriptName
End If
If Instr(Lcase(Session("ComeUrl")),"index.asp") Then Session("ComeUrl")="./"
Response.Write "<META http-equiv=Content-Type content=text/html; charset=gb2312>"
Response.Write "<br>正在更新文章数据,请稍等..."
End if
Response.Flush
End If
Execute("Update [Elook_Setup] Set IsBingHtml=1")
'Name="Setup"
'ReloadSetup() '不能用Call DelAllCache()
DelAllCache()

'Response.WRite CheckFile(RootAspFile) & RootAspFileFolder & RootAspFile
If Not CheckFile(RootAspFile) Then
'从变量RootAspFileFolder值的目录移走多余的ASP文件到根目录
MoveFileTo RootAspFileFolder & RootAspFile,RootAspFile
End if
'生成首页
TmpXmlText=GetHttpPage(SiteUrl&"index.asp","1")
If TmpXmlText="{$GetHttpPage}" Then '文章数据更新不成功
Execute("Update [Elook_Setup] Set IsBingHtml=0")
Call DelAllCache()
If VarType=0 Then Call RedirectOldUrl()
Else
Call SaveToFile(TmpXmlText,IndexHtmlFile)
End if
If VarType=1 Then ShowFlush("正在生成首页文件：" & IndexHtmlFile)
If BuildType=1 Then
TmpXmlText=""
'生成栏目页
Sql="Select ClassID From [Elook_Class]"
Set Rs=Execute(Sql)
Do While Not Rs.Eof
TmpXmlText=GetHttpPage(SiteUrl&"class.asp?classid="&Rs(0)&"&IsBulidHtml=1","1")
If TmpXmlText=False Then
Exit Sub
Else
Call SaveToFile(TmpXmlText,"class" & Rs(0) & Sys_Setting(39))
End if
If VarType=1 Then ShowFlush("正在生成栏目页文件：class" & Rs(0) & Sys_Setting(39))
Rs.MoveNext
Loop
Set Rs=Nothing
End If

'从根目录移走多余的ASP文件到变量RootAspFileFolder值的目录
If CheckDir2(RootAspFileFolder) Then
MoveFileTo RootAspFile,RootAspFileFolder & RootAspFile
Else
MakeNewsDir2(RootAspFileFolder)
MoveFileTo RootAspFile,RootAspFileFolder & RootAspFile
End if
Execute("Update [Elook_Setup] Set IsBingHtml=0")
Call DelAllCache()
If VarType=1 Then
Response.Write "<br>"
ShowFlush("<b>恭喜你！所有HTML文件生成完毕。</b>")
ElseIf VarType=0 Then
Call RedirectOldUrl()
End If
End If
End Sub

Private Sub RedirectOldUrl()
If IsGetJsPage=1 Then
Response.Write "showDataStat.innerHTML='<br>文章数据更新完毕！';"
Response.Flush
Else
Response.Write "<br>文章数据更新完毕！"
If Session("ComeUrl")<>"" Then
Response.Write "<meta http-equiv=""refresh"" content=""1;URL="&Session("ComeUrl")&""">"
Else
Response.Write "<meta http-equiv=""refresh"" content=""1;URL=./"">"
End If
Response.End
End If
End Sub

'定义xmlhttp
Private Function GetHttpPage(ByVal HttpUrl,Byval IsBingHtml)
Dim oHttp,sData
sData=System_sn & "IsBingHtml=" & IsBingHtml
On Error Resume Next
Set oHttp=Server.CreateObject("MSXML2.XMLHTTP")
With oHttp
.open "POST",HttpUrl,False
.setrequestheader "content-length",Len(sData)
.setrequestheader "content-type","application/x-www-form-urlencoded"
.send UrlEncoding(sData)
If .Readystate=4 And .Status=200 then
GetHTTPPage=BytesToBSTR(.ResponseBody,"GB2312")
Else
GetHttpPage="{$GetHttpPage}"
Exit function
End if
End With
Set oHttp=Nothing
If Err then Err.Clear
End Function

Private Function UrlEncoding(ByVal DataStr)
Dim StrReturn,Si,ThisChr,InnerCode,Hight8,Low8
StrReturn = ""
For Si = 1 To Len(DataStr)
ThisChr = Mid(DataStr,Si,1)
If Abs(Asc(ThisChr)) < &HFF Then
StrReturn = StrReturn & ThisChr
Else
InnerCode = Asc(ThisChr)
If InnerCode < 0 Then
InnerCode = InnerCode + &H10000
End If
Hight8 = (InnerCode And &HFF00)\ &HFF
Low8 = InnerCode And &HFF
StrReturn = StrReturn & "%" & Hex(Hight8) & "%" & Hex(Low8)
End If
Next
UrlEncoding = StrReturn
End Function

'转换为字符
Private Function BytesToBstr(ByVal Body,ByVal Cset)
Dim oStream
Set oStream = Server.CreateObject("ADODB.STREAM")
With oStream
.Type = 1
.Mode =3
.Open
.Write body
.Position = 0
.Type = 2
.Charset = Cset
BytesToBstr = .ReadText
.Close
End With
Set oStream = Nothing
End Function

'保存文件
Public Sub SaveToFile(strBody,File)
Dim objStream
Set objStream = Server.CreateObject("ADODB.Stream")
With objStream
.Type = 2
.Open
.Charset = "GB2312"
.Position = objStream.Size
.WriteText = strBody
.SaveToFile Server.MapPath(File),2
.Close
End With
Set objStream = Nothing
End Sub

'检查某目录是否存在
Public Function CheckDir2(byval FolderPath)
dim fso
folderpath=Server.MapPath(".")&"\"&folderpath
Set fso = Server.CreateObject("Scripting.FileSystemObject")
If fso.FolderExists(FolderPath) then
'存在
CheckDir2 = True
Else
'不存在
CheckDir2 = False
End if
Set fso = nothing
End Function

'创建目录
Public Function MakeNewsDir2(byval foldername)
dim fso,f
Set fso = Server.CreateObject("Scripting.FileSystemObject")
fso.CreateFolder(Server.MapPath(".") &"\" &foldername)
MakeNewsDir2 = True
Set fso = nothing
End Function

'检查某文件是否存在
Public Function CheckFile(FilePath)
dim fso
Set fso = Server.CreateObject("Scripting.FileSystemObject")
If fso.FileExists(Server.MapPath(FilePath)) then
'存在
CheckFile = True
Else
'不存在
CheckFile = False
End if
Set fso = nothing
End Function

'移动文件
Public Function MoveFileTo(SourceF,DestinationF)
dim fso,f
Set fso = Server.CreateObject("Scripting.FileSystemObject")
If fso.FileExists(Server.MapPath(SourceF)) Then
fso.MoveFile Server.MapPath(SourceF),Server.MapPath(DestinationF)
MoveFileTo = True
Else
MoveFileTo=False
End if
Set fso = nothing
End Function

Public Sub ShowFlush(StrShow)
Dim TableBeg,TableEnd
TableBeg="<table width=""98%"" border=""0"" align=""center"" cellpadding=""2"" cellspacing=""0"" class=""tableBorder""><tr class=""tdbg""><td>"
TableEnd="</td></tr></table>"
Response.Write TableBeg
Response.Write StrShow
Response.Write TableEnd
Response.Flush
End Sub
End Class
%>
两部分合起来！！真晕！！