我要评论public function readstylepage(page)
name = page
if objisempty then call reloadtemplates
name = page
readstylepage = value
end function
'检查管理员权限
'参数：sname(管理员用户名),sitem(权限项目)(sitem=0 只检查超管权限)
'返回：true/false
public function checkpermission(sname, sitem)
checkpermission = false
if sname = "" or isnull(sname) then exit function
dim crs
set crs = execute("select isadmin,permission,password from mesky_sitemanager where username='" & checkstr(sname) & "'")
if not (crs.eof and crs.bof) then
if adminpass = crs(2) then
if crs(0) then checkpermission = true
if sitem <> 0 then
if iteminlist(crs(1), sitem) then checkpermission = true
end if
end if
end if
set crs = nothing
end function
'
'资源分类下载列表
'参数：catalogid(被默认选择的分类id)；tablename（数据库表名）
'返回： 字符串 0=rootid;1=catalogid;2=depth;3=catalogname
public function getcatalogselect(catalogid, fromname)
dim trs, s, i
s = " <option value="""">所有分类</option>" & vbcrlf
set trs = execute("select rootid,catalogid,depth,catalogname from " & fromname & " order by rootid,orders")
do while not trs.eof
s = s & " <option value=""" & trs(0) & "," & trs(1) & "," & trs(2) & "," & trs(3) & """ "
if catalogid <> 0 then
if trs(1) = catalogid then s = s & "selected"
end if
s = s & ">"
if trs(2) = 1 then s = s & " ├ "
if trs(2) > 1 then
for i = 2 to trs(2)
s = s & " │"
next
s = s & " ├ "
end if
s = s & trs(3) & "</option>" & vbcrlf
trs.movenext
loop
set trs = nothing
getcatalogselect = s
s = null
end function
'相关下载资源
'参数：keys,cutnum
'for 标准版 and 高级版
public function mutualitydownres(keys, topnum, id)
dim trs, s
if topnum = 0 then
set trs = execute("select id,resname,resver from mesky_down_resource where (resname like '%" & keys & "%') and id<>" & id & " and isauditing=1 order by id desc")
else
set trs = execute("select top " & topnum & " id,resname,resver from mesky_down_resource where (resname like '%" & keys & "%') and id<>" & id & " and isauditing=1 order by id desc")
end if
if trs.eof and trs.bof then
s = ""
else
dim arra,arrb,i
i = 1
do while not trs.eof
if i = 1 then
arra = trs(0)
arrb = trs(1) & " " & trs(2)
else
arra = arra & "###" & trs(0)
arrb = arrb & "$$$" & trs(1) & " " & trs(2)
end if
i = i + 1
trs.movenext
loop
s = arra & "|||" & arrb
end if
set trs = nothing
mutualitydownres = s
s = null
end function
'相关文章资源
'参数：keys,cutnum
'for 标准版 and 高级版
public function mutualitycmsres(keys, topnum, id)
dim trs, s
if topnum = 0 then
set trs = execute("select id,title from mesky_cms_resource where title like '%" & keys & "%' and id<>" & id & " and isauditing=1 order by id desc")
else
set trs = execute("select top " & topnum & " id,title from mesky_cms_resource where title like '%" & keys & "%' and id<>" & id & " and isauditing=1 order by id desc")
end if
if trs.eof and trs.bof then
s = ""
else
dim arra,arrb,i
i = 1
do while not trs.eof
if i = 1 then
arra = trs(0)
arrb = trs(1)
else
arra = arra & "###" & trs(0)
arrb = arrb & "$$$" & trs(1)
end if
i = i + 1
trs.movenext
loop
s = arra & "|||" & arrb
end if
set trs = nothing
mutualitycmsres = s
s = null
end function
'相关下载资源
'参数：keys,cutnum
'for 标准版 and 高级版
public function showmutualitydownres(strres,cutnum)
if isnull(strres) or strres="" then
showmutualitydownres = ""
exit function
end if
dim i, s, arra, arrb
arra = split(strres,"|||")(0)
arrb = split(strres,"|||")(1)
arra = split(arra,"###")
arrb = split(arrb,"$$$")
s = "<table width=""100%"" border=""0"" cellspacing=""0"" cellpadding=""1"">"
for i = 0 to ubound(arra)
s = s & "<tr><td>·<a href=""" & spath & replace(setting(77), "{$id}", arra(i)) & """>" & cutstr(arrb(i), int(cutnum)) & "</a></td></tr>"
next
s = s & "</table>"
showmutualitydownres = s
s = null
end function
'相关文章资源
'参数：keys,cutnum
'for 标准版 and 高级版
public function showmutualitycmsres(strres,cutnum)
if isnull(strres) or strres="" then
showmutualitycmsres = ""
exit function
end if
dim i, s, arra, arrb
arra = split(strres,"|||")(0)
arrb = split(strres,"|||")(1)
arra = split(arra,"###")
arrb = split(arrb,"$$$")
s = "<table width=""100%"" border=""0"" cellspacing=""0"" cellpadding=""1"">"
for i = 0 to ubound(arra)
s = s & "<tr><td>·<a href=""" & spath & replace(setting(101), "{$id}", arra(i)&"_1") & """>" & cutstr(arrb(i), int(cutnum)) & "</a></td></tr>"
next
s = s & "</table>"
showmutualitycmsres = s
s = null
end function
public function shownews(topnum,cutnum1,cutnum2,istype)
dim trs,s,i
if int(istype) = 1 then
set trs = execute("select top "&topnum&" * from mesky_news where istype = 1 order by id desc")
elseif int(istype) = 2 then
set trs = execute("select top "&topnum&" * from mesky_news where istype = 2 order by id desc")
else
set trs = execute("select top "&topnum&" * from mesky_news order by id desc")
end if
if trs.eof and trs.bof then
shownews = ""
else
i = 1
do while not trs.eof
if i > 1 then s = s & "<br>"
s = s & "·<a href=""viewnews.asp?id="&trs("id")&"&istype="&istype&""" target=""_blank"">"&cutstr(trs("title"),int(cutnum1))&"</a>"
if int(cutnum2) > 0 then
s = s & "<br>" & cutstr(trs("content"),int(cutnum2))
end if
s = s &" "& formatdatetime(trs("dateandtime"),2)
i = i + 1
trs.movenext
loop
end if
shownews = s
s = null
set trs = nothing
end function
'资源列表分类导航
'for 标准版 and 高级版
public function catalog_nav(rootid, catalogid, depth, fromname)
dim s, trs, i, filename
if rootid = 0 and catalogid = 0 then
set trs = execute("select catalogid,catalogname,rootid,depth,child,resnum from " & fromname & " where depth=0 order by rootid")
else '根分类 rootid>0
set trs = execute("select catalogid,catalogname,rootid,depth,child,resnum from " & fromname & " where rootid=" & rootid & " and depth>0 order by orders")
end if
if trs.eof and trs.bof then
s = "sorry！没有找到相关的分类数据。"
else
s = "<table width=""80%"" border=""0"" align=""center"">" & vbcrlf
do while not trs.eof
s = s & "<tr><td>"
if trs(3) > 1 then
for i = 2 to trs(3)
s = s & " "
next
end if
if rootid = 0 then
s = s & "<img src=""" & spath & "images/+.gif"" border=""0"" align=""absmiddle""> "
elseif trs(4) > 0 and rootid > 0 and catalogid > 0 then
s = s & "<img src=""" & spath & "images/+.gif"" border=""0"" align=""absmiddle""> "
else
s = s & "<img src=""" & spath & "images/-.gif"" border=""0"" align=""absmiddle""> "
end if
if rootid = 0 then
if lcase(fromname) = "mesky_down_catalog" then
filename = setting(72)
else
filename = setting(97)
end if
s = s & "<a href=""" & spath & replace(replace(filename, "{$id}", trs(2)), "{$pages}", "1") & """>" & trs(1) & "</a> (<font color=red>" & trs(5) & "</font>)"
else
if lcase(fromname) = "mesky_down_catalog" then
filename = setting(73)
else
filename = setting(98)
end if
s = s & "<a href=""" & spath & replace(replace(filename, "{$id}", trs(0)), "{$pages}", "1") & """>" & trs(1) & "</a> (<font color=red>" & trs(5) & "</font>)"
if trs(0) = catalogid then s = s & "←"
end if
s = s & "</td></tr>"
trs.movenext
loop
s = s & "</table>"
end if
set trs = nothing
catalog_nav = s
s = null
end function
'当前位置 导航
'for 标准版
public function site_nav(catalogid, fromname, gettitle, geturl)
dim s, trs, catalogname, parentid, parentstr, depth, rootid, filename
if lcase(fromname) = "mesky_down_catalog" then
s = s & "<a href=""" & spath & setting(70) & """>下载首页</a> "
else
s = s & "<a href=""" & spath & setting(95) & """>首页</a> "
end if
if catalogid > 0 then
set trs = execute("select catalogname,parentid,parentstr,depth,rootid from " & fromname & " where catalogid=" & catalogid)
if not (trs.eof and trs.bof) then
catalogname = trs(0)
parentid = trs(1)
parentstr = trs(2)
depth = trs(3)
rootid = trs(4)
end if
set trs = nothing
if parentid <> 0 then
set trs = execute("select catalogid,catalogname,depth,rootid from " & fromname & " where catalogid in(" & parentstr & ")")
if not (trs.eof and trs.bof) then
do while not trs.eof
if trs(2) > 0 then
if lcase(fromname) = "mesky_down_catalog" then
filename = setting(73)
else
filename = setting(98)
end if
s = s & " → <a href=""" & spath & replace(replace(filename, "{$id}", trs(0)), "{$pages}", "1") & """>" & trs(1) & "</a>"
else
if lcase(fromname) = "mesky_down_catalog" then
filename = setting(72)
else
filename = setting(97)
end if
s = s & " → <a href=""" & spath & replace(replace(filename, "{$id}", trs(3)), "{$pages}", "1") & """>" & trs(1) & "</a>"
end if
trs.movenext
loop
end if
set trs = nothing
end if
if depth > 0 then
if lcase(fromname) = "mesky_down_catalog" then
filename = setting(73)
else
filename = setting(98)
end if
s = s & " → <a href=""" & spath & replace(replace(filename, "{$id}", catalogid), "{$pages}", "1") & """>" & catalogname & "</a>"
else
if lcase(fromname) = "mesky_down_catalog" then
filename = setting(72)
else
filename = setting(97)
end if
s = s & " → <a href=""" & spath & replace(replace(filename, "{$id}", rootid), "{$pages}", "1") & """>" & catalogname & "</a>"
end if
end if
if geturl <> "" then
s = s & " → <a href=""" & geturl & """>" & gettitle & "</a>"
else
s = s & " → " & gettitle
end if
site_nav = s
s = null
end function
'资源分类页
'for 标准版 and 高级版
public function showdownrescatalog()
dim s, rs, srs, i, x, y, brnum
brnum = 6
s = s & "<table width=""770"" border=""0"" align=""center"" cellpadding=""2"" cellspacing=""1"">" & vbcrlf
set rs = execute("select catalogid,catalogname,rootid,depth from mesky_down_catalog where depth=0 order by rootid")
i = 1
if not (rs.eof and rs.bof) then
do while not rs.eof
s = s & " <tr class=""tdbg" & i mod 2 + 1 & """>" & vbcrlf
s = s & " <td width=""100"" align=""center""><a href=""" & spath & replace(replace(setting(72), "{$id}", rs(2)), "{$pages}", "1") & """>" & rs(1) & "</a> <a href=""xml/rss_down_r" & rs(2) & ".xml""><img src=""" & spath & "images/rss.gif"" border=""0"" align=""absmiddle""></a></td>" & vbcrlf
s = s & " <td><table width=""100%"" border=""0"" cellspacing=""1"" cellpadding=""3"">" & vbcrlf
s = s & " <tr>" & vbcrlf
set srs = execute("select catalogid,catalogname,rootid,depth from mesky_down_catalog where parentid=" & rs(0) & " order by orders")
if not (srs.eof and srs.bof) then
x = 1
do while not srs.eof
s = s & " <td align=""center"" width=""12.5%""><a href=""" & spath & replace(replace(setting(73), "{$id}", srs(0)), "{$pages}", "1") & """>" & srs(1) & "</a> <a href=""xml/rss_down_s" & srs(0) & ".xml"" class=""f11"">(rss)</a></td>" & vbcrlf
if (x mod brnum) = 0 then s = s & "</tr><tr>" & vbcrlf
x = x + 1
srs.movenext
loop
if (x mod brnum) > 0 then
for y = 0 to (brnum - (x mod brnum))
s = s & "<td align=""center"" width=""12.5%"">.</td>" & vbcrlf
next
end if
if x = brnum then
for y = 0 to (brnum - x)
s = s & "<td align=""center"" width=""12.5%"">.</td>" & vbcrlf
next
end if
end if
set srs = nothing
s = s & " </tr>" & vbcrlf
s = s & " </table></td>" & vbcrlf
s = s & " </tr>" & vbcrlf
i = i + 1
rs.movenext
loop
end if
set rs = nothing
s = s & "</table>"
showdownrescatalog = s
s = null
end function
'资源分类页
'for 标准版 高级版
public function showcmsrescatalog()
dim s, rs, srs, i, x, y, brnum
brnum = 5
s = s & "<table width=""770"" border=""0"" align=""center"" cellpadding=""2"" cellspacing=""1"">" & vbcrlf
set rs = execute("select catalogid,catalogname,rootid,depth from mesky_cms_catalog where depth=0 order by rootid")
i = 1
if not (rs.eof and rs.bof) then
do while not rs.eof
s = s & " <tr class=""tdbg" & i mod 2 + 1 & """>" & vbcrlf
s = s & " <td width=""100"" align=""center""><a href=""" & spath & replace(replace(setting(97), "{$id}", rs(2)),"{$pages}","1") & """>" & rs(1) & "</a> <a href=""xml/rss_cms_r" & rs(2) & ".xml""><img src=""" & spath & "images/rss.gif"" border=""0"" align=""absmiddle""></a></td>" & vbcrlf
s = s & " <td><table width=""100%"" border=""0"" cellspacing=""1"" cellpadding=""3"">" & vbcrlf
s = s & " <tr>" & vbcrlf
set srs = execute("select catalogid,catalogname,rootid,depth from mesky_cms_catalog where parentid=" & rs(0) & " order by orders")
if not (srs.eof and srs.bof) then
x = 1
do while not srs.eof
s = s & " <td align=""center"" width=""12.5%""><a href=""" & spath & replace(replace(setting(98), "{$id}", srs(0)),"{$pages}","1") & """>" & srs(1) & "</a> <a href=""xml/rss_cms_s" & srs(0) & ".xml"" class=""f11"">(rss)</a></td>" & vbcrlf
if (x mod brnum) = 0 then s = s & "</tr><tr>"
x = x + 1
srs.movenext
loop
if (x mod brnum) > 0 then
for y = 0 to (brnum - (x mod brnum))
s = s & "<td align=""center"" width=""12.5%"">.</td>" & vbcrlf
next
end if
if x = brnum then
for y = 0 to (brnum - x)
s = s & "<td align=""center"" width=""12.5%"">.</td>" & vbcrlf
next
end if
end if
set srs = nothing
s = s & " </tr>" & vbcrlf
s = s & " </table></td>" & vbcrlf
s = s & " </tr>" & vbcrlf
i = i + 1
rs.movenext
loop
end if
set rs = nothing
s = s & "</table>"
showcmsrescatalog = s
s = null
end function
'for 标准版 and 高级版 首页
public function showdownresadv(strwhere, strorder, topnum, cutnum, showdate, showdot, showhrline, showcatalogname)
dim trs, s, i, strdot, strhits
if instr(lcase(strorder), "hits") > 0 then
strhits = replace(replace(replace(lcase(strorder), "desc", ""), "asc", ""), " ", "")
else
strhits = "hitstotal"
end if
if (showdot = "" or showdot = "0") then
strdot = "·"
else
strdot = showdot
end if
if strwhere <> "" then
set trs = execute("select top " & topnum & " id,resname,resver,catalogid,catalogname," & strhits & ",updatetime from mesky_down_resource where " & strwhere & " and isauditing=1 order by " & strorder & "")
else
set trs = execute("select top " & topnum & " id,resname,resver,catalogid,catalogname," & strhits & ",updatetime from mesky_down_resource where isauditing=1 order by " & strorder & "")
end if
s = "<table width=""99%"" border=""0"" cellspacing=""0"" cellpadding=""2"" align=""center"">" & vbcrlf
if trs.eof and trs.bof then
s = s & " <tr>" & vbcrlf
s = s & " <td>sorry！没有查询到任何记录。</td>" & vbcrlf
s = s & " </tr>" & vbcrlf
else
do while not trs.eof
s = s & " <tr>" & vbcrlf
s = s & " <td>" & strdot
if showcatalogname then '显示分类
s = s & "[<a href=""" & replace(replace(setting(73), "{$id}", trs(3)), "{$pages}", "1") & """ target=""_blank"">" & trs(4) & "</a>]"
end if
s = s & " <a href=""" & replace(setting(77), "{$id}", trs(0)) & """ target=""_blank"" title=""" & trs(1) & " " & trs(2) & """>" & cutstr(trs(1) & " " & trs(2), int(cutnum)) & "</a> </td>"
if showdate = "hits" then '显示时间还是人气
s = s & "<td width=""30"">" & trs(5) & "</td>" & vbcrlf
else
s = s & "<td width=""30"">" & formatmydate(trs(6), showdate) & "</td>" & vbcrlf
end if
s = s & " </tr>" & vbcrlf
if showhrline then s = s & "<tr><td height=""1"" colspan=""2"" background=""images/bg_dot.gif""></td></tr>" & vbcrlf
trs.movenext
loop
end if
set trs = nothing
s = s & "</table>" & vbcrlf
showdownresadv = s
s = null
end function
'for 标准版 and 高级版
public function showdownres(strwhere, strorder, topnum, cutnum, showdot, showhrline)
dim trs, s, i, strdot
i = 1
if strwhere <> "" then
set trs = execute("select top " & topnum & " id,resname,resver from mesky_down_resource where " & strwhere & " and isauditing=1 order by " & strorder & "")
else
set trs = execute("select top " & topnum & " id,resname,resver from mesky_down_resource where isauditing=1 order by " & strorder & "")
end if
if trs.eof and trs.bof then
s = ""
else
s = "<table width=""100%"" border=""0"" cellspacing=""0"" cellpadding=""1"">" & vbcrlf
do while not trs.eof
if (showdot = "" or showdot = "0") then
strdot = "" & right("0" & i, 2) & "."
else
strdot = showdot
end if
s = s & " <tr><td><font color=red>" & strdot & "</font><a href=""" & spath & replace(setting(77), "{$id}", trs(0)) & """>" & cutstr(trs(1) & " " & trs(2), int(cutnum)) & "</a></td></tr>" & vbcrlf
if showhrline then s = s & "<tr><td height=""1"" background=""" & spath & "images/bg_dot.gif""></td></tr>" & vbcrlf
i = i + 1
trs.movenext
loop
s = s & "</table>"
end if
set trs = nothing
showdownres = s
s = null
end function
'for 标准版 and 高级版 首页
public function showcmsresadv(strwhere, strorder, topnum, cutnum, showdate, showdot, showhrline, showcatalogname)
dim trs, s, i, strdot
if (showdot = "" or showdot = "0") then
strdot = "·"
else
strdot = showdot
end if
if strwhere <> "" then
set trs = execute("select top " & topnum & " id,title,catalogid,catalogname,hits,dateandtime,iscomment,redirecturl from mesky_cms_resource where " & strwhere & " and isauditing=1 order by " & strorder & "")
else
set trs = execute("select top " & topnum & " id,title,catalogid,catalogname,hits,dateandtime,iscomment,redirecturl from mesky_cms_resource where isauditing=1 order by " & strorder & "")
end if
s = "<table width=""99%"" border=""0"" cellspacing=""0"" cellpadding=""2"" align=""center"">" & vbcrlf
if trs.eof and trs.bof then
s = s & " <tr>" & vbcrlf
s = s & " <td>sorry！没有查询到任何记录。</td>" & vbcrlf
s = s & " </tr>" & vbcrlf
else
do while not trs.eof
s = s & " <tr>" & vbcrlf
s = s & " <td>" & strdot
if showcatalogname then '显示分类
s = s & "[<a href=""" & replace(replace(setting(98), "{$id}", trs(2)),"{$pages}","1") & """ target=""_blank"">" & trs(3) & "</a>]"
end if
if trs(7) <> "" then
s = s & " <a href=""" & trs(7) & """ target=""_blank"" title=""" & trs(1) & """>"
else
s = s & " <a href=""" & replace(setting(101), "{$id}", trs(0)& "_1") & """ target=""_blank"" title=""" & trs(1) & """>"
end if
'显示评论
if trs(6) = 1 then
s = s & cutstr(trs(1), int(cutnum)-4) & "</a> <a href=""../comment_cms.asp?id="&trs(0)&""">评论</a></td>"
else
s = s & cutstr(trs(1), int(cutnum)) & "</a></td>"
end if
if showdate = "hits" then '显示时间还是人气
s = s & "<td width=""30"">" & trs(4) & "</td>" & vbcrlf
else
s = s & "<td width=""30"">" & formatmydate(trs(5), showdate) & "</td>" & vbcrlf
end if
s = s & " </tr>" & vbcrlf
if showhrline then s = s & "<tr><td height=""1"" colspan=""2"" background=""images/bg_dot.gif""></td></tr>" & vbcrlf
trs.movenext
loop
end if
set trs = nothing
s = s & "</table>" & vbcrlf
showcmsresadv = s
s = null
end function
'for 标准版 and 高级版
public function showcmsres(strwhere, strorder, topnum, cutnum, showdot, showhrline)
dim trs, s, i, strdot
i = 1
if strwhere <> "" then
set trs = execute("select top " & topnum & " id,title,iscomment,redirecturl from mesky_cms_resource where " & strwhere & " and isauditing=1 order by " & strorder & "")
else
set trs = execute("select top " & topnum & " id,title,iscomment,redirecturl from mesky_cms_resource where isauditing=1 order by " & strorder & "")
end if
if trs.eof and trs.bof then
s = ""
else
s = "<table width=""100%"" border=""0"" cellspacing=""0"" cellpadding=""1"">" & vbcrlf
do while not trs.eof
if (showdot = "" or showdot = "0") then
strdot = "" & right("0" & i, 2) & "."
else
strdot = showdot
end if
if trs(3)<>"" then
s = s & " <tr><td><font color=red> " & strdot & "</font><a href=""" & trs(3) & """>"
else
s = s & " <tr><td><font color=red> " & strdot & "</font><a href=""" & spath & replace(setting(101), "{$id}", trs(0)& "_1") & """>"
end if
'显示评论
if trs(2) = 1 then
s = s & cutstr(trs(1), int(cutnum)-4) & "</a> <a href=""../comment_cms.asp?id="&trs(0)&""">评论</a></td></tr>" & vbcrlf
else
s = s & cutstr(trs(1), int(cutnum)) & "</a></td></tr>" & vbcrlf
end if
if showhrline then s = s & "<tr><td height=""1"" background=""" & spath & "images/bg_dot.gif""></td></tr>" & vbcrlf
i = i + 1
trs.movenext
loop
s = s & "</table>"
end if
set trs = nothing
showcmsres = s
s = null
end function
public function showdownresimages(strwhere, strorder, topnum, cutnum, intwidth, intheight, iswh)
dim trs, s, i
i = 1
s = "<table width=""100%"" border=""0"" cellspacing=""0"" cellpadding=""3"">" & vbcrlf
if strwhere <> "" then
set trs = execute("select top " & topnum & " id,resname,resver,smallimg from mesky_down_resource where " & strwhere & " and isauditing=1 and smallimg<>'' order by " & strorder & "")
else
set trs = execute("select top " & topnum & " id,resname,resver,smallimg from mesky_down_resource where isauditing=1 and smallimg<>'' order by " & strorder & "")
end if
if trs.eof and trs.bof then
s = s & " <tr>" & vbcrlf
s = s & " <td>sorry！没有查询到任何记录。</td>" & vbcrlf
s = s & " </tr>" & vbcrlf
else
if iswh = 1 then s = s & " </tr>" & vbcrlf
do while not trs.eof
if iswh = 2 then s = s & " <tr>" & vbcrlf
s = s & " <td align=""center""><a href=""" & spath & replace(setting(77), "{$id}", trs(0)) & """ target=""_blank"" title=""" & trs(1) & " " & trs(2) & """><img src=""" & spath & trs(3) & """ border=0 width=""" & intwidth & """ height=""" & intheight & """></a>"
s = s & "<br><a href=""" & spath & replace(setting(77), "{$id}", trs(0)) & """ target=""_blank"">" & cutstr(trs(1) & " " & trs(2), int(cutnum)) & "</a></td>" & vbcrlf
if iswh = 2 then s = s & " </tr>" & vbcrlf
trs.movenext
loop
end if
set trs = nothing
if iswh = 1 then s = s & " </tr>" & vbcrlf
s = s & "</table>" & vbcrlf
showdownresimages = s
s = null
end function
public function showcmsresimages(strwhere, strorder, topnum, cutnum, intwidth, intheight, iswh)
dim trs, s, i
i = 1
s = "<table width=""100%"" border=""0"" cellspacing=""0"" cellpadding=""3"">" & vbcrlf
if strwhere <> "" then
set trs = execute("select top " & topnum & " id,title,smallimg,redirecturl from mesky_cms_resource where " & strwhere & " and isauditing=1 and smallimg<>'' order by " & strorder & "")
else
set trs = execute("select top " & topnum & " id,title,smallimg,redirecturl from mesky_cms_resource where isauditing=1 and smallimg<>'' order by " & strorder & "")
end if
if trs.eof and trs.bof then
s = s & " <tr>" & vbcrlf
s = s & " <td>sorry！没有查询到任何记录。</td>" & vbcrlf
s = s & " </tr>" & vbcrlf
else
if iswh = 1 then s = s & " </tr>" & vbcrlf
do while not trs.eof
if iswh = 2 then s = s & " <tr>" & vbcrlf
if trs(3) <> "" then
s = s & " <td align=""center""><a href=""" & trs(3) & """ target=""_blank"" title=""" & trs(1) & """><img src=""" & spath & trs(2) & """ border=0 width=""" & intwidth & """ height=""" & intheight & """></a>"
s = s & "<br><a href=""" & trs(3) & """>" & cutstr(trs(1), int(cutnum)) & "</a></td>" & vbcrlf
else
s = s & " <td align=""center""><a href=""" & spath & replace(setting(101), "{$id}", trs(0)& "_1") & """ target=""_blank"" title=""" & trs(1) & """><img src=""" & spath & trs(2) & """ border=0 width=""" & intwidth & """ height=""" & intheight & """></a>"
s = s & "<br><a href=""" & spath & replace(setting(101), "{$id}", trs(0)& "_1") & """>" & cutstr(trs(1), int(cutnum)) & "</a></td>" & vbcrlf
end if
if iswh = 2 then s = s & " </tr>" & vbcrlf
trs.movenext
loop
end if
set trs = nothing
if iswh = 1 then s = s & " </tr>" & vbcrlf
s = s & "</table>" & vbcrlf
showcmsresimages = s
s = null
end function
public function showcmsresexcerptimages(strwhere, strorder, topnum, cutnum1, cutnum2, intwidth, intheight, iswh)
dim trs, s, i
i = 1
s = "<table width=""100%"" border=""0"" cellspacing=""0"" cellpadding=""3"">" & vbcrlf
if strwhere <> "" then
set trs = execute("select top " & topnum & " id,title,smallimg,excerpt,redirecturl from mesky_cms_resource where " & strwhere & " and isauditing=1 and smallimg<>'' order by " & strorder & "")
else
set trs = execute("select top " & topnum & " id,title,smallimg,excerpt,redirecturl from mesky_cms_resource where isauditing=1 and smallimg<>'' order by " & strorder & "")
end if
if trs.eof and trs.bof then
s = s & " <tr>" & vbcrlf
s = s & " <td>sorry！没有查询到任何记录。</td>" & vbcrlf
s = s & " </tr>" & vbcrlf
else
if iswh = 1 then s = s & " </tr>" & vbcrlf
do while not trs.eof
if iswh = 2 then s = s & " <tr>" & vbcrlf
s = s & " <td><img src=""" & spath & trs(2) & """ border=0 width=""" & intwidth & """ height=""" & intheight & """ align=""left"">"
if trs(4) <> "" then
s = s & "<a href=""" & trs(4) & """>" & cutstr(trs(1), int(cutnum1)) & "</a>"
else
s = s & "<a href=""" & spath & replace(setting(101), "{$id}", trs(0)& "_1") & """>" & cutstr(trs(1), int(cutnum1)) & "</a>"
end if
if int(cutnum2) > 0 then s = s & "<br>"&cutstr(trs(3),int(cutnum2))
s = s & "</td>" & vbcrlf
if iswh = 2 then s = s & " </tr>" & vbcrlf
trs.movenext
loop
end if
set trs = nothing
if iswh = 1 then s = s & " </tr>" & vbcrlf
s = s & "</table>" & vbcrlf
showcmsresexcerptimages = s
s = null
end function
'//截取指定长度字符串
'//返回类型：字符串
public function cutstr(str, strlen)
if str="" or isnull(str) then exit function
dim l, t, c, i
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
cutstr = left(str, i) & ".."
exit for
else
cutstr = str
end if
next
cutstr = replace(cutstr, chr(10), "")
end function
public sub systemmsg()
response.write "<table width=""75%"" align=""center"">" & vbcrlf
response.write " <tr>" & vbcrlf
response.write " <td>" & vbcrlf
response.write "<div class=containersection>" & vbcrlf
response.write " <div class=containertopborder>" & vbcrlf
response.write " <div class=containertop></div>" & vbcrlf
response.write " </div>" & vbcrlf
response.write " <div class=containercontent> system message:</div> " & vbcrlf
response.write " <div><br> <b>" & strmsg & "</b><br><br>" & vbcrlf
response.write " <div class=containercontent align=""center""><a href=""" & refererpage & """><<返回上一页</a>" & vbcrlf
response.write " </div> " & vbcrlf
response.write " </div>" & vbcrlf
response.write " <div class=bottomwrapper>" & vbcrlf
response.write " <div class=containerbottomborder>" & vbcrlf
response.write " <div class=containerbottom></div>" & vbcrlf
response.write " </div>" & vbcrlf
response.write " </div>" & vbcrlf
response.write "</div>" & vbcrlf
response.write " </td>" & vbcrlf
response.write " </tr>" & vbcrlf
response.write "</table>" & vbcrlf
end sub
public function copyright()
dim reval
reval = reval & "powered by <a href=""http://www.mesky.net"" title=""powered by www.mesky.net"">动感下载系统（meskydms）v3.0</a>"
copyright = reval
reval = null
end function
public function htmlhead()
dim reval
reval = reval & "<!--published date:" & now() & " powered by www.mesky.net-->" & vbcrlf
reval = reval & "<!--" & vbcrlf
reval = reval & "┌───────────────────── mesky─┐" & vbcrlf
reval = reval & "│动感下载系统v3.0 —— http://www.mesky.net │" & vbcrlf
reval = reval & "│ 程序购买 qq：26934364 手机：13586085531 │" & vbcrlf
reval = reval & "└───────────────────────.net┘" & vbcrlf
reval = reval & "-->" & vbcrlf
htmlhead = reval
reval = null
end function
public function dmsver()
if issqldatabase = 1 then
dmsver = "动感下载系统(meskydms) v3.0 build 050623 sql版"
else
dmsver = "动感下载系统(meskydms) v3.0 build 050623 access版"
end if
end function
public function f469e80d32(tr)
if request.servervariables("server_name")="127.0.0.1" then
f469e80d32 = "1"
exit function
end if
f469e80d32 = "0"
dim trs,tempstr, regcode
tempstr = request.servervariables("server_name") & "c0559f8d32"
regcode = md5(tempstr, 16)
set trs = execute("select * from mesky_key where regtype = " & tr)
if not (trs.eof and trs.bof) then
if trs("regcode") <> regcode then
f469e80d32 = "2"
elseif trs("regkey") <> md5(regcode & tr & "f469e80d32", 32) then
f469e80d32 = "0"
elseif trs("regcode") = regcode and trs("regkey") = md5(regcode & tr & "f469e80d32", 32) then
f469e80d32 = "1"
end if
end if
set trs = nothing
end function
public function c0559f8d32(tr)
c0559f8d32 = 0
end function
public function f469e88d32(tr)
f469e88d32 = 0
end function
public function execute(command)
if not isobject(conn) then connectiondatabase
'检查权限,防止注入攻击。
'if instr(lcase(command),"mesky_sitemanager")>0 and left(scriptname,6)<> "mesky_sitemanager" then
'if savelog=1 then
'response.write savesqllog(command,"")
'end if
'command=replace(lcase(command),"mesky_sitemanager","mesky<i>"&chr(95)&"</i>sitemanager")
'end if
if isdebug = 0 then
on error resume next
set execute = conn.execute(command)
if err then
err.clear
set conn = nothing
if savelog = 1 then
response.write savesqllog(command, "查询数据的时候发现错误，请检查您的查询代码是否正确。<br>基于安全的理由，只显示本信息，要查看详细的错误信息，请修改您的程序文件conn.asp。把""const isdebug = 0""改为：""const isdebug = 1""")
else
response.write "查询数据的时候发现错误，请检查您的查询代码是否正确。"
end if
response.end
end if
else
'response.write command & "<br>"
set execute = conn.execute(command)
end if
sqlquerynum = sqlquerynum + 1
end function
'---------------------------------------------------------------------
'时间格式化
'参数：时间，格式模板
'返回：格式化后的字符串
'备注：格式化关键词详解：
' "{y}" : 4位年
' "{y}" : 2位年
' "{m}" : 不补位的月
' "{m}" : 补位的月,如03,01
' "{d}" : 不补位的日
' "{d}" : 补位的日
' "{h}" : 不补位的小时
' "{h}" : 补位的小时
' "{mi}": 不补位的分钟
' "{mi}": 补位的分钟
' "{s}" : 不补位的秒
' "{s}" : 补位的秒
'---------------------------------------------------------------------
public function formatmydate(mydate, template)
if not isdate(mydate) or template = "" then
formatmydate = ""
exit function
end if
dim myear, mmonth, mday, mhour, mmin, msec
myear = year(mydate)
mmonth = month(mydate)
mday = day(mydate)
mhour = hour(mydate)
mmin = minute(mydate)
msec = second(mydate)
formatmydate = template
formatmydate = replace(formatmydate, "{y}", year(mydate))
formatmydate = replace(formatmydate, "{y}", right(year(mydate), 2))
formatmydate = replace(formatmydate, "{m}", month(mydate))
formatmydate = replace(formatmydate, "{m}", right("00" & month(mydate), 2))
formatmydate = replace(formatmydate, "{d}", day(mydate))
formatmydate = replace(formatmydate, "{d}", right("00" & day(mydate), 2))
formatmydate = replace(formatmydate, "{h}", hour(mydate))
formatmydate = replace(formatmydate, "{h}", right("00" & hour(mydate), 2))
formatmydate = replace(formatmydate, "{mi}", minute(mydate))
formatmydate = replace(formatmydate, "{mi}", right("00" & minute(mydate), 2))
formatmydate = replace(formatmydate, "{s}", second(mydate))
formatmydate = replace(formatmydate, "{s}", right("00" & second(mydate), 2))
if formatdatetime(mydate, 1) = formatdatetime(date, 1) then
formatmydate = "<font color=red>" & formatmydate & "</font>"
end if
'template = null
end function
rem 判断发言是否来自外部
public function chkpost()
dim server_v1, server_v2
chkpost = false
server_v1 = cstr(request.servervariables("http_referer"))
server_v2 = cstr(request.servervariables("server_name"))
if mid(server_v1, 8, len(server_v2)) <> server_v2 then
chkpost = false
else
chkpost = true
end if
end function
'过滤sql非法字符
public function checkstr(str)
if isnull(str) then
checkstr = ""
exit function
end if
str = replace(str, chr(0), "")
checkstr = replace(str, "'", "''")
end function
'显示验证码
public function getcode()
dim test
on error resume next
'set test = server.createobject("adodb.stream")
'set test = nothing
if err then
dim znum
randomize timer
znum = cint(8999 * rnd + 1000)
session("getcode") = znum
getcode = "<input type=""text"" name=""codestr"" maxlength=""4"" size=""4""> " & session("getcode")
else
getcode = "<input type=""text"" name=""codestr"" maxlength=""4"" size=""4""> <img src=""getcode.asp"">"
end if
end function
'检查验证码是否正确
public function codeistrue()
dim codestr
codestr = trim(request("codestr"))
if cstr(session("getcode")) = cstr(codestr) and codestr <> "" then
codeistrue = true
session("getcode") = empty
else
codeistrue = false
session("getcode") = empty
end if
end function
'系统分配随机密码
public function createpass()
dim ran, i, lengthnum
lengthnum = 16
createpass = ""
for i = 1 to lengthnum
randomize
ran = cint(rnd * 2)
randomize
if ran = 0 then
ran = cint(rnd * 25) + 97
createpass = createpass & ucase(chr(ran))
elseif ran = 1 then
ran = cint(rnd * 9)
createpass = createpass & ran
elseif ran = 2 then
ran = cint(rnd * 25) + 97
createpass = createpass & chr(ran)
end if
next
end function
'//从html标签中取出文本内容
public function gettextfromhtml(strhtml)
strhtml = replace(replace(replace(replace(strhtml, "<br>", vbcrlf), "<br>", vbcrlf), "</p>", vbcrlf & vbcrlf), "</p>", vbcrlf & vbcrlf)
dim strpatrn
strpatrn = "<.*?>"
dim regex
set regex = new regexp
regex.pattern = strpatrn
regex.ignorecase = true
regex.global = true
gettextfromhtml = regex.replace(strhtml, "")
set regex = nothing
end function
'//检测email
'//返回:true/false
public function checkemail(strng)
checkemail = false
dim regex, match
set regex = new regexp
regex.pattern = "^\w+((-\w+)|(\.\w+))*\@[a-za-z0-9]+((\.|-)[a-za-z0-9]+)*\.[a-za-z0-9]+$"
regex.ignorecase = true
set match = regex.execute(strng)
if match.count then checkemail = true
set match = nothing
set regex = nothing
end function
'//字符串是否在[0-9]&[a-z]及下划线中（不区分大小写）
'//返回:true/false
public function ischar26andint(str)
ischar26andint = true
dim regex, match
set regex = new regexp
regex.pattern = "[\w]{1,}?"
regex.ignorecase = true
set match = regex.execute(str)
if match.count >= 1 then
ischar26andint = false
end if
set match = nothing
set regex = nothing
end function
'//字符串是否在[a-z]中（不区分大小写）
'//返回:true/false
public function ischar26(str)
ischar26 = true
dim regex, match
set regex = new regexp
regex.pattern = "[^a-za-z]{1,}?"
regex.ignorecase = true
set match = regex.execute(str)
if match.count >= 1 then
ischar26 = false
end if
set match = nothing
set regex = nothing
end function
'//字符串是否在[0-9]中（不区分大小写）
public function isintchar(str)
isintchar = true
dim regex, match
set regex = new regexp
regex.pattern = "\d{1,}?"
regex.ignorecase = true
set match = regex.execute(str)
if match.count >= 1 then
isintchar = false
end if
set match = nothing
set regex = nothing
end function
'//html字符串转js字符串
public function htmltojs(strhtml)
if trim(strhtml) = "" then
htmltojs = ""
exit function
end if
strhtml = replace(strhtml, "\", "\\")
strhtml = replace(strhtml, """", "\""")
strhtml = replace(strhtml, vbcrlf, "")
htmltojs = strhtml
end function
'//转换html关键标签为html特殊字符串
public function htmlencode(str)
if not isnull(str) then
str = replace(str, chr(13), "")
str = replace(str, chr(10) & chr(10), "<p></p>")
str = replace(str, chr(10), "<br>")
str = replace(str, ">", ">")
str = replace(str, "<", "<")
str = replace(str, "&", "&")
str = replace(str, " ", " ")
str = replace(str, """", """)
htmlencode = str
str = null
end if
end function
public function htmlencode1(str)
if not isnull(str) then
str = replace(str, chr(32) & chr(32) & chr(32), " ")
str = replace(str, chr(13), "")
str = replace(str, chr(10) & chr(10), "<br>")
str = replace(str, chr(10), "<br>")
htmlencode1 = str
str = null
end if
end function
function htmltodata(str)
if isnull(str) then
htmltodata = ""
exit function
end if
str = replace(str, "&", "&")
str = replace(str, chr(13), " ") '回车符
str = replace(str, chr(10), " ") '换行符
str = replace(str, chr(9), " ") '制表符
str = replace(str, "'", "'") '单引号
str = replace(str, """", """) '双引号
str = replace(str, "<", "<")
str = replace(str, ">", ">")
htmltodata = str
str = null
end function
'//转换html关键标签为html特殊字符串(不转换硬回车及软回车符)
public function htmlencode2(str)
if not isnull(str) then
str = replace(str, ">", ">")
str = replace(str, "<", "<")
'str = replace(str, "&", "&")
'str = replace(str, " ", " ")
'str = replace(str, """", """)
htmlencode2 = str
str = null
end if
end function
'//函数：字符串替换
'//参数：正则表达式,被替换字符串,替换字符串
public function replacetest(patrn, mstr, replstr)
dim regex
set regex = new regexp
regex.pattern = patrn
regex.ignorecase = true
regex.global = true
replacetest = regex.replace(mstr, replstr)
set regex = nothing
end function
'//函数：字符串查找
'//参数：正则表达式,被替换字符串,替换字符串
'//返回：bool(true:找到)
public function findtext(patrn, mstr)
dim regex
set regex = new regexp
regex.pattern = patrn
regex.ignorecase = true
regex.global = true
findtext = regex.test(mstr)
set regex = nothing
end function
'//检测是否含有禁止字符串
'//参数:被检测字符串,禁止字符列表(以,号隔开)
'//返回:true(含有违禁字符)/false
'//例：mycharclass.badword("你他妈的王八蛋，fuck you","fuck you,王八蛋,you are pig")
public function badword(str, badwordlist)
badword = false
dim arrbadword
arrbadword = split(badwordlist, ",", -1, 1)
dim regex
set regex = new regexp
regex.ignorecase = true '不区分大小写
regex.global = true
dim match
dim i
for i = 0 to ubound(arrbadword)
response.write arrbadword(i) & "<br>"
if arrbadword(i) <> "" then
regex.pattern = arrbadword(i)
set match = regex.execute(str)
if match.count then
badword = true
exit for
end if
end if
next
end function
'关键字着色
public function keywordcolor(str, keyword)
keywordcolor = replacetest(keyword, str, "<font color=red>" & keyword & "</font>")
end function
'获取字符中首字字符
'返回：a-z ;123 ; ###
public function getspellchar(str)
dim tmp
getspellchar = "@"
tmp = 65536 + asc(str)
if (tmp >= 45217 and tmp <= 45252) or (tmp = 65601) or (tmp = 65633) or (tmp = 37083) then
getspellchar = "a1"
elseif (tmp >= 45253 and tmp <= 45760) or (tmp = 65602) or (tmp = 65634) or (tmp = 39658) then
getspellchar = "b1"
elseif (tmp >= 45761 and tmp <= 46317) or (tmp = 65603) or (tmp = 65635) or (tmp = 33405) then
getspellchar = "c1"
elseif (tmp >= 46318 and tmp <= 46930) or (tmp = 61884) or (tmp = 63468) or (tmp = 65604) or (tmp >= 36820 and tmp <= 38524) or (tmp = 65636) then
getspellchar = "d1"
elseif (tmp >= 46931 and tmp <= 47009) or (tmp >= 46827 and tmp <= 46842) or (tmp = 65605) or (tmp = 65637) or (tmp = 61513) then '46827 46833 46842
getspellchar = "e1"
elseif (tmp >= 47010 and tmp <= 47296) or (tmp = 65606) or (tmp = 65638) or (tmp = 61320) or (tmp = 63568) or (tmp = 36281) then
getspellchar = "f1"
elseif (tmp >= 47297 and tmp <= 47613) or (tmp = 65607) or (tmp = 65639) or (tmp = 35949) or (tmp = 36089) or (tmp = 36694) or (tmp = 34808) then
getspellchar = "g1"
elseif (tmp >= 47614 and tmp <= 48118) or (tmp = 59112) or (tmp = 40296) or (tmp = 65608) or (tmp = 65640) then
getspellchar = "h1"
elseif (tmp = 65641) or (tmp = 65609) or (tmp = 65641) then
getspellchar = "i1"
elseif (tmp >= 48119 and tmp <= 49061 and tmp <> 48739) or (tmp >= 62430 and tmp <= 62430) or (tmp = 65610) or (tmp = 65642) or (tmp = 39048) then
getspellchar = "j1"
elseif (tmp >= 49062 and tmp <= 49323) or (tmp = 65611) or (tmp = 65643) then
getspellchar = "k1"
elseif (tmp >= 49324 and tmp <= 49895) or (tmp >= 58838 and tmp <= 58838) or (tmp = 65612) or (tmp = 65644) or (tmp = 62418) or (tmp = 48739) then
getspellchar = "l1"
elseif (tmp >= 49896 and tmp <= 50370) or (tmp = 63432) or (tmp = 65613) or (tmp = 65645) then
getspellchar = "m1"
elseif (tmp >= 50371 and tmp <= 50613) or (tmp = 65614) or (tmp = 65646) then
getspellchar = "n1"
elseif (tmp >= 50614 and tmp <= 50621) or (tmp = 65615) or (tmp = 65615) or (tmp = 65647) then
getspellchar = "o1"
elseif (tmp >= 50622 and tmp <= 50905) or (tmp = 65616) or (tmp = 65648) then
getspellchar = "p1"
elseif (tmp >= 50906 and tmp <= 51386) or (tmp >= 62659 and tmp <= 63172) or (tmp = 63464) or (tmp = 63226) or (tmp = 65617) or (tmp = 65649) then
getspellchar = "q1"
elseif (tmp >= 51387 and tmp <= 51445) or (tmp = 65618) or (tmp = 65650) then
getspellchar = "r1"
elseif (tmp >= 51446 and tmp <= 52217) or (tmp = 65619) or (tmp = 65651) or (tmp = 34009) then
getspellchar = "s1"
elseif (tmp >= 52218 and tmp <= 52697) or (tmp = 65620) or (tmp = 65652) then
getspellchar = "t1"
elseif (tmp = 65621) or (tmp = 65653) then
getspellchar = "u1"
elseif (tmp = 65622) or (tmp = 65654) then
getspellchar = "v1"
elseif (tmp >= 52698 and tmp <= 52979) or (tmp = 65623) or (tmp = 65655) then
getspellchar = "w1"
elseif (tmp >= 52980 and tmp <= 53688) or (tmp = 63182) or (tmp = 65624) or (tmp = 65656) then
getspellchar = "x1"
elseif (tmp >= 53689 and tmp <= 54480) or (tmp = 65625) or (tmp = 65657) then
getspellchar = "y1"
elseif (tmp >= 54481 and tmp <= 62383 and tmp <> 59112 and tmp <> 58838 and tmp <> 57566) or (tmp = 65626) or (tmp = 65658) or (tmp = 38395) or (tmp = 39783) then
getspellchar = "z1"
end if
if (tmp >= 65601 and tmp <= 65658) then getspellchar = ucase(left(trim(str), 1)) '字母
if (tmp >= 65584 and tmp <= 65593) then getspellchar = "123" '数字
'response.write(tmp)
end function
2
您可能感兴趣的文章:
如您对本文有疑问或者有任何想说的，请 点击进行留言回复，万千网友为您解惑！
网友评论