📄 powereasy.common.front.asp
字号:
End If
rsBro.Close
Set rsBro = Nothing
GetBrotherClass = strBro
End Function
'=================================================
'函数名：GetChildClass
'作 用：显示当前栏目的下一级子栏目
'参 数：
'1 theClassID ---- 栏目ID,0为本栏目
'2 ClassNum ---- 栏目数，若大于0，则只查询前几个栏目
'3 ShowPropertyType ---- 显示栏目前的小图标，0为不显示，1为符号，其他为小图片：/images/article_common*.gif
'4 OpenType ---- 栏目打开方式，0为在原窗口打开，1为在新窗口打开，3为根据栏目设置
'5 Cols ---- 每行的列数。超过此列数就换行。
'6 ShowChildNum ---- 是否显示子栏目个数，有子栏目时才显示，
'=================================================
Function GetChildClass(theClassID, ClassNum, ShowPropertyType, OpenType, Cols, ShowChildNum)
Dim sqlChild, rsChild, i, strChild, tOpenType
If Cols = 0 Then Cols = 1
sqlChild = "select"
If ClassNum > 0 Then
sqlChild = sqlChild & " top " & ClassNum
End If
sqlChild = sqlChild & " ClassID,ClassName,Depth,ParentPath,NextID,ClassType,Child,ParentDir,ClassDir,OpenType,LinkUrl,ClassPurview from PE_Class where ChannelID=" & ChannelID & " "
If theClassID <> 0 Then
sqlChild = sqlChild & " and ParentID=" & theClassID
Else
sqlChild = sqlChild & " and ParentID=" & ClassID
End If
sqlChild = sqlChild & " and IsElite=" & PE_True & " order by OrderID"
Set rsChild = Conn.Execute(sqlChild)
If rsChild.BOF And rsChild.EOF Then
strChild = "没有任何子栏目"
Else
i = 0
Do While Not rsChild.EOF
If i > 0 Then
If i Mod Cols = 0 Then
strChild = strChild & "<br>"
Else
strChild = strChild & " "
End If
End If
If ShowPropertyType = 0 Then
strChild = strChild & ""
ElseIf ShowPropertyType = 1 Then
strChild = strChild & "·"
Else
strChild = strChild & "<img src='" & ChannelUrl & "/images/" & ModuleName & "_common" & ShowPropertyType & ".gif' border='0'>"
End If
If rsChild("ClassType") = 1 Then
strChild = strChild & " <a class='childclass' href='" & GetClassUrl(rsChild("ParentDir"), rsChild("ClassDir"), rsChild("ClassID"), rsChild("ClassPurview")) & "'"
Else
strChild = strChild & " <a class='childclass' href='" & rsChild("LinkUrl") & "'"
End If
If OpenType = 3 Then
tOpenType = rsChild("OpenType")
Else
tOpenType = OpenType
End If
If tOpenType = 0 Then
strChild = strChild & " target=""_self"">"
Else
strChild = strChild & " target=""_blank"">"
End If
strChild = strChild & rsChild("ClassName") & "</a>"
If rsChild("Child") > 0 And ShowChildNum = True Then
strChild = strChild & "(" & rsChild("Child") & ")"
End If
rsChild.MoveNext
i = i + 1
Loop
End If
rsChild.Close
Set rsChild = Nothing
GetChildClass = strChild
End Function
Function GetClassUrl(sParentDir, sClassDir, iClassID, iClassPurview)
Dim strClassUrl
If (UseCreateHTML = 1 Or UseCreateHTML = 3) And iClassPurview < 2 Then
strClassUrl = ChannelUrl & GetListPath(StructureType, ListFileType, sParentDir, sClassDir) & GetListFileName(ListFileType, iClassID, 1, 1) & FileExt_List
Else
strClassUrl = ChannelUrl_ASPFile & "/ShowClass.asp?ClassID=" & iClassID
End If
GetClassUrl = strClassUrl
End Function
Function GetClass_1Url(sParentDir, sClassDir, iClassID, iClassPurview)
Dim strClassUrl
If (UseCreateHTML = 1 Or UseCreateHTML = 3) And iClassPurview < 2 Then
strClassUrl = ChannelUrl & GetListPath(StructureType, ListFileType, sParentDir, sClassDir) & GetList_1FileName(ListFileType, iClassID) & FileExt_List
Else
strClassUrl = ChannelUrl_ASPFile & "/ShowClass.asp?ShowType=2&ClassID=" & iClassID
End If
GetClass_1Url = strClassUrl
End Function
'**************************************************
'函数名：ReplaceText
'作 用：过滤非法字符串
'参 数：iText-----输入字符串
'返回值：替换后字符串
'**************************************************
Function ReplaceText(iText, iType)
Dim rText, rsKey, sqlKey, i, Keyrow, Keycol
If PE_Cache.GetValue("Site_ReplaceText") = "" Then
Set rsKey = Server.CreateObject("Adodb.RecordSet")
sqlKey = "Select Source,ReplaceText,OpenType,ReplaceType,Priority from PE_KeyLink where isUse=1 and LinkType=1 order by Priority"
rsKey.Open sqlKey, Conn, 1, 1
If Not (rsKey.BOF And rsKey.EOF) Then
PE_Cache.SetValue "Site_ReplaceText", rsKey.GetString(, , "|||", "@@@", "")
rsKey.Close
Set rsKey = Nothing
Else
rsKey.Close
Set rsKey = Nothing
ReplaceText = iText
Exit Function
End If
End If
rText = iText
Keyrow = Split(PE_Cache.GetValue("Site_ReplaceText"), "@@@")
For i = 0 To UBound(Keyrow) - 1
Keycol = Split(Keyrow(i), "|||")
If Int(Keycol(3)) = 0 Or Int(Keycol(3)) = iType Then rText = PE_Replace(rText, Keycol(0), Keycol(1))
Next
ReplaceText = rText
End Function
'==================================================
'函数名：GetVote
'作 用：显示网站调查
'参 数：无
'==================================================
Function GetVote()
Dim strVoteBody
If PE_Cache.CacheIsEmpty(ChannelID & "_Site_Vote") Then
Dim sqlVote, rsVote, i, strVote
sqlVote = "select * from PE_Vote where IsSelected=" & PE_True & " and (ChannelID=-1 or ChannelID=" & ChannelID & ") and IsItem=" & PE_False & " order by ID Desc"
Set rsVote = Conn.Execute(sqlVote)
If rsVote.BOF And rsVote.EOF Then
strVote = XmlText("Site", "ShowVote/VoteErr", " 没有任何调查")
Else
Dim j: j = 1
Dim strVoteContent
strVoteContent = XmlText("Site", "ShowVote/VoteBody", "<form name='VoteForm{$lid}' method='post' action='{$strInstallDir}vote.asp' target='_blank'> {$Title}<br>{$VoteBody}<br><input name='VoteType' type='hidden'value='{$VoteType}'><input name='Action' type='hidden' value='Vote'><input name='ID' type='hidden' value='{$ID}'><div align='center'><a href='javascript:VoteForm{$lid}.submit();'><img src='{$strInstallDir}images/voteSubmit.gif' width='52' height='18' border='0'></a> <a href='{$strInstallDir}Vote.asp?ID={$ID}&Action=Show' target='_blank'><img src='{$strInstallDir}images/voteView.gif' width='52' height='18' border='0'></a></div></form>")
Do While Not rsVote.EOF
If rsVote("VoteType") = "Single" Then
strVoteBody = ""
For i = 1 To 8
If Trim(rsVote("Select" & i) & "") = "" Then Exit For
strVoteBody = strVoteBody & "<input type='radio' name='VoteOption' value='" & i & "' style='border:0'>" & rsVote("Select" & i) & "<br>"
Next
Else
strVoteBody = ""
For i = 1 To 8
If Trim(rsVote("Select" & i) & "") = "" Then Exit For
strVoteBody = strVoteBody & "<input type='checkbox' name='VoteOption' value='" & i & "' style='border:0'>" & rsVote("Select" & i) & "<br>"
Next
End If
strVote = strVote & Replace(Replace(Replace(Replace(Replace(Replace(strVoteContent, "{$lid}", j), "{$strInstallDir}", strInstallDir), "{$Title}", rsVote("Title")), "{$VoteBody}", strVoteBody), "{$VoteType}", rsVote("VoteType")), "{$ID}", rsVote("ID"))
rsVote.MoveNext
j = j + 1
Loop
End If
rsVote.Close
Set rsVote = Nothing
PE_Cache.SetValue ChannelID & "_Site_Vote", strVote
Else
strVote = PE_Cache.GetValue(ChannelID & "_Site_Vote")
End If
GetVote = strVote
End Function
'==================================================
'函数名：ShowAnnounce
'作 用：显示本站公告信息
'参 数：ShowType ----显示方式，1为纵向，2为横向，3为输出DIV格式，4为输出RSS格式
' AnnounceNum ----最多显示多少条公告
' ShowAuthor ----是否显示公告发布人
' ShowDate ----是否显示公告发布日期
' ContentLen ----公告内容最多字符数，一个汉字=两个英文字符，为0时全部显示。
'==================================================
Function ShowAnnounce(ShowType, AnnounceNum, ShowAuthor, ShowDate, ContentLen)
Dim sqlAnnounce, rsAnnounce, i, strAnnounce, AnnounceInfo, strContent
If AnnounceNum > 0 And AnnounceNum <= 10 Then
sqlAnnounce = "select top " & AnnounceNum
Else
sqlAnnounce = "select top 10"
End If
If ContentLen < 0 Then
ContentLen = 100
End If
sqlAnnounce = sqlAnnounce & " * from PE_Announce where IsSelected=" & PE_True & " and (ChannelID=-1 or ChannelID=" & ChannelID & ") and (ShowType=0 or ShowType=1) and (OutTime=0 or OutTime>DateDiff(" & PE_DatePart_D & ",DateAndTime, " & PE_Now & ")) order by ID Desc"
Set rsAnnounce = Conn.Execute(sqlAnnounce)
If rsAnnounce.BOF And rsAnnounce.EOF Then
If ShowType < 4 Then strAnnounce = XmlText("Site", "ShowAnnounce/AnnounceErr", "<p> 没有公告</p>")
Else
If ShowType < 4 Then Set XMLDOM = Server.CreateObject("Microsoft.FreeThreadedXMLDOM")
Dim strAnnounceBody1, strAnnounceBody2
strAnnounceBody1 = XmlText("Site", "ShowAnnounce/AnnounceBody1", " <a class='AnnounceBody1' href='#' onclick=""javascript:window.open('{$strInstallDir}Announce.asp?ChannelID={$ChannelID}&ID={$ID}', 'newwindow', 'height=440, width=400, toolbar=no, menubar=no, scrollbars=auto, resizable=no, location=no, status=no')"" title='{$Content}'>{$title}{$AnnounceInfo}</a>")
strAnnounceBody2 = XmlText("Site", "ShowAnnounce/AnnounceBody2", " <a class='AnnounceBody2' href='#' onclick=""javascript:window.open('{$strInstallDir}Announce.asp?ChannelID={$ChannelID}&ID={$ID}', 'newwindow', 'height=440, width=400, toolbar=no, menubar=no, scrollbars=auto, resizable=no, location=no, status=no')"" title='{$Content}'>{$title}{$AnnounceInfo}</a>")
Do While Not rsAnnounce.EOF
AnnounceInfo = ""
Select Case ShowType
Case 1
If ShowAuthor = True Then
AnnounceInfo = AnnounceInfo & "<br><div align='right'>" & rsAnnounce("Author") & " "
End If
If ShowDate = True Then
If ShowAuthor = True Then
AnnounceInfo = AnnounceInfo & "<br>" & FormatDateTime(rsAnnounce("DateAndTime"), 1)
Else
AnnounceInfo = AnnounceInfo & "<br><div align='right'>" & FormatDateTime(rsAnnounce("DateAndTime"), 1)
End If
End If
If ShowAuthor = True Or ShowDate = True Then
AnnounceInfo = AnnounceInfo & "</div>"
End If
If ContentLen > 0 Then
strContent = GetSubStr(nohtml(PE_HtmlDecode(rsAnnounce("Content"))), ContentLen, False)
Else
strContent = nohtml(PE_HtmlDecode(rsAnnounce("Content")))
End If
strAnnounce = strAnnounce & Replace(Replace(Replace(Replace(Replace(Replace(strAnnounceBody1, "{$strInstallDir}", strInstallDir), "{$ChannelID}", ChannelID), "{$ID}", rsAnnounce("id")), "{$Content}", strContent), "{$title}", rsAnnounce("title")), "{$AnnounceInfo}", AnnounceInfo)
rsAnnounce.MoveNext
i = i + 1
If i < AnnounceNum Then strAnnounce = strAnnounce & "<hr>"
Case 2
If ShowAuthor = True Then
AnnounceInfo = AnnounceInfo & " [" & rsAnnounce("Author")
End If
If ShowDate = True Then
If ShowAuthor = True Then
AnnounceInfo = AnnounceInfo & " " & FormatDateTime(rsAnnounce("DateAndTime"), 1)
Else
AnnounceInfo = AnnounceInfo & " [" & FormatDateTime(rsAnnounce("DateAndTime"), 1)
End If
End If
If ShowAuthor = True Or ShowDate = True Then
AnnounceInfo = AnnounceInfo & "]"
End If
If ContentLen > 0 Then
strContent = GetSubStr(nohtml(PE_HtmlDecode(rsAnnounce("Content"))), ContentLen, False)
Else
strContent = nohtml(PE_HtmlDecode(rsAnnounce("Content")))
End If
strAnnounce = strAnnounce & Replace(Replace(Replace(Replace(Replace(Replace(strAnnounceBody2, "{$strInstallDir}", strInstallDir), "{$ChannelID}", ChannelID), "{$ID}", rsAnnounce("id")), "{$Content}", strContent), "{$title}", rsAnnounce("title")), "{$AnnounceInfo}", AnnounceInfo)
strAnnounce = strAnnounce & " "
rsAnnounce.MoveNext
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -