📄 flashchannel.asp
字号:
HtmlTemplate = Replace(HtmlTemplate, TempListContent, ListContent)
HtmlTemplate = Replace(HtmlTemplate, "{$ReadListPage}", strHtmlPage)
HtmlTemplate = Replace(HtmlTemplate, "[ShowRepetend]", "")
HtmlTemplate = Replace(HtmlTemplate, "[/ShowRepetend]", "")
'开始生成子分类的HTML页
HtmlFileName = HtmlFilePath & sulCurrentPage & Newasp.Supplemental(CurrentPage, 3) & Newasp.HtmlExtName
Newasp.CreatedTextFile HtmlFileName, HtmlTemplate
If IsShowFlush = 1 Then
Response.Write "<li style=""font-size: 12px;"">生成" & Newasp.ModuleName & "列表HTML完成... <a href=" & HtmlFileName & " target=_blank>" & Server.MapPath(HtmlFileName) & "</a></li>" & vbNewLine
Response.Flush
End If
Next
End Sub
'#############################\\FLASH搜索开始//#############################
Public Sub BuildFlashSearch()
Dim SearchMaxPageList
Dim Action, findword
Dim rsClass, strNoResult
Dim strWord, s
PageType = 5
keyword = Newasp.ChkQueryStr(Trim(Request("keyword")))
keyword = Newasp.CheckInfuse(keyword,255)
strWord = Newasp.CheckStr(Trim(Request("word")))
strWord = Newasp.CheckInfuse(strWord,10)
s = Newasp.ChkNumeric(Request.QueryString("s"))
If Newasp.CheckNull(strWord) Then
strWord = UCase(Left(strWord, 6))
keyword = strWord
Else
strWord = ""
End If
If keyword = "" And strWord = "" Then
Call OutAlertScript("请输入要查询的关键字！")
Exit Sub
End If
If strWord = "" Then
If Not Newasp.CheckQuery(keyword) Then
Call OutAlertScript("你查询的关键中有非法字符！\n请返回重新输入关键字查询。")
Exit Sub
End If
End If
skinid = CLng(Newasp.ChannelSkin)
On Error Resume Next
Newasp.LoadTemplates ChannelID, 7, skinid
If Newasp.HtmlSetting(4) <> "0" Then
If IsNumeric(Newasp.HtmlSetting(4)) Then
'If CInt(Newasp.HtmlSetting(4)) Mod CInt(Newasp.HtmlSetting(1)) = 0 Then
'SearchMaxPageList = CLng(Newasp.HtmlSetting(4)) \ CInt(Newasp.HtmlSetting(1))
'Else
'SearchMaxPageList = CLng(Newasp.HtmlSetting(4)) \ CInt(Newasp.HtmlSetting(1)) + 1
'End If
SearchMaxPageList = CLng(Newasp.HtmlSetting(4))
Else
SearchMaxPageList = 50
End If
Else
SearchMaxPageList = 50
End If
strNoResult = Replace(Newasp.HtmlSetting(8), "{$KeyWord}", keyword)
Action = Newasp.CheckStr(Trim(Request("act")))
Action = Newasp.CheckStr(Action)
If strWord = "" And LCase(Action) <> "isweb" Then
If Newasp.strLength(keyword) < CLng(Newasp.HtmlSetting(5)) Or Newasp.strLength(keyword) > CLng(Newasp.HtmlSetting(6)) Then
Call OutAlertScript("查询错误！\n您查询的关键字不能小于 " & Newasp.HtmlSetting(5) & " 或者大于 " & Newasp.HtmlSetting(6) & " 个字节。")
Exit Sub
End If
End If
If strWord = "" Then
If LCase(Action) = "topic" Then
findword = "A.title like '%" & keyword & "%'"
ElseIf LCase(Action) = "content" Then
If CInt(Newasp.FullContQuery) <> 0 Then
findword = "A.Content like '%" & keyword & "%'"
Else
Call OutAlertScript(Replace(Replace(Newasp.HtmlSetting(10), Chr(34), "\"""), vbCrLf, ""))
Exit Sub
End If
Else
findword = "A.title like '%" & keyword & "%'"
End If
Else
findword = "A.AlphaIndex='" & strWord & "'"
End If
If LCase(Action) <> "isweb" Then
If IsEmpty(Session("QueryLimited")) Then
Session("QueryLimited") = keyword & "|" & Action & "|" & Now()
Else
Dim QueryLimited
QueryLimited = Split(Session("QueryLimited"), "|")
If UBound(QueryLimited) = 2 Then
If CStr(Trim(QueryLimited(0))) = CStr(keyword) And CStr(Trim(QueryLimited(1))) = CStr(Action) Then
Session("QueryLimited") = keyword & "|" & Action & "|" & Now()
Else
If DateDiff("s", QueryLimited(2), Now()) < CLng(Newasp.HtmlSetting(7)) Then
Dim strLimited
strLimited = Replace(Newasp.HtmlSetting(9), "{$TimeLimited}", Newasp.HtmlSetting(7))
Call OutAlertScript(Replace(Replace(strLimited, Chr(34), "\"""), vbCrLf, ""))
Exit Sub
Else
Session("QueryLimited") = keyword & "|" & Action & "|" & Now()
End If
End If
Else
Session("QueryLimited") = keyword & "|" & Action & "|" & Now()
End If
End If
End If
HtmlContent = Newasp.HtmlContent
HtmlContent = Replace(HtmlContent, "{$ChannelRootDir}", ChannelRootDir)
HtmlContent = Replace(HtmlContent, "{$InstallDir}", strInstallDir)
HtmlContent = Replace(HtmlContent, "{$ChannelID}", ChannelID)
HtmlContent = Replace(HtmlContent, "{$ModuleName}", Newasp.ModuleName)
HtmlContent = Replace(HtmlContent, "{$FlashIndex}", strIndexName)
HtmlContent = Replace(HtmlContent, "{$KeyWord}", KeyWord)
HtmlContent = Replace(HtmlContent, "{$PageTitle}", Newasp.ModuleName & "搜索")
HtmlContent = Replace(HtmlContent, "{$QueryKeyWord}", "<font color=red><strong>" & keyword & "</strong></font>")
Call ReplaceString
If LCase(Action) <> "isweb" Then
If IsNumeric(Request("classid")) And Request("classid") <> "" Then
Set rsClass = Newasp.Execute("SELECT ClassID,ChildStr FROM [NC_Classify] WHERE ChannelID = " & ChannelID & " And ClassID=" & CLng(Request("classid")))
If rsClass.BOF And rsClass.EOF Then
HtmlContent = Replace(HtmlContent, "{$ReadListPage}", strNoResult, 1, 1, 1)
HtmlContent = Replace(HtmlContent, "{$ReadListPage}", "")
HtmlContent = Replace(HtmlContent, "{$totalrec}", 0)
HtmlContent = Replace(HtmlContent, Newasp.CutFixContent(HtmlContent, "[ShowRepetend]", "[/ShowRepetend]", 1), "")
Set rsClass = Nothing
Response.Write HtmlContent
Exit Sub
Else
findword = "A.ClassID IN (" & rsClass("ChildStr") & ") And " & findword
End If
rsClass.Close: Set rsClass = Nothing
End If
maxperpage = CInt(Newasp.HtmlSetting(1))
If Not IsNumeric(Request("page")) And Len(Request("page")) <> 0 Then
Response.Write ("错误的系统参数!请输入整数")
Response.End
End If
If Not IsEmpty(Request("page")) And Len(Request("page")) <> 0 Then
CurrentPage = CInt(Request("page"))
Else
CurrentPage = 1
End If
If CInt(CurrentPage) = 0 Then CurrentPage = 1
Set Rs = CreateObject("ADODB.Recordset")
SQL = "SELECT TOP " & SearchMaxPageList & " A.flashid,A.ClassID,A.title,A.ColorMode,A.FontMode,A.Introduce,A.filesize,A.Author,A.star,A.miniature,A.UserName,A.addTime,A.AllHits,A.grade,A.HtmlFileDate,A.isBest,C.ClassName,C.HtmlFileDir,C.UseHtml FROM [NC_FlashList] A INNER JOIN [NC_Classify] C On A.ClassID=C.ClassID WHERE A.ChannelID=" & ChannelID & " And A.isAccept > 0 And " & findword & " ORDER BY A.addTime DESC ,A.flashid DESC"
Rs.Open SQL, Conn, 1, 1
If Rs.BOF And Rs.EOF Then
'如果没有找到相关内容,清除掉无用的标签代码
HtmlContent = Replace(HtmlContent, "{$ReadListPage}", strNoResult, 1, 1, 1)
HtmlContent = Replace(HtmlContent, "{$ReadListPage}", "")
HtmlContent = Replace(HtmlContent, "{$totalrec}", 0)
HtmlContent = Replace(HtmlContent, Newasp.CutFixContent(HtmlContent, "[ShowRepetend]", "[/ShowRepetend]", 1), "")
Else
TotalNumber = Rs.RecordCount
If (TotalNumber Mod maxperpage) = 0 Then
TotalPageNum = TotalNumber \ maxperpage
Else
TotalPageNum = TotalNumber \ maxperpage + 1
End If
If CurrentPage > TotalPageNum Then CurrentPage = TotalPageNum
If CurrentPage < 1 Then CurrentPage = 1
HtmlContent = Replace(HtmlContent, "{$totalrec}", TotalNumber)
'获取模板标签[ShowRepetend][/ReadFlashList]中的字符串
TempListContent = Newasp.CutFixContent(HtmlContent, "[ShowRepetend]", "[/ShowRepetend]", 1)
Call LoadSearchList
End If
Rs.Close: Set Rs = Nothing
Else
HtmlContent = Replace(HtmlContent, "{$ReadListPage}", "")
HtmlContent = Replace(HtmlContent, "{$totalrec}", 0)
HtmlContent = Replace(HtmlContent, Newasp.CutFixContent(HtmlContent, "[ShowRepetend]", "[/ShowRepetend]", 1), "")
If s = 1 Then
Call isWeb_Query()
Exit Sub
End If
Response.Write HtmlContent & SearchObj
Exit Sub
End If
Response.Write HtmlContent
Exit Sub
End Sub
'================================================
'过程名：LoadSearchList
'作 用：装载软件搜索列表
'================================================
Private Sub LoadSearchList()
If IsNull(TempListContent) Then Exit Sub
i = 0
If TotalPageNum > 1 Then Rs.Move (CurrentPage - 1) * maxperpage
ListContent = ""
j = (CurrentPage - 1) * maxperpage + 1
Do While Not Rs.EOF And i < CInt(maxperpage)
If Not Response.IsClientConnected Then Response.End
Call SearchResult
Rs.MoveNext
i = i + 1
j = j + 1
If i >= maxperpage Then Exit Do
Loop
Dim strPagination
strPagination = ShowListPage(CurrentPage, TotalPageNum, TotalNumber, maxperpage, ASPCurrentPage(PageType), "搜索结果")
HtmlContent = Replace(HtmlContent, TempListContent, ListContent)
HtmlContent = Replace(HtmlContent, "[ShowRepetend]", "")
HtmlContent = Replace(HtmlContent, "[/ShowRepetend]", "")
HtmlContent = Replace(HtmlContent, "{$ReadListPage}", strPagination)
End Sub
'================================================
'过程名：SearchResult
'作 用：装载搜索列表细节
'================================================
Private Sub SearchResult()
Dim sTitle, sTopic, title, ListStyle, TitleWord
Dim FlashUrl, addTime, sClassName, FlashImage, FlashIntro
Dim miniatureUrl,miniature,strminiature
ListContent = ListContent & TempListContent
If (i Mod 2) = 0 Then
ListStyle = 1
Else
ListStyle = 2
End If
TitleWord = Replace(Rs("title"), keyword, "<font color=red>" & keyword & "</font>")
sTitle = Newasp.ReadFontMode(TitleWord, Rs("ColorMode"), Rs("FontMode"))
If CInt(CreateHtml) <> 0 Then
FlashUrl = ChannelRootDir & Rs("HtmlFileDir") & Newasp.ShowDatePath(Rs("HtmlFileDate"), Newasp.HtmlPath) & ReadPagination(0)
sClassName = ChannelRootDir & Rs("HtmlFileDir")
Else
FlashUrl = ChannelRootDir & "show.asp?id=" & Rs("flashid")
sClassName = ChannelRootDir & "list.asp?classid=" & Rs("ClassID")
End If
sClassName = "<a href=""" & sClassName & """ title=""" & Rs("ClassName") & """ target=""_blank""><span style=""color:" & Newasp.MainSetting(3) & """>" & Rs("ClassName") & "</span></a>"
title = "<a href='" & FlashUrl & "' title='" & Rs("title") & "' class=""showtopic"" target=""_blank"">" & sTitle & "</a>"
FlashIntro = Newasp.CutString(Rs("Introduce"), CInt(Newasp.HtmlSetting(3)))
FlashIntro = Replace(FlashIntro, keyword, "<font color=red>" & keyword & "</font>")
If Not IsNull(Rs("miniature")) Then
strminiature = Rs("miniature")
End If
miniatureUrl = Newasp.GetImageUrl(strminiature, Newasp.ChannelDir)
miniature = Newasp.GetFlashAndPic(miniatureUrl, CInt(Newasp.HtmlSetting(11)), CInt(Newasp.HtmlSetting(12)))
miniature = "<a href='" & FlashUrl & "' title='" & Rs("title") & "'>" & miniature & "</a>"
addTime = Newasp.ShowDateTime(Rs("addTime"), CInt(Newasp.HtmlSetting(2)))
ListContent = Replace(ListContent, "{$KeyWord}", keyword)
ListContent = Replace(ListContent, "{$totalrec}", TotalNumber)
ListContent = Replace(ListContent, "{$ClassifyName}", sClassName)
ListContent = Replace(ListContent, "{$FlashTitle}", title)
ListContent = Replace(ListContent, "{$FlashTopic}", sTitle)
ListContent = Replace(ListContent, "{$FlashUrl}", FlashUrl)
ListContent = Replace(ListContent, "{$Miniature}", miniature)
ListContent = Replace(ListContent, "{$Star}", Rs("star"))
ListContent = Replace(ListContent, "{$FlashHits}", Rs("AllHits"))
ListContent = Replace(ListContent, "{$UserName}", Rs("username"))
ListContent = Replace(ListContent, "{$DateAndTime}", addTime)
ListContent = Replace(ListContent, "{$Introduce}", FlashIntro)
ListContent = Replace(ListContent, "{$ListStyle}", ListStyle)
ListContent = Replace(ListContent, "{$FlashSize}", ReadFilesize(Rs("filesize")))
ListContent = Replace(ListContent, "{$Author}", Newasp.ChkNull(Rs("Author")))
ListContent = Replace(ListContent, "{$FlashID}", Rs("flashid"))
ListContent = Replace(ListContent, "{$Order}", j)
End Sub
'//--搜索结束
'================================================
'函数名：FlashComment
'作 用：FLASH评论
'================================================
Private Function FlashComment(flashid)
Dim rsComment, SQL, strContent, strComment
Dim i, Resize, strRearrange
Dim ArrayTemp()
On Error Resume Next
Set rsComment = Newasp.Execute("SELECT TOP " & CInt(Newasp.HtmlSetting(5)) & " content,Grade,username,postime,postip FROM NC_Comment WHERE ChannelID=" & ChannelID & " And postid = " & flashid & " ORDER BY postime DESC,CommentID DESC")
If Not (rsComment.EOF And rsComment.BOF) Then
i = 0
Resize = 0
Do While Not rsComment.EOF
ReDim Preserve ArrayTemp(i + Resize)
strContent = ArrayTemp(i) & Newasp.HtmlSetting(7)
strComment = Newasp.CutString(rsComment("content"), CInt(Newasp.HtmlSetting(6)))
strContent = Replace(strContent, "{$Comment}", Newasp.HTMLEncode(strComment))
strContent = Replace(strContent, "{$UserName}", Newasp.HTMLEncode(rsComment("username")))
strContent = Replace(strContent, "{$UserGrade}", rsComment("Grade"))
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -