%
Server.ScriptTimeOut=999
Response.Buffer = True
Response.Expires = -1
Response.ExpiresAbsolute = Now() - 1
Response.CacheControl = "no-cache"
response.Charset = "gb2312"
ConnectionDatabase
Dim ClsMain,ACT_S_Qie_Qie,filename
Dim MakeSearch,TemplateContent,SearchList,lists
Dim MaxPerPage,KeyWord,RS,i
Set ACT_S_Qie_Qie = New ACT_Search
Dim RefreshTime:RefreshTime = 600 '设置防刷新时间
Session("SearchTime")=Now()
KeyWord=ACTCMS.s("KeyWord")
'检测时间是否生成新页面
dim filepath
dim objfso '文件组件
dim objfile '文件
filepath = server.MapPath("/KeywordMap/index.html")'
set objfso=createobject("scripting.filesystemobject") '实例文件组件
set objfile=objfso.GetFile(filepath) '读取文件所在路径
'if datediff("d",objfile.datelastmodified,now)>=2 then
if KeyWord = "生成列表y" then
call mkjs()
call MKWL()'生成搜索列表
Response.Redirect "/KeywordMap/"
end if
If KeyWord="" Then Call ACTCMS.Alert("你没有输入搜索关键字!",""):response.End
if instr(lcase(KeyWord),"admin")<>0 or instr(lcase(KeyWord),"select")<>0 or instr(lcase(KeyWord),"count")<>0 or instr(lcase(KeyWord),"and")<>0 or instr(lcase(KeyWord),"char")<>0 or len(KeyWord)>18 then
response.write "对不起,搜索时出现问题。请稍后再试"
If DateDiff("s", Session("SearchTime"), Now()) < RefreshTime Then
Response.Write "
本页面起用了防刷新机制,请不要在"&RefreshTime&"秒内连续刷新本页面
正在打开页面,请稍后……"
Response.End
End If
response.End()
end if
'if then response.write "关键字限制,请联系管理员":response.End()
filename = "KeywordMap/"&ACTCMS.GetEn(ACTCMS.PinYin(keyword))&".html"
'#######################################################################################################################
'#关键字检测、更新、生成
If CKW(KeyWord) = True Then
call ANKW()'添加新词
call MKW()'生成搜索页
Else
call UKW()'更新关键词
call MKW()'生成搜索页
End if
Response.Redirect filename
'#######################################################################################################################
'###########################################
'#更新关键字时间、次数
'###########################################
Sub UKW()
Conn.Execute("Update search_Form_ACT set hit_act=hit_act+1,zhtime_act=#"&now()&"# where keyword_act='" & keyword & "'")
End Sub
'###########################################
'#添加新词
'###########################################
Sub ANKW()
Set RS=server.CreateObject("adodb.recordset")
rs.open("select * from search_Form_ACT where 1=0"),conn,1,3
rs.addnew
rs("keyword_act") = keyword
rs("zhtime_act") = now()
rs("hit_act") = 1
rs("filename_act") = filename
rs.update
rs.close
set rs=nothing
End Sub
'###########################################
'#检测关键字 True - 新 False - 已有
'###########################################
Function CKW(str)
Set RS=conn.execute("select * from search_Form_ACT where keyword_act='" & keyword & "'")
if rs.eof then
CKW = True
else
CKW = False
end if
rs.close
set rs=nothing
End Function
'###########################################
'#生成搜索页面
'###########################################
Sub MKW()
Set MakeSearch =New ACT_Code
TemplateContent = MakeSearch.LoadTemplate("/templets/search.htm")
TemplateContent = MakeSearch.LabelReplaceAll(TemplateContent)
TemplateContent = replace(TemplateContent,"{$SearchKeyword}",keyword)
TemplateContent = replace(TemplateContent,"{$Searchdescription}",SD(keyword))
TemplateContent = replace(TemplateContent,"{$hotkeyword}",GHS)
TemplateContent = replace(TemplateContent,"{$SearchList}",List(keyword))
TemplateContent = replace(TemplateContent,"{$ProList}",ProList(keyword))
TemplateContent = replace(TemplateContent,"{$NewsList}",NewsList(keyword))
Call MakeSearch.FSOSaveFile(TemplateContent,filename)
Set MakeSearch=Nothing
End Sub
'###########################################
'#生成搜索列表
'###########################################
Sub MKWL()
'第一步,取得列表
dim lists,rsct,zongye,diye,zkey,arrl,arrs
set rs=conn.execute("select * from search_Form_ACT order by hit_act desc,zhtime_act asc")
zkey=rs.GetRows
rs.close
set rs=nothing
lists = ""
rsct=conn.execute("select count(*) from search_Form_ACT")(0)
zongye = int(rsct/160)+1
arrs = ubound(zkey,2)
for arrl = 0 to arrs
if arrl = 0 then lists = lists & "