|
|
发表于 2008-1-12 16:37:52
|
显示全部楼层
"
Next
Set Matches = Nothing
Set RegEx = Nothing
GetAllLinkTags = TempStr
End Function
Function GetOtherContent(Str,StartStr,LastStr)
On Error Resume Next
Dim RegEx,SearchStr,Matches,Matche
Str = Replace(Replace(Str,Chr(13),""),Chr(10),"")
StartStr = Replace(Replace(StartStr,Chr(13),""),Chr(10),"")
LastStr = Replace(Replace(LastStr,Chr(13),""),Chr(10),"")
SearchStr = StartStr & ".*" & LastStr
Set RegEx = New RegExp
RegEx.IgnoreCase = True
RegEx.Global = True
RegEx.Pattern = SearchStr
Set Matches = RegEx.Execute(Str)
For Each Matche In Matches
If Matche <> "" Then
GetOtherContent = Matche
RegEx.Pattern = StartStr
GetOtherContent = RegEx.Replace(GetOtherContent,"")
RegEx.Pattern = LastStr & ".*|\n"
GetOtherContent = RegEx.Replace(GetOtherContent,"")
Else
GetOtherContent = ""
End If
If Err.Number <> 0 Then
Err.Clear
GetOtherContent = ""
End If
Exit For
Next
End Function
Function FormatUrl(NewsLinkStr,ObjUrl)
Dim URLSearchLoc
If Left(LCase(NewsLinkStr),7) <> "http://" Then
Dim CheckURLStr,TempCollectObjUrl,CheckObjUrl
NewsLinkStr = Replace(Replace(Replace(NewsLinkStr,"'",""),"""","")," ","")
TempCollectObjUrl = Left(ObjUrl,InStrRev(ObjUrl,"/"))
CheckObjUrl = NewsLinkStr
CheckURLStr = Left(NewsLinkStr,3)
If Left(NewsLinkStr,1) = "/" Then
URLSearchLoc = InStr(ObjUrl,"//") + 2
FormatUrl = Left(ObjUrl,InStr(URLSearchLoc,ObjUrl,"/") - 1)
FormatUrl = FormatUrl & NewsLinkStr
ElseIf CheckURLStr = "../" Then
Do While Not CheckURLStr <> "../"
CheckObjUrl = Mid(CheckObjUrl,4)
If Right(TempCollectObjUrl,1) = "/" Then TempCollectObjUrl = Left(TempCollectObjUrl,Len(TempCollectObjUrl) - 1)
TempCollectObjUrl = Left(TempCollectObjUrl,InStrRev(TempCollectObjUrl,"/"))
CheckURLStr = Left(CheckObjUrl,3)
Loop
FormatUrl = TempCollectObjUrl & CheckObjUrl
Else
FormatUrl = TempCollectObjUrl & NewsLinkStr
End If
Else
FormatUrl = NewsLinkStr
End If
End Function
Function ReplaceContentStr(ContentStr)
Dim TempContentStr
TempContentStr = ContentStr
If RuleDataBox(14,0) = 1 Then
TempContentStr = LoseHtml(TempContentStr)
Else
TempContentStr = LoseNoteTag(TempContentStr)
If RuleDataBox(15,0) = 1 Then TempContentStr = LoseStyleTag(TempContentStr)
If RuleDataBox(16,0) = 1 Then TempContentStr = LoseDivTag(TempContentStr)
If RuleDataBox(17,0) = 1 Then TempContentStr = LoseATag(TempContentStr)
If RuleDataBox(18,0) = 1 Then TempContentStr = LoseFontTag(TempContentStr)
If RuleDataBox(19,0) = 1 Then TempContentStr = LoseSpanTag(TempContentStr)
If RuleDataBox(20,0) = 1 Then TempContentStr = LoseObjectTag(TempContentStr)
If RuleDataBox(21,0) = 1 Then TempContentStr = LoseIFrameTag(TempContentStr)
If RuleDataBox(22,0) = 1 Then TempContentStr = LoseScriptTag(TempContentStr)
If RuleDataBox(23,0) = 1 Then TempContentStr = LoseClassTag(TempContentStr)
TempContentStr = LoseTableTag(TempContentStr)
TempContentStr = LoseTDTag(TempContentStr)
TempContentStr = LoseTRTag(TempContentStr)
End If
ReplaceContentStr = TempContentStr
End Function
Function CNReplaceContentStr(ContentStr)
Dim TempContentStr
TempContentStr = ContentStr
If CNRuleDataBox(14,0) = 1 Then
TempContentStr = LoseHtml(TempContentStr)
Else
TempContentStr = LoseNoteTag(TempContentStr)
If CNRuleDataBox(15,0) = 1 Then TempContentStr = LoseStyleTag(TempContentStr)
If CNRuleDataBox(16,0) = 1 Then TempContentStr = LoseDivTag(TempContentStr)
If CNRuleDataBox(17,0) = 1 Then TempContentStr = LoseATag(TempContentStr)
If CNRuleDataBox(18,0) = 1 Then TempContentStr = LoseFontTag(TempContentStr)
If CNRuleDataBox(19,0) = 1 Then TempContentStr = LoseSpanTag(TempContentStr)
If CNRuleDataBox(20,0) = 1 Then TempContentStr = LoseObjectTag(TempContentStr)
If CNRuleDataBox(21,0) = 1 Then TempContentStr = LoseIFrameTag(TempContentStr)
If CNRuleDataBox(22,0) = 1 Then TempContentStr = LoseScriptTag(TempContentStr)
If CNRuleDataBox(23,0) = 1 Then TempContentStr = LoseClassTag(TempContentStr)
TempContentStr = LoseTableTag(TempContentStr)
TempContentStr = LoseTDTag(TempContentStr)
TempContentStr = LoseTRTag(TempContentStr)
End If
CNReplaceContentStr = TempContentStr
End Function
Function LoseHtml(ContentStr)
Dim ClsTempLoseStr,RegEx
ClsTempLoseStr = Cstr(ContentStr)
Set RegEx = New RegExp
RegEx.Pattern = "<\/*[^<>]*>"
RegEx.IgnoreCase = True
RegEx.Global = True
ClsTempLoseStr = RegEx.Replace(ClsTempLoseStr,"")
Set RegEx = Nothing
LoseHtml = ClsTempLoseStr
End function
Function LoseClassTag(ContentStr)
Dim ClsTempLoseStr,RegEx
ClsTempLoseStr = Cstr(ContentStr)
Set RegEx = New RegExp
RegEx.Pattern = "(class=){1,}(""|\'){0,1}\S+(""|\'|>|\s){0,1}"
RegEx.IgnoreCase = True
RegEx.Global = True
ClsTempLoseStr = RegEx.Replace(ClsTempLoseStr,"")
LoseClassTag = ClsTempLoseStr
Set RegEx = Nothing
End Function
Function LoseScriptTag(ContentStr)
Dim ClsTempLoseStr,RegEx
ClsTempLoseStr = Cstr(ContentStr)
Set RegEx = New RegExp
RegEx.Pattern = "(<script){1,}[^<>]*>[^\0]*(<\/script>){1,}"
RegEx.IgnoreCase = True
RegEx.Global = True
ClsTempLoseStr = RegEx.Replace(ClsTempLoseStr,"")
LoseScriptTag = ClsTempLoseStr
Set RegEx = Nothing
End Function
Function LoseIFrameTag(ContentStr)
Dim ClsTempLoseStr,RegEx
ClsTempLoseStr = Cstr(ContentStr)
Set RegEx = New RegExp
RegEx.Pattern = "(<iframe){1,}[^<>]*>[^\0]*(<\/iframe>){1,}"
RegEx.IgnoreCase = True
RegEx.Global = True
ClsTempLoseStr = RegEx.Replace(ClsTempLoseStr,"")
LoseIFrameTag = ClsTempLoseStr
Set RegEx = Nothing
End Function
Function LoseObjectTag(ContentStr)
Dim ClsTempLoseStr,RegEx
ClsTempLoseStr = Cstr(ContentStr)
Set RegEx = New RegExp
RegEx.Pattern = "(<object){1,}[^<>]*>[^\0]*(<\/object>){1,}"
RegEx.IgnoreCase = True
RegEx.Global = True
ClsTempLoseStr = RegEx.Replace(ClsTempLoseStr,"")
LoseObjectTag = ClsTempLoseStr
Set RegEx = Nothing
End Function
Function LoseSpanTag(ContentStr)
Dim ClsTempLoseStr,RegEx
ClsTempLoseStr = Cstr(ContentStr)
Set RegEx = New RegExp
RegEx.Pattern = "<(\/){0,1}span[^<>]*>"
RegEx.IgnoreCase = True
RegEx.Global = True
ClsTempLoseStr = RegEx.Replace(ClsTempLoseStr,"")
LoseSpanTag = ClsTempLoseStr
Set RegEx = Nothing
End Function
Function LoseFontTag(ContentStr)
Dim ClsTempLoseStr,RegEx
ClsTempLoseStr = Cstr(ContentStr)
Set RegEx = New RegExp
RegEx.Pattern = "<(\/){0,1}font[^<>]*>"
RegEx.IgnoreCase = True
RegEx.Global = True
ClsTempLoseStr = RegEx.Replace(ClsTempLoseStr,"")
LoseFontTag = ClsTempLoseStr
Set RegEx = Nothing
End Function
Function LoseATag(ContentStr)
Dim ClsTempLoseStr,RegEx
ClsTempLoseStr = Cstr(ContentStr)
Set RegEx = New RegExp
RegEx.Pattern = "<(\/){0,1}a[^<>]*>"
RegEx.IgnoreCase = True
RegEx.Global = True
ClsTempLoseStr = RegEx.Replace(ClsTempLoseStr,"")
LoseATag = ClsTempLoseStr
Set RegEx = Nothing
End Function
Function LoseDivTag(ContentStr)
Dim ClsTempLoseStr,RegEx
ClsTempLoseStr = Cstr(ContentStr)
Set RegEx = New RegExp
RegEx.Pattern = "<(\/){0,1}div[^<>]*>"
RegEx.IgnoreCase = True
RegEx.Global = True
ClsTempLoseStr = RegEx.Replace(ClsTempLoseStr,"")
LoseDivTag = ClsTempLoseStr
Set RegEx = Nothing
End Function
Function LoseStyleTag(ContentStr)
Dim ClsTempLoseStr,RegEx
ClsTempLoseStr = Cstr(ContentStr)
Set RegEx = New RegExp
RegEx.Pattern = "(<style){1,}[^<>]*>[^\0]*(<\/style>){1,}"
RegEx.IgnoreCase = True
RegEx.Global = True
ClsTempLoseStr = RegEx.Replace(ClsTempLoseStr,"")
LoseStyleTag = ClsTempLoseStr
Set RegEx = Nothing
End Function
Function LoseNoteTag(ContentStr)
Dim ClsTempLoseStr,RegEx
ClsTempLoseStr = Cstr(ContentStr)
Set RegEx = New RegExp
RegEx.Pattern = "<!--\/*[^<>]*-->"
RegEx.IgnoreCase = True
RegEx.Global = True
ClsTempLoseStr = RegEx.Replace(ClsTempLoseStr,"")
LoseNoteTag = ClsTempLoseStr
Set RegEx = Nothing
End Function
Function LoseTableTag(ContentStr)
Dim ClsTempLoseStr,RegEx
ClsTempLoseStr = Cstr(ContentStr)
Set RegEx = New RegExp
RegEx.Pattern = "<(\/){0,1}table[^<>]*>"
RegEx.IgnoreCase = True
RegEx.Global = True
ClsTempLoseStr = RegEx.Replace(ClsTempLoseStr,"")
LoseTableTag = ClsTempLoseStr
Set RegEx = Nothing
End Function
Function LoseTDTag(ContentStr)
Dim ClsTempLoseStr,RegEx
ClsTempLoseStr = Cstr(ContentStr)
Set RegEx = New RegExp
RegEx.Pattern = "<(\/){0,1}td[^<>]*>"
RegEx.IgnoreCase = True
RegEx.Global = True
ClsTempLoseStr = RegEx.Replace(ClsTempLoseStr,"")
LoseTDTag = ClsTempLoseStr
Set RegEx = Nothing
End Function
Function LoseTRTag(ContentStr)
Dim ClsTempLoseStr,RegEx
ClsTempLoseStr = Cstr(ContentStr)
Set RegEx = New RegExp
RegEx.Pattern = "<(\/){0,1}tr[^<>]*>"
RegEx.IgnoreCase = True
RegEx.Global = True
ClsTempLoseStr = RegEx.Replace(ClsTempLoseStr,"")
LoseTRTag = ClsTempLoseStr
Set RegEx = Nothing
End Function
%>
asp常用函数集合，非常不错以后研究
<%
function loadtempletfile(byval path)
on error resume next
dim objstream
set objstream = server.createobject("adodb.stream")
with objstream
.type = 2
.mode = 3
.open
.loadfromfile server.mappath(path)
if err.number <> 0 then
err.clear
response.write("预加载的模板[" & path & "]不存在!")
response.end()
end if
.charset = "" & chrset & ""
.position = 2
loadtempletfile = .readtext
.close
end with
set objstream = nothing
end function
function movefiles(sFolder,dFolder)
on error resume next
dim fso
set fso = server.createobject("scripting.filesystemobject")
if fso.folderexists(server.mappath(sFolder)) and fso.folderexists(server.mappath(dFolder)) then
fso.copyfolder server.mappath(sFolder),server.mappath(dFolder)
movefiles = true
else
movefiles = false
set fso = nothing
call alertbox("系统没有找到指定的路径[" & sFolder & "]!",2)
end if
set fso = nothing
end function
function renamefolder(sFolder,dFolder)
on error resume next
dim fso
set fso = server.createobject("scripting.filesystemobject")
if fso.folderexists(server.mappath(sFolder)) then
fso.movefolder server.mappath(sFolder),server.mappath(dFolder)
renamefolder = true
else
renamefolder = false
set fso = nothing
call alertbox("系统没有找到指定的路径[" & sFolder & "]!",2)
end if
set fso = nothing
end function
function checkfolder(sPATH)
on error resume next
dim fso
set fso = server.createobject("scripting.filesystemobject")
if fso.folderexists(server.mappath(sPATH)) then
checkfolder = true
else
checkfolder = false
end if
set fso = nothing
end function
function checkfile(sPATH)
on error resume next
dim fso
set fso = server.createobject("scripting.filesystemobject")
if fso.fileexists(server.mappath(sPATH)) then
checkfile = true
else
checkfile = false
end if
set fso = nothing
end function
function createdir(sPATH)
dim fso,pathArr,i,path_Level,pathTmp,cPATH
on error resume next
sPATH = replace(sPATH,"\","/")
set fso = server.createobject("scripting.filesystemobject")
pathArr = split(sPATH,"/")
path_Level = ubound(pathArr)
for i = 0 to path_Level
if i = 0 then pathTmp = pathArr(0) & "/" else pathTmp = pathTmp&pathArr(i) & "/"
cPATH = left(pathTmp,len(pathTmp)-1)
if not fso.folderexists(cPATH) then fso.createfolder(cPATH)
next
set fso = nothing
if err.number <> 0 then
err.clear
createdir = false
else
createdir = true
end if
end function
function delclassfolder(sPATH)
on error resume next
dim fso
set fso = server.createobject("scripting.filesystemobject")
if fso.folderexists(server.mappath(sPATH)) then
fso.deletefolder(server.mappath(sPATH))
end if
set fso = nothing
end function
function delnewsfile(sPATH,filename)
on error resume next
dim fso,tempArr,cPATH,ePATH,i:i = 0
set fso = server.createobject("scripting.filesystemobject")
sPATH = sPATH & filename & site_extname
if fso.fileexists(server.mappath(sPATH)) then
fso.deletefile(server.mappath(sPATH))
while(i <> -1)
i = i + 1
ePATH = replace(sPATH,filename & ".",filename & "_" & i + 1 & ".")
if fso.fileexists(server.mappath(ePATH)) then
fso.deletefile(server.mappath(ePATH))
else
i = -1
end if
wend
end if
end function
class stringclass
public function getstr(strhtml)
dim PatrnStr
PatrnStr="<.*?>"
dim objRegEx
set objRegEx = new RegExp
objRegEx.pattern = PatrnStr
objRegEx.ignorecase = true
objRegEx.global = true
getstr = objRegEx.replace(strhtml,"")
set objRegEx = nothing
end function
public function replacestr(patrn,mstr,replstr)
dim objRegEx
set objRegEx = new RegExp
objRegEx.pattern = patrn
objRegEx.ignorecase = true
objRegEx.global = true
replacestr = objRegEx.replace(mstr,replstr)
set objRegEx = nothing
end function
public function classcustomtag(byval patrn,byval mstr,byval classid,byval indexid,byval pagestr)
dim objRegEx,match,matches
set objRegEx = new RegExp
objRegEx.pattern = patrn
objRegEx.ignorecase = true
objRegEx.global = true
set matches = objRegEx.execute(mstr)
for each match in matches
mstr = replace(mstr,match.value,parseclasstag(match.value,classid,indexid,pagestr))
next
set matches = nothing
set objRegEx = nothing
classcustomtag = mstr
end function
public function newscustomtag(byval patrn,byval mstr,byval classid,byval newsid,byval keywords)
dim objRegEx,match,matches
set objRegEx = new RegExp
objRegEx.pattern = patrn
objRegEx.ignorecase = true
objRegEx.global = true
set matches = objRegEx.execute(mstr)
for each match in matches
mstr = replace(mstr,match.value,parsenewstag(match.value,classid,newsid,keywords))
next
set matches = nothing
set objRegEx = nothing
newscustomtag = mstr
end function
end class
function processcustomtag(byval scontent)
dim objRegEx,match,matches
set objRegEx = new RegExp
objRegEx.pattern = "{ncms:[^<>]+?\/}"
objRegEx.ignorecase = true
objRegEx.global = true
set matches = objRegEx.execute(scontent)
for each match in matches
scontent = replace(scontent,match.value,parsetag(match.value))
next
set matches = nothing
set objRegEx = nothing
processcustomtag = scontent
end function
function X_processcustomtag(byval scontent)
dim objRegEx,match,matches
set objRegEx = new RegExp
objRegEx.pattern = "(\[ncms:).+?(\])(.|\n)+?(\[\/ncms\])"
objRegEx.ignorecase = true
objRegEx.global = true
set matches = objRegEx.execute(scontent)
for each match in matches
scontent = replace(scontent,match.value,parsetag(match.value))
next
set matches = nothing
set objRegEx = nothing
X_processcustomtag = scontent
end function
function getattribute(byval strattribute,byval strtag)
dim objRegEx,matches
set objRegEx = new RegExp
objRegEx.pattern = lcase(strattribute)&"=""[0-9a-zA-Z]*"""
objRegEx.ignorecase = true
objRegEx.global = true
set matches = objRegEx.execute(strtag)
if matches.count > 0 then
getattribute = split(matches(0).value,"""")(1)
else
getattribute = ""
end if
set matches = nothing
set objRegEx = nothing
end function
function getinnerhtml(byval strhtml)
dim objregex,matches,str
set objregex = new regexp
objregex.pattern = "(\])(.|\n)+?(\[\/ncms\])"
objregex.ignorecase = true
objregex.global = false
set matches = objregex.execute(strhtml)
if matches.count > 0 then
str = trim(matches.item(0).value)
end if
set matches = nothing
if len(str) > 8 then
getinnerhtml = mid(str,2,len(str) - 8)
end if
end function
function parsetag(byval strtag)
dim arrresult,classname,arrattributes,objclass
if len(strtag) = 0 then exit function
arrresult = split(strtag,":")
classname = split(arrresult(1)," ")(0)
select case lcase(classname)
case "news"
set objclass = new ncmsnewstag
if not isnumeric(getattribute("id",strtag)) then
response.write("标签[ncms:news]参数错误!参数[id]必须是数字!")
response.end()
end if
objclass.id = getattribute("id",strtag)
if not isnumeric(getattribute("num",strtag)) then
response.write("标签[ncms:news]参数错误!参数[num]必须是数字!")
response.end()
end if
objclass.num = getattribute("num",strtag)
if not isnumeric(getattribute("len",strtag)) then
response.write("标签[ncms:news]参数错误!参数[len]必须是数字!")
response.end()
end if
objclass.len = getattribute("len",strtag)
objclass.show = getattribute("show",strtag)
if getattribute("lih",strtag) <> "" and not isnumeric(getattribute("lih",strtag)) then
response.write("标签[ncms:news]参数错误!参数[lih]必须是数字!")
response.end()
end if
objclass.lih = getattribute("lih",strtag)
if getattribute("imgw",strtag) <> "" and not isnumeric(getattribute("imgw",strtag)) then
response.write("标签[ncms:news]参数错误!参数[imgw]必须是数字!")
response.end()
end if
objclass.imgw = getattribute("imgw",strtag)
if getattribute("imgh",strtag) <> "" and not isnumeric(getattribute("imgh",strtag)) then
response.write("标签[ncms:news]参数错误!参数[imgh]必须是数字!")
response.end()
end if
objclass.imgh = getattribute("imgh",strtag)
if getattribute("tgt",strtag) <> "" and getattribute("tgt",strtag) <> "blank" then
response.write("标签[ncms:news]参数错误!参数[tgt]必须是[<font color=""red"">blank</font>]!")
response.end()
end if
objclass.tgt = getattribute("tgt",strtag)
if getattribute("hit",strtag) <> "" and not isnumeric(getattribute("hit",strtag)) then
response.write("标签[ncms:free]参数错误!参数[hit]必须是数字!")
response.end()
end if
objclass.hit = getattribute("hit",strtag)
if not isnumeric(getattribute("col",strtag)) then
response.write("标签[ncms:news]参数错误!参数[col]必须是数字!")
response.end()
end if
parsetag = objclass.newsshow(getattribute("ty",strtag),getattribute("col",strtag))
set objclass = nothing
case "free"
set objclass = new X_ncmsnewstag
if not isnumeric(getattribute("id",strtag)) then
response.write("标签[ncms:free]参数错误!参数[id]必须是数字!")
response.end()
end if
objclass.id = getattribute("id",strtag)
if not isnumeric(getattribute("num",strtag)) then
response.write("标签[ncms:free]参数错误!参数[num]必须是数字!")
response.end()
end if
objclass.num = getattribute("num",strtag)
if not isnumeric(getattribute("len",strtag)) then
response.write("标签[news:free]参数错误!参数[len]必须是数字!")
response.end()
end if
objclass.len = getattribute("len",strtag)
objclass.show = getattribute("show",strtag)
if getattribute("lih",strtag) <> "" and not isnumeric(getattribute("lih",strtag)) then
response.write("标签[ncms:free]参数错误!参数[lih]必须是数字!")
response.end()
end if
objclass.lih = getattribute("lih",strtag)
if getattribute("hit",strtag) <> "" and not isnumeric(getattribute("hit",strtag)) then
response.write("标签[ncms:free]参数错误!参数[hit]必须是数字!")
response.end()
end if
objclass.hit = getattribute("hit",strtag)
if not isnumeric(getattribute("col",strtag)) then
response.write("标签[ncms:free]参数错误!参数[col]必须是数字!")
response.end()
end if
parsetag = objclass.newsshow(getattribute("ty",strtag),getattribute("col",strtag),getinnerhtml(strtag))
case "menu"
set objclass = new ncmsmenutag
parsetag = objclass.menushow(getattribute("show",strtag))
set objclass = nothing
case "info"
set objclass = new ncmsinfotag
if not isnumeric(getattribute("num",strtag)) then
response.write("标签[ncms:info]参数错误!参数[num]必须是数字!")
response.end()
end if
objclass.num = getattribute("num",strtag)
if not isnumeric(getattribute("len",strtag)) then
response.write("标签[ncms:info]参数错误!参数[len]必须是数字!")
response.end()
end if
objclass.len = getattribute("len",strtag)
parsetag = objclass.infoshow()
set objclass = nothing
case "head"
set objclass = new ncmsheadtag
if not isnumeric(getattribute("num",strtag)) then
response.write("标签[ncms:head]参数错误!参数[num]必须是数字!")
response.end()
elseif getattribute("num",strtag) > 6 then
response.write("标签[ncms:head]参数错误!参数[num]在[1-6]之间!")
response.end()
end if
objclass.num = getattribute("num",strtag)
if not isnumeric(getattribute("len",strtag)) then
response.write("标签[ncms:head]参数错误!参数[len]必须是数字!")
response.end()
end if
objclass.len = getattribute("len",strtag)
if getattribute("imgw",strtag) <> "" and not isnumeric(getattribute("imgw",strtag)) then
response.write("标签[ncms:head]参数错误!参数[imgw]必须是数字!")
response.end()
end if
objclass.imgw = getattribute("imgw",strtag)
if getattribute("imgh",strtag) <> "" and not isnumeric(getattribute("imgh",strtag)) then
response.write("标签[ncms:head]参数错误!参数[imgh]必须是数字!")
response.end()
end if
objclass.imgh = getattribute("imgh",strtag)
if getattribute("size",strtag) <> "" and not isnumeric(getattribute("size",strtag)) then
response.write("标签[ncms:head]参数错误!参数[size]必须是数字!")
response.end()
end if
objclass.size = getattribute("size",strtag)
parsetag = objclass.headshow(getattribute("ty",strtag))
set objclass = nothing
case "link"
set objclass = new ncmslinktag
if not isnumeric(getattribute("num",strtag)) then
response.write("标签[ncms:link]参数错误!参数[num]必须是数字!")
response.end()
end if
objclass.num = getattribute("num",strtag)
if not isnumeric(getattribute("col",strtag)) then
response.write("标签[ncms:link]参数错误!参数[col]必须是数字!")
response.end()
end if
parsetag = objclass.linkshow(getattribute("ty",strtag),getattribute("col",strtag))
set objclass = nothing
case else
response.write("标签[ncms:xxx]构造错误!")
response.end()
end select
end function
function parseclasstag(byval strtag,byval classid,byval indexid,byval pagestr)
dim arrresult,classname,arrattributes,objclass
if len(strtag) = 0 then exit function
arrresult = split(strtag,":")
classname = split(arrresult(1)," ")(0)
select case lcase(classname)
case "list"
set objclass = new ncmsclasstag
if not isnumeric(getattribute("len",strtag)) then
response.write("标签[news:list]参数错误!参数[len]必须是数字!")
response.end()
end if
objclass.len = getattribute("len",strtag)
objclass.order = getattribute("order",strtag)
if getattribute("lih",strtag) <> "" and not isnumeric(getattribute("lih",strtag)) then
response.write("标签[news:list]参数错误!参数[lih]必须是数字!")
response.end()
end if
objclass.lih = getattribute("lih",strtag)
if not isnumeric(getattribute("col",strtag)) then
response.write("标签[news:list]参数错误!参数[col]必须是数字!")
response.end()
end if
parseclasstag = objclass.classshow(getattribute("ty",strtag),getattribute("col",strtag),classid,indexid,pagestr)
set objclass = nothing
case else
response.write("标签[news:xxxx]构造错误!")
response.end()
end select
end function
function parsenewstag(byval strtag,byval classid,byval newsid,byval keywords)
dim arrresult,classname,arrattributes,objclass
if len(strtag) = 0 then exit function
arrresult = split(strtag,":")
classname = split(arrresult(1)," ")(0)
select case lcase(classname)
case "relate"
set objclass = new ncmsrelatetag
if not isnumeric(getattribute("num",strtag)) then
response.write("标签[news:relate]参数错误!参数[num]必须是数字!")
response.end()
end if
objclass.num = getattribute("num",strtag)
if not isnumeric(getattribute("len",strtag)) then
response.write("标签[news:relate]参数错误!参数[len]必须是数字!")
response.end()
end if
objclass.len = getattribute("len",strtag)
if getattribute("lih",strtag) <> "" and not isnumeric(getattribute("lih",strtag)) then
response.write("标签[news:relate]参数错误!参数[lih]必须是数字!")
response.end()
end if
objclass.lih = getattribute("lih",strtag)
if not isnumeric(getattribute("col",strtag)) then
response.write("标签[news:relate]参数错误!参数[col]必须是数字!")
response.end()
end if
parsenewstag = objclass.relateshow(getattribute("col",strtag),classid,newsid,keywords)
set objclass = nothing
case "page"
set objclass = new ncmspagetag
parsenewstag = objclass.pageshow(getattribute("show",strtag),classid,newsid)
set objclass = nothing
case else
response.write("标签[news:xxxx]构造错误!")
response.end()
end select
end function
function getcurclasscount(classid)
dim rs,curclasscount
set rs = conn.execute("select count(*) from NCMS_news where classid in(" & classid & allchildclass(classid) & ")")
if instr(rs(0)/n_listnum,".") <> 0 then
curclasscount = fix(rs(0)/n_listnum) + 1
else
curclasscount = rs(0)/n_listnum
end if
rs.close:set rs = nothing
getcurclasscount = curclasscount
end function
class ncmsclasstag
public ty,len,order,lih
public function classshow(stype,scolumn,classid,indexid,pagestr)
dim TempHTM,xsql,rs,sql,databox,l,obox
TempHTM = "" & chr(10) & "<table cellpadding=""0"" cellspacing=""0"" width=""100%"" border=""0"">" & chr(10)
TempHTM = TempHTM & "<tr>" & chr(10)
if indexid = "" or indexid = 0 then
indexid = 1
end if
select case stype
case "text"
set rs = server.createobject("adodb.recordset")
if order = "desc" then
sql = "select classid,title,click,filename,addtime from NCMS_news where classid in(" & classid & allchildclass(classid) & ") and created=1 and pagetype=0 order by id desc"
elseif order = "asc" then
sql = "select classid,title,click,filename,addtime from NCMS_news where classid in(" & classid & allchildclass(classid) & ") and created=1 and pagetype=0 order by id asc"
else
response.write("标签[news:list]参数[order]错误!")
response.end()
end if
rs.cursorlocation = 3
rs.open sql,conn,1,3
if rs.eof then
rs.close:set rs = nothing
TempHTM = "<li><font color=""red"">暂时没有新闻!</font></li>"
classshow = TempHTM
exit function
end if
rs.pagesize = n_listnum
rs.absolutepage = indexid
for l = 1 to rs.pagesize
if rs.eof then exit for
TempHTM = TempHTM & "<td height=""" & lih & """ align=""left"" valign=""middle"">·<a href=""" & site_root & "/" & site_html & "/" & getclasspath(rs("classid")) & "/" & rs("filename") & site_extname & """ title=""" & rs("title") & """>" & gottopic(rs("title"),len) & "</a></td>" & chr(10)
TempHTM = TempHTM & "<td height=""" & lih & """ align=""center"" valign=""middle"">" & rs("click") & "</td>" & chr(10)
TempHTM = TempHTM & "<td height=""" & lih & """ align=""center"" valign=""middle"">" & rs("addtime") & "</td>" & chr(10)
if l = rs.pagesize then
TempHTM = TempHTM & "</tr>" & chr(10)
else
if cint(l mod scolumn) = 0 then
TempHTM = TempHTM & "</tr>" & chr(10)
TempHTM = TempHTM & "<tr>" & chr(10)
end if
end if
rs.movenext
next
rs.close:set rs = nothing
TempHTM = TempHTM & "</table>" & chr(10)
classshow = TempHTM & pagestr
case "image"
if IsObjInstalled("persits.jpeg") = true and jpeg_gate = 0 then
set rs = server.createobject("adodb.recordset")
if order = "desc" then
sql = "select classid,title,bimg,filename,addtime from NCMS_news where classid in(" & classid & allchildclass(classid) & ") and isimg=1 and created=1 and pagetype=0 order by id desc"
elseif order = "asc" then
sql = "select classid,title,bimg,filename,addtime from NCMS_news where classid in(" & classid & allchildclass(classid) & ") and isimg=1 and created=1 and pagetype=0 order by id asc"
else
response.write("标签[news:list]参数[order]错误!")
response.end()
end if
rs.cursorlocation = 3
rs.open sql,conn,1,3
if rs.eof then
rs.close:set rs = nothing
TempHTM = "<li><font color=""red"">暂时没有新闻!</font></li>"
classshow = TempHTM
exit function
end if
rs.pagesize = n_listnum
rs.absolutepage = indexid
for l = 1 to rs.pagesize
if rs.eof then exit for
TempHTM = TempHTM & "<td><div id=""simg""><a href=""" & site_root & "/" & site_html & "/" & getclasspath(rs("classid")) & "/" & rs("filename") & site_extname & """><img height=""" & jpeg_height & """ src=""" & site_root & "/" & site_upload & "/" & site_simg & "/" & rs("bimg") & """ width=""" & jpeg_width & """ alt=""" & rs("title") & """ /></a></div></td>" & chr(10)
if l = rs.pagesize then
TempHTM = TempHTM & "</tr>" & chr(10)
else
if cint(l mod scolumn) = 0 then
TempHTM = TempHTM & "</tr>" & chr(10)
TempHTM = TempHTM & "<tr>" & chr(10)
end if
end if
if checkfile("" & site_root & "/" & site_upload & "/" & site_bimg & "/" & rs("bimg") & "") = true then
set obox = server.createobject("persits.jpeg")
obox.open server.mappath("" & site_root & "/" & site_upload & "/" & site_bimg & "/" & rs("bimg") & "")
obox.width = jpeg_width
obox.height = jpeg_height
obox.save server.mappath("" & site_root & "/" & site_upload & "/" & site_simg & "/" & rs("bimg") & "")
set obox = nothing
end if
rs.movenext
next
rs.close:set rs = nothing
TempHTM = TempHTM & "</table>" & chr(10)
classshow = TempHTM & pagestr
else
set rs = server.createobject("adodb.recordset")
if order = "desc" then
sql = "select classid,title,bimg,filename,addtime from NCMS_news where classid in(" & classid & allchildclass(classid) & ") and isimg=1 and created=1 and pagetype=0 order by id desc"
elseif order = "asc" then
sql = "select classid,title,bimg,filename,addtime from NCMS_news where classid in(" & classid & allchildclass(classid) & ") and isimg=1 and created=1 and pagetype=0 order by id asc"
else
response.write("标签[news:list]参数[order]错误!")
response.end()
end if
rs.cursorlocation = 3
rs.open sql,conn,1,3
if rs.eof then
rs.close:set rs = nothing
TempHTM = "<li><font color=""red"">暂时没有新闻!</font></li>"
classshow = TempHTM
exit function
end if
rs.pagesize = n_listnum
rs.absolutepage = indexid
for l = 1 to rs.pagesize
if rs.eof then exit for
TempHTM = TempHTM & "<td><div id=""simg""><a href=""" & site_root & "/" & site_html & "/" & getclasspath(rs("classid")) & "/" & rs("filename") & site_extname & """><img height=""" & jpeg_height & """ src=""" & site_root & "/" & site_upload & "/" & site_bimg & "/" & rs("bimg") & """ width=""" & jpeg_width & """ alt=""" & rs("title") & """ /></a></div></td>" & chr(10)
if l = rs.pagesize then
TempHTM = TempHTM & "</tr>" & chr(10)
else
if cint(l mod scolumn) = 0 then
TempHTM = TempHTM & "</tr>" & chr(10)
TempHTM = TempHTM & "<tr>" & chr(10)
end if
end if
rs.movenext
next
rs.close:set rs = nothing
TempHTM = TempHTM & "</table>" & chr(10)
classshow = TempHTM & pagestr
end if
case else
response.write("标签[news:list]参数[ty]错误!")
response.end()
end select
end function
end class
class ncmsnewstag
public id,ty,show,len,num,lih,imgw,imgh,tgt,hit
public function newsshow(stype,scolumn)
dim TempHTM,xsql,rs,databox,i,imgdot,obox
TempHTM = "" & chr(10) & "<table cellpadding=""0"" cellspacing=""0"" width=""100%"" border=""0"">" & chr(10)
TempHTM = TempHTM & "<tr>" & chr(10)
if tgt = "" then
tgt = "self"
end if
select case stype
case "text"
if show = "new" then
if id = 0 then
set rs = conn.execute("select top " & num & " classid,title,isimg,filename from NCMS_news where created=1 and pagetype=0 order by id desc")
else
set rs = conn.execute("select top " & num & " classid,title,isimg,filename from NCMS_news where classid in(" & id & allchildclass(id) & ") and created=1 and pagetype=0 order by id desc")
end if
elseif show = "elite" then
if id = 0 then
set rs = conn.execute("select top " & num & " classid,title,isimg,filename from NCMS_news where elite=1 and created=1 and pagetype=0 order by id desc")
else
set rs = conn.execute("select top " & num & " classid,title,isimg,filename from NCMS_news where classid in(" & id & allchildclass(id) & ") and elite=1 and created=1 and pagetype=0 order by id desc")
end if
elseif show = "hot" then
if id = 0 then
set rs = conn.execute("select top " & num & " classid,title,isimg,filename from NCMS_news where click>=" & hit & " and created=1 and pagetype=0 order by click desc")
else
set rs = conn.execute("select top " & num & " classid,title,isimg,filename from NCMS_news where classid in(" & id & allchildclass(id) & ") and click>=" & hit & " and created=1 and pagetype=0 order by click desc")
end if
else
response.write("标签[ncms:news]参数[show]错误!")
response.end()
end if
if rs.eof then
rs.close:set rs = nothing
TempHTM = "<li><font color=""red"">暂时没有新闻!</font></li>"
newsshow = TempHTM
exit function
else
databox = rs.getrows()
rs.close:set rs = nothing
for i = 0 to ubound(databox,2)
if databox(2,i) = 1 and show = "new" then
imgdot = "[<font color=""red"" size=""2"">图</font>]"
else
imgdot = ""
end if
TempHTM = TempHTM & "<td height=""" & lih & """ align=""left"" valign=""middle"">·<a href=""" & site_root & "/" & site_html & "/" & getclasspath(databox(0,i)) & "/" & databox(3,i) & site_extname & """ title=""" & databox(1,i) & """ target=""_" & tgt & """>" & gottopic(databox(1,i),len) & imgdot & "</a></td>" & chr(10)
if i = ubound(databox,2) then
TempHTM = TempHTM & "</tr>" & chr(10)
else
if cint((i+1) mod scolumn) = 0 then
TempHTM = TempHTM & "</tr>" & chr(10)
TempHTM = TempHTM & "<tr>" & chr(10)
end if
end if
next
databox = ""
TempHTM = TempHTM & "</table>" & chr(10)
newsshow = TempHTM
end if
case "image"
if IsObjInstalled("persits.jpeg") = true and jpeg_gate = 0 then
if show = "new" then
if id = 0 then
set rs = conn.execute("select top " & num & " classid,title,bimg,simg,filename from NCMS_news where isimg=1 and created=1 and pagetype=0 order by id desc")
else
set rs = conn.execute("select top " & num & " classid,title,bimg,simg,filename from NCMS_news where classid in(" & id & allchildclass(id) & ") and isimg=1 and created=1 and pagetype=0 order by id desc")
end if
elseif show = "elite" then
if id = 0 then
set rs = conn.execute("select top " & num & " classid,title,bimg,simg,filename from NCMS_news where elite=1 and isimg=1 and created=1 and pagetype=0 order by id desc")
else
set rs = conn.execute("select top " & num & " classid,title,bimg,simg,filename from NCMS_news where classid in(" & id & allchildclass(id) & ") and elite=1 and isimg=1 and created=1 and pagetype=0 order by id desc")
end if
elseif show = "hot" then
if id = 0 then
set rs = conn.execute("select top " & num & " classid,title,bimg,simg,filename from NCMS_news where click>=" & hit & " and isimg=1 and created=1 and pagetype=0 order by id desc")
else
set rs = conn.execute("select top " & num & " classid,title,bimg,simg,filename from NCMS_news where classid in(" & id & allchildclass(id) & ") and click>=" & hit & " and isimg=1 and created=1 and pagetype=0 order by id desc")
end if
else
response.write("标签[ncms:news]参数[show]错误!")
response.end()
end if
if rs.eof then
rs.close:set rs = nothing
TempHTM = "<li><font color=""red"">暂时没有新闻!</font></li>"
newsshow = TempHTM
exit function
else
databox = rs.getrows()
rs.close:set rs = nothing
for i = 0 to ubound(databox,2)
TempHTM = TempHTM & "<td>" & chr(10)
TempHTM = TempHTM & "<div id=""simg""><a href=""" & site_root & "/" & site_html & "/" & getclasspath(databox(0,i)) & "/" & databox(4,i) & site_extname & """ target=""_" & tgt & """><img src=""" & site_root & "/" & site_upload & "/" & site_simg & "/" & databox(2,i) & """ alt=""" & databox(1,i) & """ /><br />" & gottopic(databox(1,i),len) & "</a></div>" & chr(10)
TempHTM = TempHTM & "</td>" & chr(10)
if i = ubound(databox,2) then
TempHTM = TempHTM & "</tr>" & chr(10)
else
if cint((i+1) mod scolumn) = 0 then
TempHTM = TempHTM & "</tr>" & chr(10)
TempHTM = TempHTM & "<tr>" & chr(10)
end if
end if
if checkfile("" & site_root & "/" & site_upload & "/" & site_bimg & "/" & databox(2,i) & "") = true then
set obox = server.createobject("persits.jpeg")
obox.open server.mappath("" & site_root & "/" & site_upload & "/" & site_bimg & "/" & databox(2,i) & "")
if imgw = "" or imgh = "" then
obox.width = jpeg_width
obox.height = jpeg_height
else
obox.width = imgw
obox.height = imgh
end if
obox.save server.mappath("" & site_root & "/" & site_upload & "/" & site_simg & "/" & databox(3,i) & "")
set obox = nothing
end if
next
databox = ""
TempHTM = TempHTM & "</tr>" & chr(10)
TempHTM = TempHTM & "</table>" & chr(10)
newsshow = TempHTM
end if
else
if show = "new" then
if id = 0 then
set rs = conn.execute("select top " & num & " classid,title,bimg,filename from NCMS_news where isimg=1 and created=1 and pagetype=0 order by id desc")
else
set rs = conn.execute("select top " & num & " classid,title,bimg,filename from NCMS_news where classid in(" & id & allchildclass(id) & ") and isimg=1 and created=1 and pagetype=0 order by id desc")
end if
elseif show = "elite" then
if id = 0 then
set rs = conn.execute("select top " & num & " classid,title,bimg,filename from NCMS_news where elite=1 and isimg=1 and created=1 and pagetype=0 order by id desc")
else
set rs = conn.execute("select top " & num & " classid,title,bimg,filename from NCMS_news where classid in(" & id & allchildclass(id) & ") and elite=1 and isimg=1 and created=1 and pagetype=0 order by id desc")
end if
elseif show = "hot" then
if id = 0 then
set rs = conn.execute("select top " & num & " classid,title,bimg,filename from NCMS_news where click>=" & hit & " and isimg=1 and created=1 and pagetype=0 order by id desc")
else
set rs = conn.execute("select top " & num & " classid,title,bimg,filename from NCMS_news where classid in(" & id & allchildclass(id) & ") and click>=" & hit & " and isimg=1 and created=1 and pagetype=0 order by id desc")
end if
else
response.write("标签[ncms:news]参数[show]错误!")
response.end()
end if
if rs.eof then
rs.close:set rs = nothing
TempHTM = "<li><font color=""red"">暂时没有新闻!</font></li>"
newsshow = TempHTM
exit function
else
databox = rs.getrows()
rs.close:set rs = nothing
for i = 0 to ubound(databox,2)
TempHTM = TempHTM & "<td><div id=""simg""><a href=""" & site_root & "/" & site_html & "/" & getclasspath(databox(0,i)) & "/" & databox(3,i) & site_extname & """ target=""_" & tgt & """><img height=""" & jpeg_height & """ src=""" & site_root & "/" & site_upload & "/" & site_bimg & "/" & databox(2,i) & """ width=""" & jpeg_width & """ alt=""" & databox(1,i) & """ /></a></div></td>" & chr(10)
if i = ubound(databox,2) then
TempHTM = TempHTM & "</tr>" & chr(10)
else
if cint((i+1) mod scolumn) = 0 then
TempHTM = TempHTM & "</tr>" & chr(10)
TempHTM = TempHTM & "<tr>" & chr(10)
end if
end if
next
databox = ""
TempHTM = TempHTM & "</tr>" & chr(10)
TempHTM = TempHTM & "</table>" & chr(10)
newsshow = TempHTM
end if
end if
case else
response.write("标签[ncms:news]参数[ty]错误!")
response.end()
end select
end function
end class
class ncmsinfotag
public len,num
public function infoshow()
dim TempHTM,rs,databox,i
TempHTM = "" & chr(10) & "<table cellpadding=""0"" cellspacing=""0"" width=""100%"" border=""0"">" & chr(10)
TempHTM = TempHTM & "<tr>" & chr(10)
set rs = conn.execute("select top " & num & " content,addtime from NCMS_info order by addtime desc")
if rs.eof then
rs.close:set rs = nothing
TempHTM = "<li><font color=""red"">暂时没有公告信息!</font></li>"
infoshow = TempHTM
exit function
else
databox = rs.getrows()
rs.close:set rs = nothing
for i = 0 to ubound(databox,2)
TempHTM = TempHTM & "<td>" & gottopic(databox(0,i),len) & "(" & databox(1,i) & ")</td>" & chr(10)
next
databox = ""
TempHTM = TempHTM & "</tr>" & chr(10)
TempHTM = TempHTM & "</table>" & chr(10)
infoshow = TempHTM
end if
end function
end class
class ncmsheadtag
public ty,len,num,imgw,imgh,size
public function headshow(stype)
dim rs,databox,TempHTM,i,NcmsP,NcmsL,NcmsT,tempstr:tempstr = "|"
select case stype
case "text"
TempHTM = "" & chr(10) & "<table cellpadding=""0"" cellspacing=""0"" width=""100%"" border=""0"">" & chr(10)
set rs = conn.execute("select top " & num & " id,classid,title,content,filename from NCMS_news where head=1 and isimg=0 and created=1 and pagetype=0 order by id desc")
if rs.eof then
rs.close:set rs = nothing
TempHTM = "<li><font color=""red"">暂时没有头条新闻!</font></li>"
headshow = TempHTM
exit function
else
databox = rs.getrows()
rs.close:set rs = nothing
for i = 0 to ubound(databox,2)
TempHTM = TempHTM & "<tr><td><a href=""" & site_root & "/" & site_html & "/" & getclasspath(databox(1,i)) & "/" & databox(4,i) & site_extname & """ target=""_blank""><font size=""" & size & """><b>" & databox(2,i) & "</b></font></a></td></tr>" & chr(10)
TempHTM = TempHTM & "<tr><td>" & gottopic(LoseHtml(databox(3,i)),len) & "[<a href=""" & site_root & "/tools/comment.asp?newsid=" & databox(0,i) & "&newstitle=" & getnewstitle(databox(0,i)) & "#comment"" target=""_blank"" title=""评论""><font color=""red"" size=""2"">评论</font></a>]</td></tr>" & chr(10)
next
databox = ""
TempHTM = TempHTM & "</table>" & chr(10)
headshow = TempHTM
end if
case "image"
set rs = conn.execute("select top " & num & " classid,title,bimg,filename from NCMS_news where head=1 and isimg=1 and created=1 and pagetype=0 order by id desc")
if rs.eof then
rs.close:set rs = nothing
TempHTM = "<li><font color=""red"">暂时没有头条新闻!</font></li>"
headshow = TempHTM
exit function
else
databox = rs.getrows()
rs.close:set rs = nothing
for i = 0 to ubound(databox,2)
NcmsP = NcmsP & "" & site_root & "/" & site_upload & "/" & site_bimg & "/" & databox(2,i) & tempstr & ""
NcmsL = NcmsL & "" & site_root & "/" & site_html & "/" & getclasspath(databox(0,i)) & "/" & databox(3,i) & site_extname & tempstr & ""
NcmsT = NcmsT & "" & gottopic(databox(1,i),len) & tempstr & ""
next
databox = ""
TempHTM = TempHTM & "" & chr(10) & "<script language=""JavaScript"" type=""text/javascript"">" & chr(10)
TempHTM = TempHTM & "<!--" & chr(10)
TempHTM = TempHTM & "var NcmsPW = " & imgw & "" & chr(10)
TempHTM = TempHTM & "var NcmsPH = " & imgh & "" & chr(10)
TempHTM = TempHTM & "var NcmsTH = 0" & chr(10)
TempHTM = TempHTM & "var NcmsAH = NcmsPH + NcmsTH" & chr(10)
TempHTM = TempHTM & "var NcmsP = '" & left(NcmsP,strlength(NcmsP) - 1) & "'" & chr(10)
TempHTM = TempHTM & "var NcmsL = '" & left(NcmsL,strlength(NcmsL) - 1) & "'" & chr(10)
TempHTM = TempHTM & "var NcmsT = '" & left(NcmsT,strlength(NcmsT) - 1) & "'" & chr(10)
TempHTM = TempHTM & "document.write('<object classid=""clsid:d27cdb6e-ae6d-11cf-96b8-444553540000"" codebase=""http://fpdownload.macromedia.com/pub/shockwave/cabs/flash/swflash.cab#version=6,0,0,0"" width=""'+NcmsPW+'"" height=""'+NcmsAH+'"">');" & chr(10)
TempHTM = TempHTM & "document.write('<param name=""allowScriptAccess"" value=""sameDomain"">');" & chr(10)
TempHTM = TempHTM & "document.write('<param name=""movie"" value=""" & site_root & "/images/ncms/head.swf"">');" & chr(10)
TempHTM = TempHTM & "document.write('<param name=""quality"" value=""high"">');" & chr(10)
TempHTM = TempHTM & "document.write('<param name=""bgcolor"" value=""#252f3c"">');" & chr(10)
TempHTM = TempHTM & "document.write('<param name=""menu"" value=""false"">');" & chr(10)
TempHTM = TempHTM & "document.write('<param name=""wmode"" value=""opaque"">');" & chr(10)
TempHTM = TempHTM & "document.write('<param name=""FlashVars"" value=""pics='+NcmsP+'&links='+NcmsL+'&texts='+NcmsT+'&borderwidth='+NcmsPW+'&borderheight='+NcmsPH+'&NcmsTHeight='+NcmsTH+'"">');" & chr(10)
TempHTM = TempHTM & "document.write('<embed src=""" & site_root & "/images/ncms/head.swf"" wmode=""opaque"" FlashVars=""pics='+NcmsP+'&links='+NcmsL+'&texts='+NcmsT+'&borderwidth='+NcmsPW+'&borderheight='+NcmsPH+'&NcmsTHeight='+NcmsTH+'"" menu=""false"" bgcolor=""#252f3c"" quality=""high"" width=""'+NcmsPW+'"" height=""'+NcmsAH+'"" allowScriptAccess=""sameDomain"" type=""application/x-shockwave-flash"" pluginspage=""http://www.macromedia.com/go/getflashplayer"" />');" & chr(10)
TempHTM = TempHTM & "document.write('</object>');" & chr(10)
TempHTM = TempHTM & "//-->" & chr(10)
TempHTM = TempHTM & "</script>" & chr(10)
headshow = TempHTM
end if
case else
response.write("标签[ncms:head]参数[ty]错误!")
response.end()
end select
end function
end class
class ncmslinktag
public num,ty
public function linkshow(stype,scolumn)
dim TempHTM,rs,databox,i
TempHTM = "" & chr(10) & "<table cellpadding=""0"" cellspacing=""0"" width=""100%"" border=""0"">" & chr(10)
TempHTM = TempHTM & "<tr>" & chr(10)
select case stype
case "text"
set rs = conn.execute("select top " & num & " name,site from NCMS_link where kinds=0 order by orders asc")
if rs.eof then
rs.close:set rs = nothing
TempHTM = "<li><font color=""red"">暂时没有文字连接!</font></li>"
linkshow = TempHTM
exit function
else
databox = rs.getrows()
rs.close:set rs = nothing
for i = 0 to ubound(databox,2)
TempHTM = TempHTM & "<td><a href=""" & databox(1,i) & """ title=""" & databox(0,i) & """ target=""_blank"">" & databox(0,i) & "</a></td>" & chr(10)
if i = ubound(databox,2) then
TempHTM = TempHTM & "</tr>" & chr(10)
else
if cint((i+1) mod scolumn) = 0 then
TempHTM = TempHTM & "</tr>" & chr(10)
TempHTM = TempHTM & "<tr>" & chr(10)
end if
end if
next
databox = ""
TempHTM = TempHTM & "</table>" & chr(10)
linkshow = TempHTM
end if
case "image"
set rs = conn.execute("select top " & num & " name,site,logo from NCMS_link where kinds=1 order by orders asc")
if rs.eof then
rs.close:set rs = nothing
TempHTM = "<li><font color=""red"">暂时没有图片连接!</font></li>"
linkshow = TempHTM
exit function
else
databox = rs.getrows()
rs.close:set rs = nothing
for i = 0 to ubound(databox,2)
TempHTM = TempHTM & "<td><a href=""" & databox(1,i) & """ target=""_blank""><img src=""" & databox(2,i) & """ alt=""" & databox(0,i) & """ /></a></td>" & chr(10)
if i = ubound(databox,2) then
TempHTM = TempHTM & "</tr>" & chr(10)
else
if cint((i+1) mod scolumn) = 0 then
TempHTM = TempHTM & "</tr>" & chr(10)
TempHTM = TempHTM & "<tr>" & chr(10)
end if
end if
next
databox = ""
TempHTM = TempHTM & "</table>" & chr(10)
linkshow = TempHTM
end if
case else
response.write("标签[ncms:link]参数[ty]错误!")
response.end()
end select
end function
end class
class ncmsmenutag
public show
public function menushow(stype)
dim TempHTM,rs,databox,i,tempstr:tempstr = " | "
select case stype
case "center"
TempHTM = "" & chr(10) & "<div id=""navbox"">" & chr(10)
TempHTM = TempHTM & "<ul id=""nav"">" & chr(10)
set rs = conn.execute("select id,cname,ename,isout,isurl,link from NCMS_class where parent=0 and kinds=1 order by orders asc")
if rs.eof then
rs.close:set rs = nothing
TempHTM = ""
menushow = TempHTM
exit function
else
databox = rs.getrows()
rs.close:set rs = nothing
end if
for i = 0 to ubound(databox,2)
if databox(4,i) = 0 then
TempHTM = TempHTM & "<li><a href=""" & site_root & "/" & site_html & "/" & databox(2,i) & "/index" & site_extname & """ title=""" & databox(1,i) & """>" & databox(1,i) & "</a>" & childmenushow(databox(0,i)) & "</li>" & chr(10)
elseif databox(3,i) = 1 then
if databox(4,i) = 0 then
TempHTM = TempHTM & "<li><a href=""" & site_root & "/" & site_html & "/" & databox(2,i) & "/" & databox(5,i) & """ title=""" & databox(1,i) & """>" & databox(1,i) & "</a>" & childmenushow(databox(0,i)) & "</li>" & chr(10)
elseif databox(4,i) = 1 then
TempHTM = TempHTM & "<li><a href=""" & databox(5,i) & """ title=""" & databox(1,i) & """>" & databox(1,i) & "</a></li>" & chr(10)
end if
end if
next:databox = ""
TempHTM = TempHTM & "</ul>" & chr(10)
TempHTM = TempHTM & "</div>" & chr(10)
menushow = TempHTM
case "top"
set rs = conn.execute("select id,cname,ename,isout,isurl,link from NCMS_class where parent=0 and kinds=2 order by orders asc")
if rs.eof then
rs.close:set rs = nothing
TempHTM = ""
menushow = TempHTM
exit function
else
databox = rs.getrows()
rs.close:set rs = nothing
for i = 0 to ubound(databox,2)
if i = ubound(databox,2) then tempstr = ""
if databox(3,i) = 0 then
TempHTM = TempHTM & "<a href=""" & site_root & "/" & site_html & "/" & databox(2,i) & "/index" & site_extname & """>" & databox(1,i) & "</a>" & tempstr & ""
elseif databox(3,i) = 1 then
if databox(4,i) = 0 then
TempHTM = TempHTM & "<a href=""" & site_root & "/" & site_html & "/" & databox(2,i) & "/" & databox(5,i) & """>" & databox(1,i) & "</a>" & tempstr & ""
elseif databox(4,i) = 1 then
TempHTM = TempHTM & "<a href=""" & databox(5,i) & """>" & databox(1,i) & "</a>" & tempstr & ""
end if
end if
next
menushow = TempHTM
end if
case "bottom"
set rs = conn.execute("select id,cname,ename,isout,isurl,link from NCMS_class where parent=0 and kinds=3 order by orders asc")
if rs.eof then
rs.close:set rs = nothing
TempHTM = ""
menushow = TempHTM
exit function
else
databox = rs.getrows()
rs.close:set rs = nothing
for i = 0 to ubound(databox,2)
if i = ubound(databox,2) then tempstr = ""
if databox(3,i) = 0 then
TempHTM = TempHTM & "<a href=""" & site_root & "/" & site_html & "/" & databox(2,i) & "/"">" & databox(1,i) & "</a>" & tempstr & ""
elseif databox(3,i) = 1 then
if databox(4,i) = 0 then
TempHTM = TempHTM & "<a href=""" & site_root & "/" & site_html & "/" & databox(2,i) & "/" & databox(5,i) & """>" & databox(1,i) & "</a>" & tempstr & ""
elseif databox(4,i) = 1 then
TempHTM = TempHTM & "<a href=""" & databox(5,i) & """>" & databox(1,i) & "</a>" & tempstr & ""
end if
end if
next
menushow = TempHTM
end if
case else
response.write("标签[ncms:menu]参数[show]错误!")
response.end()
end select
end function
private function childmenushow(id)
dim TempHTM,rschild,box,j
TempHTM = "" & chr(10) & "<ul>" & chr(10)
set rschild = conn.execute("select id,cname,ename,isout,isurl,link from NCMS_class where parent=" & id & " and kinds=1 order by orders asc")
if rschild.eof then
rschild.close:set rschild = nothing
TempHTM = ""
childmenushow = TempHTM
exit function
else
box = rschild.getrows()
rschild.close:set rschild = nothing
end if
for j = 0 to ubound(box,2)
if box(3,j) = 0 then
TempHTM = TempHTM & "<li><a href=""" & site_root & "/" & site_html & "/" & box(2,j) & "/"" title=""" & box(1,j) & """>" & box(1,j) & "</a></li>" & chr(10)
elseif box(3,j) = 1 then
if box(4,j) = 0 then
TempHTM = TempHTM & "<li><a href=""" & site_root & "/" & site_html & "/" & box(2,j) & "/" & box(5,j) & """ title=""" & box(1,j) & """>" & box(1,j) & "</a></li>" & chr(10)
elseif box(4,j) = 1 then
TempHTM = TempHTM & "<li><a href=""" & box(5,j) & """ title=""" & box(1,j) & """>" & box(1,j) & "</a></li>" & chr(10)
end if
end if
next:box = ""
TempHTM = TempHTM & "</ul>" & chr(10)
childmenushow = TempHTM
end function
end class
class ncmsrelatetag
public len,num,lih
public function relateshow(scolumn,classid,newsid,keywords)
if keywords = "" or isnull(keywords) then
relateshow = "<li><font color=""red"">暂时没有相关新闻!</font></li>"
exit function
end if
dim arr,i,TempSql
arr = split(keywords,",",3,1)
for i = 0 to ubound(arr)
if TempSql <> "" then
TempSql = TempSql & "or title like '%" & arr(i) & "%' or keywords like '%" & arr(i) & "%'"
else
TempSql = TempSql & "title like '%" & arr(i) & "%' or keywords like '%" & arr(i) & "%'"
end if
next
if TempSql <> "" then
TempSql = "where (" & TempSql & ") and classid=" & classid & " and id <> " & newsid & " order by id desc"
end if
dim TempHTM:TempHTM = "" & chr(10) & "<table cellpadding=""0"" cellspacing=""0"" width=""100%"" border=""0"">" & chr(10)
TempHTM = TempHTM & "<tr>" & chr(10)
dim rs,databox,j
set rs = conn.execute("select top " & num & " classid,title,filename from NCMS_news " & TempSql)
if rs.eof then
rs.close:set rs = nothing
TempHTM = "<li><font color=""red"">暂时没有相关新闻!</font></li>"
relateshow = TempHTM
else
databox = rs.getrows()
rs.close:set rs = nothing
for j = 0 to ubound(databox,2)
TempHTM = TempHTM & "<td height=""" & lih & """ align=""left"" valign=""middle"">·<a href=""" & site_root & "/" & site_html & "/" & getclasspath(databox(0,j)) & "/" & databox(2,j) & site_extname & """ title=""" & databox(1,j) & """ target=""_blank"">" & gottopic(databox(1,j),len) & "</a></td>" & chr(10)
if j = ubound(databox,2) then
TempHTM = TempHTM & "</tr>" & chr(10)
else
if cint((j+1) mod scolumn) = 0 then
TempHTM = TempHTM & "</tr>" & chr(10)
TempHTM = TempHTM & "<tr>" & chr(10)
end if
end if
next
TempHTM = TempHTM & "</table>" & chr(10)
relateshow = TempHTM
end if
end function
end class
class ncmspagetag
public show
public function pageshow(stype,classid,newsid)
dim TempHTM,rs,databox
TempHTM = "" & chr(10) & "<div id=""page"">"
select case stype
case "last"
set rs = conn.execute("select top 1 id,classid,title,filename from NCMS_news where classid=" & classid & " and id > " & newsid & "")
if rs.eof or rs.bof then
rs.close:set rs = nothing
TempHTM = TempHTM & "上一篇：<font color=""red"">没有上一篇</font>"
TempHTM = TempHTM & "</div>" & chr(10)
pageshow = TempHTM
exit function
else
databox = rs.getrows()
rs.close:set rs = nothing
TempHTM = TempHTM & "上一篇：<a href=""" & site_root & "/" & site_html & "/" & getclasspath(databox(1,0)) & "/" & databox(3,0) & site_extname & """>" & databox(2,0) & "</a>"
TempHTM = TempHTM & "</div>" & chr(10)
databox = ""
pageshow = TempHTM
end if
case "next"
set rs = conn.execute("select top 1 id,classid,title,filename from NCMS_news where classid=" & classid & " and id < " & newsid & " order by id desc")
if rs.eof or rs.bof then
rs.close:set rs = nothing
TempHTM = TempHTM & "下一篇：<font color=""red"">没有下一篇</font>"
TempHTM = TempHTM & "</div>" & chr(10)
pageshow = TempHTM
exit function
else
databox = rs.getrows()
rs.close:set rs = nothing
TempHTM = TempHTM & "下一篇：<a href=""" & site_root & "/" & site_html & "/" & getclasspath(databox(1,0)) & "/" & databox(3,0) & site_extname & """>" & databox(2,0) & "</a>"
TempHTM = TempHTM & "</div>" & chr(10)
databox = ""
pageshow = TempHTM
end if
case else
response.write("标签[news:page]参数[show]错误!")
response.end()
end select
end function
end class
class X_ncmsnewstag
public id,ty,show,len,num,lih,hit
public function newsshow(stype,scolumn,strHtml)
dim TempHTM,xsql,rs,databox,i
TempHTM = "" & chr(10) & "<table cellpadding=""0"" cellspacing=""0"" width=""100%"" border=""0"">" & chr(10)
TempHTM = TempHTM & "<tr>" & chr(10)
select case stype
case "text"
if show = "new" then
if id = 0 then
set rs = conn.execute("select top " & num & " id,classid,title,content,click,isimg,bimg,simg,filename,addtime from NCMS_news where created=1 and pagetype=0 order by id desc")
else
set rs = conn.execute("select top " & num & " id,classid,title,content,click,isimg,bimg,simg,filename,addtime from NCMS_news where classid in(" & id & allchildclass(id) & ") and created=1 and pagetype=0 order by id desc")
end if
elseif show = "elite" then
if id = 0 then
set rs = conn.execute("select top " & num & " id,classid,title,content,click,isimg,bimg,simg,filename,addtime from NCMS_news where elite=1 and created=1 and pagetype=0 order by id desc")
else
set rs = conn.execute("select top " & num & " id,classid,title,content,click,isimg,bimg,simg,filename,addtime from NCMS_news where classid in(" & id & allchildclass(id) & ") and elite=1 and created=1 and pagetype=0 order by id desc")
end if
elseif show = "hot" then
if id = 0 then
set rs = conn.execute("select top " & num & " id,classid,title,content,click,isimg,bimg,simg,filename,addtime from NCMS_news where click>=" & hit & " and created=1 and pagetype=0 order by click desc")
else
set rs = conn.execute("select top " & num & " id,classid,title,content,click,isimg,bimg,simg,filename,addtime from NCMS_news where classid in(" & id & allchildclass(id) & ") and click>=" & hit & " and created=1 and pagetype=0 order by click desc")
end if
else
response.write("标签[ncms:free]参数[show]错误!")
response.end()
end if
case "image"
if show = "new" then
if id = 0 then
set rs = conn.execute("select top " & num & " id,classid,title,content,click,isimg,bimg,simg,filename,addtime from NCMS_news where isimg=1 and created=1 and pagetype=0 order by id desc")
else
set rs = conn.execute("select top " & num & " id,classid,title,content,click,isimg,bimg,simg,filename,addtime from NCMS_news where classid in(" & id & allchildclass(id) & ") and isimg=1 and created=1 and pagetype=0 order by id desc")
end if
elseif show = "elite" then
if id = 0 then
set rs = conn.execute("select top " & num & " id,classid,title,content,click,isimg,bimg,simg,filename,addtime from NCMS_news where isimg=1 and elite=1 and created=1 and pagetype=0 order by id desc")
else
set rs = conn.execute("select top " & num & " id,classid,title,content,click,isimg,bimg,simg,filename,addtime from NCMS_news where classid in(" & id & allchildclass(id) & ") and isimg=1 and elite=1 and created=1 and pagetype=0 order by id desc")
end if
elseif show = "hot" then
if id = 0 then
set rs = conn.execute("select top " & num & " id,classid,title,content,click,isimg,bimg,simg,filename,addtime from NCMS_news where isimg=1 and click>=" & hit & " and created=1 and pagetype=0 order by click desc")
else
set rs = conn.execute("select top " & num & " id,classid,title,content,click,isimg,bimg,simg,filename,addtime from NCMS_news where classid in(" & id & allchildclass(id) & ") and isimg=1 and click>=" & hit & " and created=1 and pagetype=0 order by click desc")
end if
else
response.write("标签[ncms:free]参数[show]错误!")
response.end()
end if
case else
response.write("标签[ncms:free]参数[ty]错误!")
response.end()
end select
if rs.eof then
rs.close:set rs = nothing
TempHTM = "<li><font color=""red"">暂时没有新闻!</font></li>"
newsshow = TempHTM
exit function
else
databox = rs.getrows()
rs.close:set rs = nothing
for i = 0 to ubound(databox,2)
TempHTM = TempHTM & "<td height=""" & lih & """ align=""left"" valign=""middle"">" & strHtml & "</td>" & chr(10)
if i = ubound(databox,2) then
TempHTM = TempHTM & "</tr>" & chr(10)
else
if cint((i+1) mod scolumn) = 0 then
TempHTM = TempHTM & "</tr>" & chr(10)
TempHTM = TempHTM & "<tr>" & chr(10)
end if
end if
dim charclass,PatrnStr
set charclass = new stringclass
PatrnStr = "\{\$classname\$\}"
TempHTM = charclass.replacestr(PatrnStr,TempHTM,"<a href=""" & site_root & "/" & site_html & "/" & getclasspath(databox(1,i)) & "/index" & site_extname & """ target=""_blank"">" & getclassname(databox(1,i)) & "</a>")
PatrnStr = "\{\$title\$\}"
TempHTM = charclass.replacestr(PatrnStr,TempHTM,gottopic(LoseHtml(databox(2,i)),len))
PatrnStr = "\{\$content\$\}"
TempHTM = charclass.replacestr(PatrnStr,TempHTM,gottopic(LoseHtml(databox(3,i)),len))
PatrnStr = "\{\$click\$\}"
TempHTM = charclass.replacestr(PatrnStr,TempHTM,databox(4,i))
PatrnStr = "\{\$filepath\$\}"
TempHTM = charclass.replacestr(PatrnStr,TempHTM,"" & site_root & "/" & site_html & "/" & getclasspath(databox(1,i)) & "/" & databox(8,i) & site_extname & "")
PatrnStr = "\{\$addtime\$\}"
TempHTM = charclass.replacestr(PatrnStr,TempHTM,formattagdate(databox(9,i),datestyle))
PatrnStr = "\{\$imgpath\$\}"
if IsObjInstalled("persits.jpeg") = true and jpeg_gate = 0 then
TempHTM = charclass.replacestr(PatrnStr,TempHTM,"" & site_root & "/" & site_upload & "/" & site_simg & "/" & databox(7,i) & "")
else
TempHTM = charclass.replacestr(PatrnStr,TempHTM,"" & site_root & "/" & site_upload & "/" & site_bimg & "/" & databox(6,i) & "")
end if
PatrnStr = "\{\$comment\$\}"
TempHTM = charclass.replacestr(PatrnStr,TempHTM,"[<a href=""" & site_root & "/tools/comment.asp?newsid=" & databox(0,i) & "&newstitle=" & getnewstitle(databox(0,i)) & "#comment"" target=""_blank"" title=""评论""><font color=""red"" size=""2"">评论</font></a>]")
next
databox = ""
TempHTM = TempHTM & "</table>" & chr(10)
newsshow = TempHTM
end if
end function
end class
function guide(id)
dim TempHTM
if id = "" or len(id) = 0 or not isnumeric(id) then
TempHTM = "当前位置 : <a href=""" & site_root & "/index" & site_extname & """>首页</a> >>"
else
dim rs
set rs = conn.execute("select top 1 id,parent,cname,ename from NCMS_class where id=" & id)
if not rs.eof then
TempHTM = TempHTM & guide(rs("parent"))
TempHTM = TempHTM & "<a href=""" & site_root & "/" & site_html & "/" & rs("ename") & "/index" & site_extname & """>" & rs("cname") & "</a> >> "
end if
rs.close:set rs = nothing
if id = 0 then
TempHTM = TempHTM & "当前位置 : <a href=""" & site_root & "/index" & site_extname & """>首页</a> >> "
end if
end if
guide = TempHTM
end function
function createindex()
dim Temp:Temp = ""
Temp = processcustomtag(loadtempletfile("../templet/" & site_dtemp & ""))
Temp = X_processcustomtag(Temp)
dim charclass
set charclass = new stringclass
dim PatrnStr
PatrnStr = "<title>.*?</title>"
Temp = charclass.replacestr(PatrnStr,Temp,"<title>" & site_name & "</title>")
PatrnStr = "\{\$guide\$\}"
Temp = charclass.replacestr(PatrnStr,Temp,guide(""))
PatrnStr = "\{\$keywords\$\}"
Temp = charclass.replacestr(PatrnStr,Temp,site_keywords)
PatrnStr = "\{\$search\$\}"
Temp = charclass.replacestr(PatrnStr,Temp,search())
PatrnStr = "\{\$description\$\}"
Temp = charclass.replacestr(PatrnStr,Temp,site_description)
PatrnStr = "\{\$copyright\$\}"
Temp = charclass.replacestr(PatrnStr,Temp,site_copyright)
PatrnStr = "\{\$root\$\}"
Temp = charclass.replacestr(PatrnStr,Temp,site_root)
dim sPATH:sPATH = "" & site_root & "/index" & site_extname & ""
dim objstream
set objstream = server.createobject("adodb.stream")
with objstream
.open
.charset = "" & chrset & ""
.position = objstream.size
.writetext = Temp
.savetofile server.mappath(sPATH),2
.close
end with
set objstream = nothing
if err.number <> 0 then
err.clear
createindex = false
else
createindex = true
end if
end function
function createnewsclass(id)
dim arrcont:arrcont = getcurclasscount(id)
dim i,j
for i = 0 to arrcont - 1
dim Temp:Temp = ""
Temp = processcustomtag(loadtempletfile("../templet/" & getclassall(id,1) & ""))
Temp = X_processcustomtag(Temp)
dim charclass
set charclass = new stringclass
dim PatrnStr
PatrnStr = "<title>.*?</title>"
Temp = charclass.replacestr(PatrnStr,Temp,"<title>" & charclass.getstr(getclassname(id)) & " - " & site_name & "</title>")
PatrnStr = "\{\$guide\$\}"
Temp = charclass.replacestr(PatrnStr,Temp,guide(id))
PatrnStr = "\{\$keywords\$\}"
Temp = charclass.replacestr(PatrnStr,Temp,site_keywords)
PatrnStr = "\{\$search\$\}"
Temp = charclass.replacestr(PatrnStr,Temp,search())
PatrnStr = "\{\$description\$\}"
Temp = charclass.replacestr(PatrnStr,Temp,site_description)
PatrnStr = "\{\$copyright\$\}"
Temp = charclass.replacestr(PatrnStr,Temp,site_copyright)
PatrnStr = "\{\$root\$\}"
Temp = charclass.replacestr(PatrnStr,Temp,site_root)
dim sPATH,cPATH:cPATH = "" & site_root & "/" & site_html & "/" & getclasspath(id) & "/"
createdir(server.mappath(cPATH))
dim PageHTM:PageHTM = ""
if i = 0 then
sPATH = "" & cPATH & "index" & site_extname & ""
else
sPATH = "" & cPATH & "index" & site_extname & ""
sPATH = left(sPATH,(len(sPATH)-len(site_extname))) & "_" & i + 1 & site_extname
end if
if arrcont >= 2 then
if i = 0 then
PageHTM = PageHTM & "【首页】-"
PageHTM = PageHTM & "【上页】"
end if
if i > 1 then
PageHTM = PageHTM & "【<a href=""index" & site_extname & """>首页</a>】-"
PageHTM = PageHTM & "【<a href=""index" & "_" & i & site_extname & """>上页</a>】"
end if
if i = 1 Then
PageHTM = PageHTM & "【<a href=""index" & site_extname & """>首页</a>】-"
PageHTM = PageHTM & "【<a href=""index" & site_extname & """>上页</a>】"
end if
PageHTM = PageHTM & "-【第<font color=""red"">" & i + 1 & "</font>页】/【共<font color=""red"">" & arrcont & "</font>页】-"
if i < arrcont - 1 then
PageHTM = PageHTM & "【<a href=""index" & "_" & i + 2 & site_extname & """>下页</a>】-"
PageHTM = PageHTM & "【<a href=""index" & "_" & arrcont & site_extname & """>尾页</a>】- "
end if
if i = arrcont - 1 then
PageHTM = PageHTM & "【下页】-"
PageHTM = PageHTM & "【尾页】- "
end if
PageHTM = PageHTM & "<select name=""page"" onchange=""self.location.href=this.options[this.selectedIndex].value"">"
PageHTM = PageHTM & "<option selected>页/码</option>"
PageHTM = PageHTM & "<option value=""index" & site_extname & """>第1页</option>"
for j = 1 to arrcont - 1
PageHTM = PageHTM & "<option value=""index" & "_" & j + 1 & site_extname & """>第" & j + 1 & "页</option>"
next
PageHTM = PageHTM & "</select>"
end if
PatrnStr = "{news:[^<>]+?\/}"
Temp = charclass.classcustomtag(PatrnStr,Temp,id,i + 1,"<p align=""center"">" & PageHTM & "</p>" & chr(10) & "")
dim objstream
set objstream = server.createobject("adodb.stream")
with objstream
.open
.charset = "" & chrset & ""
.position = objstream.size
.writetext = Temp
.savetofile server.mappath(sPATH),2
.close
end with
next
set objstream = nothing
if err.number <> 0 then
err.clear
createnewsclass = false
else
createnewsclass = true
end if
end function
function createnewsfile(id)
dim rs,sql
set rs = server.createobject("adodb.recordset")
sql = "select id,classid,title,content,author,source,keywords,bimg,simg,filename,pagetype,addtime from NCMS_news where id=" & id
rs.open sql,conn,1,1
dim databox:databox = rs.getrows()
rs.close:set rs = nothing
dim Temp:Temp = ""
if databox(10,0) = 0 then
Temp = processcustomtag(loadtempletfile("../templet/" & getclassall(databox(1,0),2) & ""))
Temp = X_processcustomtag(Temp)
else
Temp = processcustomtag(loadtempletfile("../templet/" & site_stemp & ""))
Temp = X_processcustomtag(Temp)
end if
dim charclass
set charclass = new stringclass
dim PatrnStr,AdvCont
PatrnStr = "<title>.*?</title>"
Temp = charclass.replacestr(PatrnStr,Temp,"<title>" & charclass.getstr(databox(2,0)) & " - " & site_name & "</title>")
PatrnStr = "{news:[^<>]+?\/}"
Temp = charclass.newscustomtag(PatrnStr,Temp,databox(1,0),databox(0,0),databox(6,0))
PatrnStr = "\{\$id\$\}"
Temp = charclass.replacestr(PatrnStr,Temp,databox(0,0))
PatrnStr = "\{\$classid\$\}"
Temp = charclass.replacestr(PatrnStr,Temp,databox(1,0))
PatrnStr = "\{\$title\$\}"
Temp = charclass.replacestr(PatrnStr,Temp,databox(2,0))
PatrnStr = "\{\$author\$\}"
Temp = charclass.replacestr(PatrnStr,Temp,databox(4,0))
PatrnStr = "\{\$source\$\}"
Temp = charclass.replacestr(PatrnStr,Temp,databox(5,0))
PatrnStr = "\{\$keywords\$\}"
Temp = charclass.replacestr(PatrnStr,Temp,databox(6,0))
PatrnStr = "\{\$click\$\}"
Temp = charclass.replacestr(PatrnStr,Temp,click(databox(0,0)))
PatrnStr = "\{\$addtime\$\}"
Temp = charclass.replacestr(PatrnStr,Temp,databox(11,0))
PatrnStr = "\{\$guide\$\}"
Temp = charclass.replacestr(PatrnStr,Temp,guide(databox(1,0)))
PatrnStr = "\{\$search\$\}"
Temp = charclass.replacestr(PatrnStr,Temp,search())
PatrnStr = "\{\$fontselect\$\}"
Temp = charclass.replacestr(PatrnStr,Temp,fontselect())
PatrnStr = "\{\$toolbar\$\}"
Temp = charclass.replacestr(PatrnStr,Temp,toolbar(databox(0,0)))
PatrnStr = "\{\$copyurl\$\}"
Temp = charclass.replacestr(PatrnStr,Temp,copyurl())
PatrnStr = "\{\$description\$\}"
Temp = charclass.replacestr(PatrnStr,Temp,site_description)
PatrnStr = "\{\$copyright\$\}"
Temp = charclass.replacestr(PatrnStr,Temp,site_copyright)
PatrnStr = "\{\$root\$\}"
Temp = charclass.replacestr(PatrnStr,Temp,site_root)
PatrnStr = "\{\$advarea\$\}"
AdvCont = databox(3,0)
AdvCont = charclass.replacestr(PatrnStr,AdvCont,advshow(site_advcode))
dim tempArr,n,sPATH,ePATH,cPATH:cPATH = "" & site_root & "/" & site_html & "/" & getclasspath(databox(1,0)) & "/"
if instr(databox(9,0),"/") = 0 then
createdir(server.mappath(cPATH))
else
tempArr = split(databox(9,0),"/")
for n = 0 to ubound(tempArr)
ePATH = replace(databox(9,0),tempArr(n),"")
next
createdir(server.mappath(cPATH & ePATH))
end if
dim TTemp:TTemp = Temp
dim arrcont:arrcont = split(AdvCont,"{$split$}",-1,1)
dim PageHTM:PageHTM = ""
dim i,j,k:k = ubound(arrcont)
for i = 0 to k
if i = 0 then
sPATH = "" & cPATH & databox(9,0) & site_extname & ""
else
sPATH = "" & cPATH & databox(9,0) & site_extname & ""
sPATH = left(sPATH,(len(sPATH)-len(site_extname))) & "_" & i + 1 & site_extname
end if
if sPATH = "" then
createnewsfile = false
exit function
end if
if k >= 1 then
PageHTM = "<p align=""center"">【本新闻共<font color=""red"">" & k + 1 & "</font>页】-"
if i = 0 then
PageHTM = PageHTM & "【首页】-"
PageHTM = PageHTM & "【上页】-"
end if
if i > 1 then
PageHTM = PageHTM & "【<a href=""" & cPATH & databox(9,0) & site_extname & """>首页</a>】-"
PageHTM = PageHTM & "【<a href=""" & cPATH & databox(9,0) & "_" & i & site_extname & """>上页</a>】-"
end if
if i = 1 Then
PageHTM = PageHTM & "【<a href=""" & cPATH & databox(9,0) & site_extname & """>首页</a>】-"
PageHTM = PageHTM & "【<a href=""" & cPATH & databox(9,0) & site_extname & """>上页</a>】-"
end if
if i < k then
PageHTM = PageHTM & "【<a href=""" & cPATH & databox(9,0) & "_" & i + 2 & site_extname & """>下页</a>】-"
PageHTM = PageHTM & "【<a href=""" & cPATH & databox(9,0) & "_" & k + 1 & site_extname & """>尾页</a>】-"
end if
if i = k then
PageHTM = PageHTM & "【下页】-"
PageHTM = PageHTM & "【尾页】-"
end if
PageHTM = PageHTM & "【当前在第<font color=""red"">" & i + 1 & "</font>页】</p>"
else
PageHTM = ""
end if
PatrnStr = "\{\$content\$\}"
Temp = charclass.replacestr(PatrnStr,TTemp,"" & chr(10) & "<div id=""content"">" & chr(10) & arrcont(i) & PageHTM & chr(10) & "</div>" & chr(10))
dim objstream
set objstream = server.createobject("adodb.stream")
with objstream
.open
.charset = "" & chrset & ""
.position = objstream.size
.writetext = X_processcustomtag(Temp)
.savetofile server.mappath(sPATH),2
.close
end with
set objstream = nothing
next
if err.number <> 0 then
err.clear
createnewsfile = false
else
conn.execute("update NCMS_news set created=1 where id=" & databox(0,0))
createnewsfile = true
databox = ""
end if
end function
function createnewsjs(show,id,len,num,lih,col,filename)
dim TempHTM,xsql,rs,databox,i
TempHTM = "document.writeln('<table cellpadding=\""0\"" cellspacing=\""0\"" width=\""100%\"" border=\""0\"">');"
TempHTM = TempHTM & "document.writeln('<tr>');"
select case show
case "new"
if id = 0 then
set rs = conn.execute("select top " & num & " classid,title,filename from NCMS_news where created=1 and pagetype=0 order by id desc")
else
set rs = conn.execute("select top " & num & " classid,title,filename from NCMS_news where classid in(" & id & allchildclass(id) & ") and created=1 and pagetype=0 order by id desc")
end if
case "elite"
if id = 0 then
set rs = conn.execute("select top " & num & " classid,title,filename from NCMS_news where elite=1 and created=1 and pagetype=0 order by id desc")
else
set rs = conn.execute("select top " & num & " classid,title,filename from NCMS_news where classid in(" & id & allchildclass(id) & ") and elite=1 and created=1 and pagetype=0 order by id desc")
end if
case "hot"
if id = 0 then
set rs = conn.execute("select top " & num & " classid,title,filename from NCMS_news where click>=100 and created=1 and pagetype=0 order by click desc")
else
set rs = conn.execute("select top " & num & " classid,title,filename from NCMS_news where classid in(" & id & allchildclass(id) & ") and click>=100 and created=1 and pagetype=0 order by click desc")
end if
case else
response.write("[新闻类型]参数错误!")
response.end()
end select
if rs.eof then
rs.close:set rs = nothing
TempHTM = "document.writeln('<li><font color=\""red\"">暂时没有新闻!<\/font><\/li>');"
else
databox = rs.getrows()
rs.close:set rs = nothing
for i = 0 to ubound(databox,2)
TempHTM = TempHTM & "document.writeln('<td height=\""" & lih & "\"" align=\""left\"" valign=\""middle\"">·<a href=\""" & site_root & "/" & site_html & "/" & getclasspath(databox(0,i)) & "/" & databox(2,i) & site_extname & "\"" title=\""" & databox(1,i) & "\"" target=\""_blank\"">" & gottopic(databox(1,i),len) & "<\/a><\/td>');"
if i = ubound(databox,2) then
TempHTM = TempHTM & "document.writeln('<\/tr>');"
else
if cint((i+1) mod col) = 0 then
TempHTM = TempHTM & "document.writeln('<\/tr>');"
TempHTM = TempHTM & "document.writeln('<tr>');"
end if
end if
next
databox = ""
TempHTM = TempHTM & "document.writeln('<\/table>');"
end if
if checkfolder("" & site_root & "/jss/") = false then
createdir(server.mappath("" & site_root & "/jss/"))
end if
if checkfile("" & site_root & "/jss/" & filename & ".js") = true then
call alertbox("文件已存在!请更换文件名!",2)
end if
dim objstream
set objstream = server.createobject("adodb.stream")
with objstream
.open
.charset = "" & chrset & ""
.position = objstream.size
.writetext = TempHTM
.savetofile server.mappath("" & site_root & "/jss/" & filename & ".js"),2
.close
end with
set objstream = nothing
if err.number <> 0 then
err.clear
createnewsjs = false
else
createnewsjs = true
end if
end function
function getnewstitle(id)
dim rs,tempstr
set rs = conn.execute("select title from NCMS_news where id=" & id)
if not rs.eof then
tempstr = server.urlencode(rs("title"))
end if
rs.close:set rs = nothing
getnewstitle = tempstr
end function
function getclasspath(id)
dim rs,tempstr
set rs = conn.execute("select ename from NCMS_class where id=" & id)
if not rs.eof then
tempstr = rs("ename")
end if
rs.close:set rs = nothing
getclasspath = tempstr
end function
function getclassid(id)
dim rs,tempstr
set rs = conn.execute("select classid from NCMS_news where id=" & id)
if not rs.eof then
tempstr = rs("classid")
end if
rs.close:set rs = nothing
getclassid = tempstr
end function
function getclassname(id)
dim rs,tempstr
set rs = conn.execute("select cname from NCMS_class where id= " & id)
if not rs.eof then
tempstr = rs("cname")
end if
rs.close:set rs = nothing
getclassname = tempstr
end function
function allchildclass(id)
dim rs
set rs = conn.execute("select id from NCMS_class where parent=" & id)
while not rs.eof
allchildclass = allchildclass & "," & rs("id")
allchildclass = allchildclass & allchildclass(rs("id"))
rs.movenext
wend
rs.close:set rs = nothing
end function
function getclassall(id,stype)
dim rs,tempstr
select case stype
case "1"
set rs = conn.execute("select ctemp from NCMS_class where id=" & id)
if not rs.eof then
tempstr = rs("ctemp")
end if
rs.close:set rs = nothing
getclassall = tempstr
case "2"
set rs = conn.execute("select ntemp from NCMS_class where id=" & id)
if not rs.eof then
tempstr = rs("ntemp")
end if
rs.close:set rs = nothing
getclassall = tempstr
case "3"
set rs = conn.execute("select fname from NCMS_class where id=" & id)
if not rs.eof then
tempstr = rs("fname")
end if
rs.close:set rs = nothing
getclassall = tempstr
case else
response.write("获取栏目属性失败!")
response.end()
end select
end function
function advshow(advcode)
if advcode = "" then
advshow = ""
exit function
else
dim advarr
advarr = split(advcode," |
|
