📄 function.asp
字号:
If ObjIsEmpty() Then loadShowarticleshiyu()
showarticleshiyu=value
end function
public sub loadShowarticleshiyu()
dim strtemp
strtemp = ""
dim trs,arrClassID,TitleStr,iClassID,strrow,strcol,i
dim sqlClassAD,rsClassAD,ClassAD
sqlClassAD="select * from Advertisement where IsSelected=True and (ChannelID=0 or ChannelID=" & ChannelID & ") and ADType=2 order by ID Desc"
Set rsClassAD=Execute(sqlClassAD)
if tmpdata="" then
strtemp = strtemp & "<tr><td height='60' class='tdbg_mainall'><font color='#ff9900'>· </font>"
strtemp = strtemp & "还没有任何栏目，请首先添加栏目。"
strtemp = strtemp & "</td></tr>"
else
strtemp = strtemp & "<tr><td class='tdbg_mainall'><table width='100%' border='0' cellspacing='0' cellpadding='0'></tr>"
strrow=Split(tmpdata,"@@@")
iClassID=0
for i = 0 to UBound(strrow)-1
strcol=Split(strrow(i),"|||")
strtemp = strtemp & "<td valign='top' width='49%'><table width='100%' border='0' cellspacing='0' cellpadding='0'>"
strtemp = strtemp & "<tr><td class='title_right'><table width='100%' border='0' cellspacing='0' cellpadding='0'>"
strtemp = strtemp & "<tr><td width='14'><img src='{$PicUrl}/h_cl1.gif' width='14' height='23'></td>"
strtemp = strtemp & "<td>"
arrClassID=strcol(0)
strtemp = strtemp & "<a href='" & strcol(3) & "?ClassID=" & strcol(0) & "'><strong>" & strcol(1) & "</strong></a>"
if strcol(5)>0 then
set trs=execute("select ClassID from ArticleClass where RootID=" & strcol(2) & " and Child=0 and LinkUrl=''")
do while not trs.eof
arrClassID=arrClassID & "," & trs(0)
trs.movenext
loop
end if
strtemp = strtemp & "</td><td width='60' align='right'>"
strtemp = strtemp & "<a href='" & strcol(3) & "?ClassID=" & strcol(0) & "'>more...</a> "
strtemp = strtemp & "</td>"
strtemp = strtemp & "</tr>"
strtemp = strtemp & "</table></td>"
strtemp = strtemp & "</tr>"
strtemp = strtemp & "<tr><td height='127' valign='top' class='tdbg_right'>"
sql="select top 6 A.ArticleID,A.ClassID,L.LayoutID,L.LayoutFileName,A.Title,A.Key,A.Author,A.CopyFrom,A.UpdateTime,A.Editor,A.TitleFontColor,A.TitleFontType,"
sql=sql & "A.Hits,A.OnTop,A.Hot,A.Elite,A.Passed,A.IncludePic,A.Stars,A.PaginationType,A.ReadLevel,A.ReadPoint,A.DefaultPicUrl from Article A"
sql=sql & " inner join Layout L on A.LayoutID=L.LayoutID where A.Deleted=False and A.Passed=True and A.ClassID in (" & arrClassID & ") order by A.OnTop,A.ArticleID desc"
set rsArticle=execute(sql)
if rsArticle.bof and rsArticle.eof then
strtemp = strtemp & "<font color='#ff9900'>· </font>此栏目没有任何文章"
else
strtemp = strtemp & ArticleContentshiyu(20,True,True,False,1,False,False)
end if
rsArticle.close
strtemp = strtemp & "</td>"
strtemp = strtemp & "</tr>"
strtemp = strtemp & "</table></td>"
iClassID=iClassID+1
if iClassID mod 2=0 then
strtemp = strtemp & "</tr>"
if not rsClassAD.bof and not rsClassAD.eof then
if rsClassAD("isflash")=true then
ClassAD= "<object classid='clsid:D27CDB6E-AE6D-11cf-96B8-444553540000' codebase='http://download.macromedia.com/pub/shockwave/cabs/flash/swflash.cab#version=5,0,0,0'"
if rsClassAD("ImgWidth")>0 then ClassAD = ClassAD & " width='" & rsClassAD("ImgWidth") & "'"
if rsClassAD("ImgHeight")>0 then ClassAD = ClassAD & " height='" & rsClassAD("ImgHeight") & "'"
ClassAD = ClassAD & "><param name='movie' value='" & rsClassAD("ImgUrl") & "'><param name='quality' value='high'><embed src='" & rsClassAD("ImgUrl") & "' pluginspage='http://www.macromedia.com/shockwave/download/index.cgi?P1_Prod_Version=ShockwaveFlash' type='application/x-shockwave-flash'"
if rsClassAD("ImgWidth")>0 then ClassAD = ClassAD & " width='" & rsClassAD("ImgWidth") & "'"
if rsClassAD("ImgHeight")>0 then ClassAD = ClassAD & " height='" & rsClassAD("ImgHeight") & "'"
ClassAD = ClassAD & "></embed></object>"
else
ClassAD ="<a href='" & rsClassAD("SiteUrl") & "' target='_blank' title='" & rsClassAD("SiteName") & "：" & rsClassAD("SiteUrl") & vbcrlf & rsClassAD("SiteIntro") & "'><img src='" & rsClassAD("ImgUrl") & "'"
if rsClassAD("ImgWidth")>0 then ClassAD = ClassAD & " width='" & rsClassAD("ImgWidth") & "'"
if rsClassAD("ImgHeight")>0 then ClassAD = ClassAD & " height='" & rsClassAD("ImgHeight") & "'"
ClassAD = ClassAD & " border='0'></a>"
end if
strtemp = strtemp & "<tr><td align='center' bgcolor='#E4EEFD' class='tdbg_mainall' colSpan='3'>"
strtemp = strtemp & ClassAD
strtemp = strtemp & "</td></tr>"
rsClassAD.movenext
end if
strtemp = strtemp & "</tr><tr><td height='6'></td></tr>"
else
strtemp = strtemp & "<td width='1%'></td>"
end if
next
end if
strtemp = strtemp & "</table></td></tr>"
value = strtemp
end sub
'其他处理函数(安全，字符过滤等)
Public Function Execute(Command)
If Not IsObject(Conn) Then ConnectionDatabase
If IsDeBug = 0 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
Set Execute = Conn.Execute(Command)
End If
SqlQueryNum = SqlQueryNum+1
End Function
Public Function strLength(str)
If isNull(str) Or Str = "" Then
StrLength = 0
Exit Function
End If
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
Next
strLength=t
Else
strLength=len(str)
End If
End Function
Public Function ChkBadWords(Str)
If IsNull(Str) Then Exit Function
Dim i
For i = 0 To Ubound(BadWords)
If i > UBound(rBadWord) Then
Str = Replace(Str,BadWords(i),"*")
Else
Str = Replace(Str,BadWords(i),rBadWord(i))
End If
Next
ChkBadWords = Str
End Function
Public Function Checkstr(Str)
dim tempcheckstr
tempcheckstr=str
If Isnull(Str) Then
CheckStr = ""
Exit Function
End If
CheckStr = Replace(tempcheckstr,"'","''")
End Function
End Class
'****************************
'模板处理类
'****************************
Class cls_Templates
Public html
Public Property Let Value(ByVal vNewValue)
Dim tmpstr:tmpstr = vNewValue
tmpstr = Replace(tmpstr,"{$PicUrl}",nt2003.Site_PicUrl)
html = Split(tmpstr,"|||")
End Property
End Class
'后台管理页面临时函数
Sub dvbbs_error()
Response.Write"<br>"
Response.Write"<table cellpadding=3 cellspacing=1 align=center class=""tableBorder"" style=""width:75%"">"
Response.Write"<tr align=center>"
Response.Write"<th width=""100%"" height=25 colspan=2>错误信息"
Response.Write"</td>"
Response.Write"</tr>"
Response.Write"<tr>"
Response.Write"<td width=""100%"" class=""Forumrow"" colspan=2>"
Response.Write ErrMsg
Response.Write"</td></tr>"
Response.Write"<tr>"
Response.Write"<td class=""Forumrow"" valign=middle colspan=2 align=center><a href=""javascript:history.go(-1)""><<返回上一页</a></td></tr>"
Response.Write"</table>"
Response.End
End Sub
Sub Dv_suc(info)
Response.Write"<br>"
Response.Write"<table cellpadding=0 cellspacing=0 align=center class=""tableBorder"" style=""width:75%"">"
Response.Write"<tr align=center>"
Response.Write"<th width=""100%"" height=25 colspan=2>成功信息"
Response.Write"</td>"
Response.Write"</tr>"
Response.Write"<tr>"
Response.Write"<td width=""100%"" class=""forumRowHighlight"" colspan=2 height=25>"
Response.Write info
Response.Write"</td></tr>"
Response.Write"<tr>"
Response.Write"<td class=""forumRowHighlight"" valign=middle colspan=2 align=center><a href="&Request.ServerVariables("HTTP_REFERER")&" ><<返回上一页</a></td></tr>"
Response.Write"</table>"
End Sub
dim UserLogined,UserName,UserLevel,ChargeType,UserPoint,ValidDays
'**************************************************
'函数名：gotTopic
'作 用：截字符串，汉字一个算两个字符，英文算一个字符
'参 数：str ----原字符串
' strlen ----截取长度
'返回值：截取后的字符串
'**************************************************
function gotTopic(str,strlen)
if str="" then
gotTopic=""
exit function
end if
dim l,t,c, i
str=replace(replace(replace(replace(str," "," "),""",chr(34)),">",">"),"<","<")
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
gotTopic=left(str,i) & "…"
exit for
else
gotTopic=str
end if
next
gotTopic=replace(replace(replace(replace(gotTopic," "," "),chr(34),"""),">",">"),"<","<")
end function
'**************************************************
'函数名：JoinChar
'作 用：向地址中加入 ? 或 &
'参 数：strUrl ----网址
'返回值：加了 ? 或 & 的网址
'**************************************************
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
'==================================================
'函数名：Announcestr
'作 用：显示本站公告信息
'参 数：ShowType ------显示方式，1为纵向，2为横向
' AnnounceNum ----最多显示多少条公告
'==================================================
function Announcestr(ShowType,AnnounceNum)
dim sqlAnnounce,rsAnnounce,i,tempAnnouncestr
if AnnounceNum>0 and AnnounceNum<=10 then
sqlAnnounce="select top " & AnnounceNum
else
sqlAnnounce="select top 10"
end if
sqlAnnounce=sqlAnnounce & " * from Announce where IsSelected=True and (ChannelID=0 or ChannelID=" & ChannelID & ") and (ShowType=0 or ShowType=1) order by ID Desc"
Set rsAnnounce= nt2003.execute(sqlAnnounce)
if rsAnnounce.bof and rsAnnounce.eof then
AnnounceCount=0
tempAnnouncestr="<p>当前没有任何公告！</p>"
else
AnnounceCount=rsAnnounce.recordcount
if ShowType=1 then
do while not rsAnnounce.eof
tempAnnouncestr=tempAnnouncestr&" <a href='#' onclick=""javascript:window.open('Announce.asp?ChannelID=" & ChannelID & "&ID=" & rsAnnounce("id") &"', 'newwindow', 'height=300, width=400, toolbar=no, menubar=no, scrollbars=auto, resizable=no, location=no, status=no')"" title='" & rsAnnounce("Content") & "'>" & rsAnnounce("title") & "</div><br><div align='right'>" & rsAnnounce("Author") & " <br>" & FormatDateTime(rsAnnounce("DateAndTime"),1) & "</a>"
rsAnnounce.movenext
i=i+1
if i<AnnounceCount then tempAnnouncestr=tempAnnouncestr& "<hr>"
loop
else
do while not rsAnnounce.eof
tempAnnouncestr=tempAnnouncestr& " <a href='#' onclick=""javascript:window.open('Announce.asp?ChannelID=" & ChannelID & "&ID=" & rsAnnounce("id") &"', 'newwindow', 'height=300, width=400, toolbar=no, menubar=no, scrollbars=auto, resizable=no, location=no, status=no')"" title='" & rsAnnounce("Content") & "' >" & rsAnnounce("title") & " [" & rsAnnounce("Author") & " " & FormatDateTime(rsAnnounce("DateAndTime"),1) & "]</a> "
rsAnnounce.movenext
loop
end if
end if
rsAnnounce.close
set rsAnnounce=nothing
Announcestr=tempAnnouncestr
end function
'**************************************************
'过程名：showpage
'作 用：显示“上一页 下一页”等信息
'参 数：sfilename ----链接地址
' totalnumber ----总数量
' maxperpage ----每页数量
' ShowTotal ----是否显示总数量
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -