newasp中main類
<%
const isdebug = 1
class newaspmain_cls
public membername, memberpass, membergrade, membergroup, memberid
public memberclass, menbernickname, cookies_name, checkpassword
public sitename, siteurl, mastermail, keywords, copyright
public installdir, indexname, istopsite, stopreadme, isclosemail
public sendmailtype, mailfrom, mailserver, mailusername, mailpassword, mailinformpass, chksamemail
public checkuserreg, admincheckreg, adduserpoint, sendregmessage, fullcontquery, actiontime
public isruntime, uploadclass, uploadfilesize, uploadfiletype, contentkeyword, previewsetting
public stopapplylink, fso_scriptname, inittitlecolor, stopbankpay
public chinaebank, versionid, badwords, badwordr, serialcode, passedcode
public channelname, channeldir, stopchannel, channeltype
public modules, channelskin, htmlpath, htmlform, htmlprefix
public iscreatehtml, htmlextname, stopupload, maxfilesize, upfiletype
public isauditing, appeargrade, modulename, binddomain, domainname
public postgrade, leaststring, maxstring, paginalnum, leasthothist, channel_setting
public channelsetting,channeldata,channelpath
public channelmodule,channelhtmlpath,channelhtmlform,channelusehtml,channelhtmlext,channelprefix
public thisedition, copyrightstr, version, values, startime
public sqlquerynum, getuserip, cachename, reloadtime
public scriptname, admin_page, skinid, skinpath, htmlcss, htmltop, htmlfoot, htmlcontent, shtmlcontent
private main_style, main_setting, mainstyle, html_setting
private localcachename, cache_data
private cachechannel, cachedata
private arrgroupsetting, blngroupsetting, binuserlong
private sub class_initialize()
on error resume next
reloadtime = 28800
sqlquerynum = 0
'--緩存名稱
cachename = "newasp"
cookies_name = "newasp_net"
binuserlong = false
blngroupsetting = false
getuserip = request.servervariables("http_x_forwarded_for")
if len(getuserip) = 0 then getuserip = request.servervariables("remote_addr")
getuserip = checkstr(getuserip)
membername = checkstr(request.cookies(cookies_name)("username"))
memberpass = checkstr(request.cookies(cookies_name)("password"))
menbernickname = checkstr(request.cookies(cookies_name)("nickname"))
membergrade = chknumeric(request.cookies(cookies_name)("usergrade"))
membergroup = checkstr(request.cookies(cookies_name)("usergroup"))
memberclass = chknumeric(request.cookies(cookies_name)("userclass"))
memberid = chknumeric(request.cookies(cookies_name)("userid"))
checkpassword = checkstr(request.cookies(cookies_name)("checkpassword"))
dim tmpstr, i
tmpstr = request.servervariables("path_info")
tmpstr = split(tmpstr, "/")
i = ubound(tmpstr)
scriptname = lcase(tmpstr(i))
admin_page = false
if instr(scriptname, "showerr") > 0 or instr(scriptname, "login") > 0 or instr(scriptname, "admin_") > 0 then admin_page = true
end sub
private sub class_terminate()
if isobject(conn) then conn.close : set conn = nothing
end sub
'===================服務器緩存部分函數開始===================
public property let name(byval vnewvalue)
localcachename = lcase(vnewvalue)
cache_data = application(cachename & "_" & localcachename)
end property
public property let value(byval vnewvalue)
if localcachename <> "" then
redim cache_data(2)
cache_data(0) = vnewvalue
cache_data(1) = now()
application.lock
application(cachename & "_" & localcachename) = cache_data
application.unlock
else
err.raise vbobjecterror + 1, "newaspcacheserver", " please change the cachename."
end if
end property
public property get value()
if localcachename <> "" then
if isarray(cache_data) then
value = cache_data(0)
else
'err.raise vbobjecterror + 1, "newaspcacheserver", " the cache_data("&localcachename&") is empty."
end if
else
err.raise vbobjecterror + 1, "newaspcacheserver", " please change the cachename."
end if
end property
public function objisempty()
objisempty = true
if not isarray(cache_data) then exit function
if not isdate(cache_data(1)) then exit function
if datediff("s", cdate(cache_data(1)), now()) < (60 * reloadtime) then objisempty = false
end function
public sub delcahe(mycahename)
application.lock
application.contents.remove (cachename & "_" & mycahename)
application.unlock
end sub
public sub delcache(mycahename)
application.lock
application.contents.remove ("mynewasp_" & mycahename)
application.unlock
end sub
'===================服務器緩存部分函數結束===================
public function chkboolean(byval values)
if typename(values) = "boolean" or isnumeric(values) or lcase(values) = "false" or lcase(values) = "true" then
chkboolean = cbool(values)
else
chkboolean = false
end if
end function
public function checknumeric(byval check_id)
if check_id <> "" and isnumeric(check_id) then
check_id = ccur(check_id)
else
check_id = 0
end if
checknumeric = check_id
end function
public function chknumeric(byval check_id)
if check_id <> "" and isnumeric(check_id) then
check_id = clng(check_id)
if check_id < 0 then check_id = 0
else
check_id = 0
end if
chknumeric = check_id
end function
public function checkstr(byval str)
if isnull(str) then
checkstr = ""
exit function
end if
str = replace(str, chr(0), "")
checkstr = replace(str, "'", "''")
end function
'================================================
'過程名：checknull
'作 用：是否有效值
'================================================
public function checknull(byval svalue)
on error resume next
if isnull(svalue) then
checknull = false
exit function
end if
if trim(svalue) <> "" and lcase(trim(svalue)) <> "http://" then
checknull = true
else
checknull = false
end if
end function
public function chknull(byval str)
on error resume next
if isnull(str) then
chknull = ""
exit function
end if
if trim(str) <> "" and lcase(trim(str)) <> "http://" then
chknull = trim(str)
else
chknull = ""
end if
end function
'=============================================================
'函數名：chkformstr
'作 用：過濾表單字符
'參 數：str ----原字符串
'返回值：過濾后的字符串
'=============================================================
public function chkformstr(byval str)
dim fstring
fstring = str
if isnull(fstring) then
chkformstr = ""
exit function
end if
fstring = replace(fstring, "'", "'")
fstring = replace(fstring, chr(34), """)
fstring = replace(fstring, chr(13), "")
fstring = replace(fstring, chr(10), "")
fstring = replace(fstring, chr(9), "")
fstring = replace(fstring, ">", ">")
fstring = replace(fstring, "<", "<")
fstring = replace(fstring, "%", "％")
chkformstr = trim(japencode(fstring))
end function
'=============================================================
'函數作用：過濾sql非法字符
'=============================================================
public function checkrequest(byval str,byval strlen)
on error resume next
str = trim(str)
str = replace(str, chr(0), "")
str = replace(str, "'", "")
str = replace(str, "%", "")
str = replace(str, "^", "")
str = replace(str, ";", "")
str = replace(str, "*", "")
str = replace(str, "<", "")
str = replace(str, ">", "")
str = replace(str, "|", "")
str = replace(str, "and", "")
str = replace(str, "chr", "")
if len(str) > 0 and strlen > 0 then
str = left(str, strlen)
end if
checkrequest = str
end function
'-- 移除有害字符
public function removebadcharacters(byval strtemp)
dim re
on error resume next
set re = new regexp
re.pattern = "[^\s\w]"
re.global = true
removebadcharacters = re.replace(strtemp, "")
set re = nothing
end function
'-- 去掉html標記
public function removehtml(byval textstr)
dim str,re
str = textstr
on error resume next
set re = new regexp
re.ignorecase = true
re.global = true
re.pattern = "<(.[^>]*)>"
str = re.replace(str, "")
set re = nothing
removehtml=str
end function
'-- 數據庫連接
public function execute(command)
if not isobject(conn) then connectiondatabase
if isdebug = 0 then
on error resume next
set execute = conn.execute(command)
if err then
err.clear
set conn = nothing
response.write "查詢數據的時候發現錯誤，請檢查您的查詢代碼是否正確。
"
response.write command
response.end
end if
else
set execute = conn.execute(command)
end if
sqlquerynum = sqlquerynum+1
end function
public sub readconfig()
on error resume next
name = "config"
if objisempty() then reloadconfig
cachedata = value
'第一次起用系統或者重啟iis的時候加載緩存
name = "date"
if objisempty() then
value = date
else
if cstr(value) <> cstr(date) then
name = "config"
call reloadconfig
cachedata = value
end if
end if
sitename = cachedata(1, 0): siteurl = cachedata(2, 0): mastermail = cachedata(3, 0): keywords = cachedata(4, 0): copyright = cachedata(5, 0): installdir = cachedata(6, 0)
indexname = cachedata(7, 0): istopsite = cachedata(8, 0): stopreadme = cachedata(9, 0): isclosemail = cachedata(10, 0): sendmailtype = cachedata(11, 0): mailfrom = cachedata(12, 0)
mailserver = cachedata(13, 0): mailusername = cachedata(14, 0): mailpassword = cachedata(15, 0): checkuserreg = cachedata(16, 0): admincheckreg = cachedata(17, 0): mailinformpass = cachedata(18, 0)
chksamemail = cachedata(19, 0): adduserpoint = cachedata(20, 0): sendregmessage = cachedata(21, 0): fullcontquery = cachedata(22, 0): actiontime = cachedata(23, 0): isruntime = cachedata(24, 0)
uploadclass = cachedata(25, 0): uploadfilesize = cachedata(26, 0): uploadfiletype = cachedata(27, 0): contentkeyword = cachedata(28, 0): stopapplylink = cachedata(29, 0): fso_scriptname = cachedata(30, 0)
inittitlecolor = cachedata(31, 0): stopbankpay = cachedata(32, 0): chinaebank = cachedata(33, 0): versionid = cachedata(34, 0): badwords = cachedata(35, 0): badwordr = cachedata(36, 0)
serialcode = cachedata(37, 0): passedcode = cachedata(38, 0) : previewsetting = cachedata(39, 0)
thisedition = "免費版 (free edition)"
version = "powered by：newcloud sitemanagesystem version 2.0.0 sp1"
copyrightstr = "" & vbcrlf
if cint(istopsite) = 1 and not admin_page then response.redirect ("" & siteurl & installdir & "showerr.asp?action=stop")
end sub
public sub reloadconfig()
dim sql, rs
on error resume next
sql = "select * from [nc_config] "
set rs = execute(sql)
value = rs.getrows(1)
set rs = nothing
end sub
'=============================================================
'過程名：reloadchannel
'作 用：再裝頻道設置
'參 數：channelid ----頻道id
'=============================================================
private sub reloadchannel(channelid)
dim sql, rs
on error resume next
sql = "select channelid,channelname,channeldir,stopchannel,channeltype,modules,modulename,binddomain,domainname,channelskin,htmlpath,htmlform,iscreatehtml,htmlextname,htmlprefix,stopupload,maxfilesize,upfiletype,isauditing,appeargrade,postgrade,leaststring,maxstring,paginalnum,leasthothist,channel_setting from nc_channel where channeltype <= 1 and channelid = " & clng(channelid)
set rs = execute(sql)
if rs.bof and rs.eof then
response.write "錯誤的頻道參數！"
exit sub
end if
value = rs.getrows(1)
set rs = nothing
end sub
'=============================================================
'過程名：readchannel
'作 用：讀取頻道設置
'參 數：channelid ----頻道id
'=============================================================
public sub readchannel(channelid)
on error resume next
if not isnumeric(channelid) then channelid = 1
channelid = clng(channelid)
name = "channel" & channelid
if objisempty() then call reloadchannel(channelid)
cachechannel = value
if clng(cachechannel(0, 0)) <> channelid then
call reloadchannel(channelid)
cachechannel = value
end if
channelname = cachechannel(1, 0): channeldir = cachechannel(2, 0): stopchannel = cachechannel(3, 0): channeltype = cachechannel(4, 0): modules = cachechannel(5, 0): modulename = cachechannel(6, 0): binddomain = cachechannel(7, 0): domainname = cachechannel(8, 0): channelskin = cachechannel(9, 0): htmlpath = cachechannel(10, 0)
htmlform = cachechannel(11, 0): iscreatehtml = cachechannel(12, 0): htmlextname = cachechannel(13, 0): htmlprefix = cachechannel(14, 0): stopupload = cachechannel(15, 0): maxfilesize = cachechannel(16, 0): upfiletype = cachechannel(17, 0): isauditing = cachechannel(18, 0): appeargrade = cachechannel(19, 0)
postgrade = cachechannel(20, 0): leaststring = cachechannel(21, 0): maxstring = cachechannel(22, 0): paginalnum = cachechannel(23, 0): leasthothist = cachechannel(24, 0): channel_setting = cachechannel(25, 0)
if cint(stopchannel) = 1 and not admin_page then response.redirect (installdir & "showerr.asp?action=chanstop")
end sub
public sub loadchannel(chanid)
on error resume next
dim rs,sql,tmpdata
chanid = clng(chanid)
name = "mychannel" & chanid
if objisempty() then
sql = "select channelname,channeldir,modulename,htmlpath,htmlform,iscreatehtml,htmlextname,htmlprefix,stopupload,leaststring,maxstring,leasthothist from nc_channel where channeltype<=1 and channelid= " & clng(chanid)
set rs = execute(sql)
tmpdata = rs.getstring(, , "|||", "
const isdebug = 1
class newaspmain_cls
public membername, memberpass, membergrade, membergroup, memberid
public memberclass, menbernickname, cookies_name, checkpassword
public sitename, siteurl, mastermail, keywords, copyright
public installdir, indexname, istopsite, stopreadme, isclosemail
public sendmailtype, mailfrom, mailserver, mailusername, mailpassword, mailinformpass, chksamemail
public checkuserreg, admincheckreg, adduserpoint, sendregmessage, fullcontquery, actiontime
public isruntime, uploadclass, uploadfilesize, uploadfiletype, contentkeyword, previewsetting
public stopapplylink, fso_scriptname, inittitlecolor, stopbankpay
public chinaebank, versionid, badwords, badwordr, serialcode, passedcode
public channelname, channeldir, stopchannel, channeltype
public modules, channelskin, htmlpath, htmlform, htmlprefix
public iscreatehtml, htmlextname, stopupload, maxfilesize, upfiletype
public isauditing, appeargrade, modulename, binddomain, domainname
public postgrade, leaststring, maxstring, paginalnum, leasthothist, channel_setting
public channelsetting,channeldata,channelpath
public channelmodule,channelhtmlpath,channelhtmlform,channelusehtml,channelhtmlext,channelprefix
public thisedition, copyrightstr, version, values, startime
public sqlquerynum, getuserip, cachename, reloadtime
public scriptname, admin_page, skinid, skinpath, htmlcss, htmltop, htmlfoot, htmlcontent, shtmlcontent
private main_style, main_setting, mainstyle, html_setting
private localcachename, cache_data
private cachechannel, cachedata
private arrgroupsetting, blngroupsetting, binuserlong
private sub class_initialize()
on error resume next
reloadtime = 28800
sqlquerynum = 0
'--緩存名稱
cachename = "newasp"
cookies_name = "newasp_net"
binuserlong = false
blngroupsetting = false
getuserip = request.servervariables("http_x_forwarded_for")
if len(getuserip) = 0 then getuserip = request.servervariables("remote_addr")
getuserip = checkstr(getuserip)
membername = checkstr(request.cookies(cookies_name)("username"))
memberpass = checkstr(request.cookies(cookies_name)("password"))
menbernickname = checkstr(request.cookies(cookies_name)("nickname"))
membergrade = chknumeric(request.cookies(cookies_name)("usergrade"))
membergroup = checkstr(request.cookies(cookies_name)("usergroup"))
memberclass = chknumeric(request.cookies(cookies_name)("userclass"))
memberid = chknumeric(request.cookies(cookies_name)("userid"))
checkpassword = checkstr(request.cookies(cookies_name)("checkpassword"))
dim tmpstr, i
tmpstr = request.servervariables("path_info")
tmpstr = split(tmpstr, "/")
i = ubound(tmpstr)
scriptname = lcase(tmpstr(i))
admin_page = false
if instr(scriptname, "showerr") > 0 or instr(scriptname, "login") > 0 or instr(scriptname, "admin_") > 0 then admin_page = true
end sub
private sub class_terminate()
if isobject(conn) then conn.close : set conn = nothing
end sub
'===================服務器緩存部分函數開始===================
public property let name(byval vnewvalue)
localcachename = lcase(vnewvalue)
cache_data = application(cachename & "_" & localcachename)
end property
public property let value(byval vnewvalue)
if localcachename <> "" then
redim cache_data(2)
cache_data(0) = vnewvalue
cache_data(1) = now()
application.lock
application(cachename & "_" & localcachename) = cache_data
application.unlock
else
err.raise vbobjecterror + 1, "newaspcacheserver", " please change the cachename."
end if
end property
public property get value()
if localcachename <> "" then
if isarray(cache_data) then
value = cache_data(0)
else
'err.raise vbobjecterror + 1, "newaspcacheserver", " the cache_data("&localcachename&") is empty."
end if
else
err.raise vbobjecterror + 1, "newaspcacheserver", " please change the cachename."
end if
end property
public function objisempty()
objisempty = true
if not isarray(cache_data) then exit function
if not isdate(cache_data(1)) then exit function
if datediff("s", cdate(cache_data(1)), now()) < (60 * reloadtime) then objisempty = false
end function
public sub delcahe(mycahename)
application.lock
application.contents.remove (cachename & "_" & mycahename)
application.unlock
end sub
public sub delcache(mycahename)
application.lock
application.contents.remove ("mynewasp_" & mycahename)
application.unlock
end sub
'===================服務器緩存部分函數結束===================
public function chkboolean(byval values)
if typename(values) = "boolean" or isnumeric(values) or lcase(values) = "false" or lcase(values) = "true" then
chkboolean = cbool(values)
else
chkboolean = false
end if
end function
public function checknumeric(byval check_id)
if check_id <> "" and isnumeric(check_id) then
check_id = ccur(check_id)
else
check_id = 0
end if
checknumeric = check_id
end function
public function chknumeric(byval check_id)
if check_id <> "" and isnumeric(check_id) then
check_id = clng(check_id)
if check_id < 0 then check_id = 0
else
check_id = 0
end if
chknumeric = check_id
end function
public function checkstr(byval str)
if isnull(str) then
checkstr = ""
exit function
end if
str = replace(str, chr(0), "")
checkstr = replace(str, "'", "''")
end function
'================================================
'過程名：checknull
'作 用：是否有效值
'================================================
public function checknull(byval svalue)
on error resume next
if isnull(svalue) then
checknull = false
exit function
end if
if trim(svalue) <> "" and lcase(trim(svalue)) <> "http://" then
checknull = true
else
checknull = false
end if
end function
public function chknull(byval str)
on error resume next
if isnull(str) then
chknull = ""
exit function
end if
if trim(str) <> "" and lcase(trim(str)) <> "http://" then
chknull = trim(str)
else
chknull = ""
end if
end function
'=============================================================
'函數名：chkformstr
'作 用：過濾表單字符
'參 數：str ----原字符串
'返回值：過濾后的字符串
'=============================================================
public function chkformstr(byval str)
dim fstring
fstring = str
if isnull(fstring) then
chkformstr = ""
exit function
end if
fstring = replace(fstring, "'", "'")
fstring = replace(fstring, chr(34), """)
fstring = replace(fstring, chr(13), "")
fstring = replace(fstring, chr(10), "")
fstring = replace(fstring, chr(9), "")
fstring = replace(fstring, ">", ">")
fstring = replace(fstring, "<", "<")
fstring = replace(fstring, "%", "％")
chkformstr = trim(japencode(fstring))
end function
'=============================================================
'函數作用：過濾sql非法字符
'=============================================================
public function checkrequest(byval str,byval strlen)
on error resume next
str = trim(str)
str = replace(str, chr(0), "")
str = replace(str, "'", "")
str = replace(str, "%", "")
str = replace(str, "^", "")
str = replace(str, ";", "")
str = replace(str, "*", "")
str = replace(str, "<", "")
str = replace(str, ">", "")
str = replace(str, "|", "")
str = replace(str, "and", "")
str = replace(str, "chr", "")
if len(str) > 0 and strlen > 0 then
str = left(str, strlen)
end if
checkrequest = str
end function
'-- 移除有害字符
public function removebadcharacters(byval strtemp)
dim re
on error resume next
set re = new regexp
re.pattern = "[^\s\w]"
re.global = true
removebadcharacters = re.replace(strtemp, "")
set re = nothing
end function
'-- 去掉html標記
public function removehtml(byval textstr)
dim str,re
str = textstr
on error resume next
set re = new regexp
re.ignorecase = true
re.global = true
re.pattern = "<(.[^>]*)>"
str = re.replace(str, "")
set re = nothing
removehtml=str
end function
'-- 數據庫連接
public function execute(command)
if not isobject(conn) then connectiondatabase
if isdebug = 0 then
on error resume next
set execute = conn.execute(command)
if err then
err.clear
set conn = nothing
response.write "查詢數據的時候發現錯誤，請檢查您的查詢代碼是否正確。
response.write command
response.end
end if
else
set execute = conn.execute(command)
end if
sqlquerynum = sqlquerynum+1
end function
public sub readconfig()
on error resume next
name = "config"
if objisempty() then reloadconfig
cachedata = value
'第一次起用系統或者重啟iis的時候加載緩存
name = "date"
if objisempty() then
value = date
else
if cstr(value) <> cstr(date) then
name = "config"
call reloadconfig
cachedata = value
end if
end if
sitename = cachedata(1, 0): siteurl = cachedata(2, 0): mastermail = cachedata(3, 0): keywords = cachedata(4, 0): copyright = cachedata(5, 0): installdir = cachedata(6, 0)
indexname = cachedata(7, 0): istopsite = cachedata(8, 0): stopreadme = cachedata(9, 0): isclosemail = cachedata(10, 0): sendmailtype = cachedata(11, 0): mailfrom = cachedata(12, 0)
mailserver = cachedata(13, 0): mailusername = cachedata(14, 0): mailpassword = cachedata(15, 0): checkuserreg = cachedata(16, 0): admincheckreg = cachedata(17, 0): mailinformpass = cachedata(18, 0)
chksamemail = cachedata(19, 0): adduserpoint = cachedata(20, 0): sendregmessage = cachedata(21, 0): fullcontquery = cachedata(22, 0): actiontime = cachedata(23, 0): isruntime = cachedata(24, 0)
uploadclass = cachedata(25, 0): uploadfilesize = cachedata(26, 0): uploadfiletype = cachedata(27, 0): contentkeyword = cachedata(28, 0): stopapplylink = cachedata(29, 0): fso_scriptname = cachedata(30, 0)
inittitlecolor = cachedata(31, 0): stopbankpay = cachedata(32, 0): chinaebank = cachedata(33, 0): versionid = cachedata(34, 0): badwords = cachedata(35, 0): badwordr = cachedata(36, 0)
serialcode = cachedata(37, 0): passedcode = cachedata(38, 0) : previewsetting = cachedata(39, 0)
thisedition = "免費版 (free edition)"
version = "powered by：newcloud sitemanagesystem version 2.0.0 sp1"
copyrightstr = "" & vbcrlf
if cint(istopsite) = 1 and not admin_page then response.redirect ("" & siteurl & installdir & "showerr.asp?action=stop")
end sub
public sub reloadconfig()
dim sql, rs
on error resume next
sql = "select * from [nc_config] "
set rs = execute(sql)
value = rs.getrows(1)
set rs = nothing
end sub
'=============================================================
'過程名：reloadchannel
'作 用：再裝頻道設置
'參 數：channelid ----頻道id
'=============================================================
private sub reloadchannel(channelid)
dim sql, rs
on error resume next
sql = "select channelid,channelname,channeldir,stopchannel,channeltype,modules,modulename,binddomain,domainname,channelskin,htmlpath,htmlform,iscreatehtml,htmlextname,htmlprefix,stopupload,maxfilesize,upfiletype,isauditing,appeargrade,postgrade,leaststring,maxstring,paginalnum,leasthothist,channel_setting from nc_channel where channeltype <= 1 and channelid = " & clng(channelid)
set rs = execute(sql)
if rs.bof and rs.eof then
response.write "錯誤的頻道參數！"
exit sub
end if
value = rs.getrows(1)
set rs = nothing
end sub
'=============================================================
'過程名：readchannel
'作 用：讀取頻道設置
'參 數：channelid ----頻道id
'=============================================================
public sub readchannel(channelid)
on error resume next
if not isnumeric(channelid) then channelid = 1
channelid = clng(channelid)
name = "channel" & channelid
if objisempty() then call reloadchannel(channelid)
cachechannel = value
if clng(cachechannel(0, 0)) <> channelid then
call reloadchannel(channelid)
cachechannel = value
end if
channelname = cachechannel(1, 0): channeldir = cachechannel(2, 0): stopchannel = cachechannel(3, 0): channeltype = cachechannel(4, 0): modules = cachechannel(5, 0): modulename = cachechannel(6, 0): binddomain = cachechannel(7, 0): domainname = cachechannel(8, 0): channelskin = cachechannel(9, 0): htmlpath = cachechannel(10, 0)
htmlform = cachechannel(11, 0): iscreatehtml = cachechannel(12, 0): htmlextname = cachechannel(13, 0): htmlprefix = cachechannel(14, 0): stopupload = cachechannel(15, 0): maxfilesize = cachechannel(16, 0): upfiletype = cachechannel(17, 0): isauditing = cachechannel(18, 0): appeargrade = cachechannel(19, 0)
postgrade = cachechannel(20, 0): leaststring = cachechannel(21, 0): maxstring = cachechannel(22, 0): paginalnum = cachechannel(23, 0): leasthothist = cachechannel(24, 0): channel_setting = cachechannel(25, 0)
if cint(stopchannel) = 1 and not admin_page then response.redirect (installdir & "showerr.asp?action=chanstop")
end sub
public sub loadchannel(chanid)
on error resume next
dim rs,sql,tmpdata
chanid = clng(chanid)
name = "mychannel" & chanid
if objisempty() then
sql = "select channelname,channeldir,modulename,htmlpath,htmlform,iscreatehtml,htmlextname,htmlprefix,stopupload,leaststring,maxstring,leasthothist from nc_channel where channeltype<=1 and channelid= " & clng(chanid)
set rs = execute(sql)
tmpdata = rs.getstring(, , "|||", "
", "")
tmpdata = left(tmpdata, len(tmpdata) - 3)
set rs = nothing
value = tmpdata
end if
channeldata = split(value, "|||")
channelpath = installdir & channeldata(1)
channelmodule = channeldata(2)
channelhtmlpath = channeldata(3)
channelhtmlform = channeldata(4)
channelusehtml = channeldata(5)
channelhtmlext = channeldata(6)
channelprefix = channeldata(7)
end sub
'=============================================================
'過程名：loadtemplates
'作 用：載入模板
'參 數：page_mark ----styleid
'=============================================================
public sub loadtemplates(channelid, pageid, styleid)
dim rstmp, tempskinid
on error resume next
channelid = clng(channelid)
pageid = cint(pageid)
name = "defaultskinid"
if objisempty() then
set rstmp = execute("select skinid from [nc_template] where pageid = 0 and isdefault = 1")
value = rstmp(0)
set rstmp = nothing
end if
tempskinid = value
if styleid = 0 or styleid = "" then
skinid = tempskinid
else
set rstmp = execute("select skinid from [nc_template] where pageid = 0 and skinid = " & styleid)
if not rstmp.eof then
skinid = rstmp(0)
else
skinid = tempskinid
end if
set rstmp = nothing
end if
skinid = clng(skinid)
name = "mainstyle" & skinid
if objisempty() then templatesmaincache (skinid)
main_style = value
skinpath = main_style(0, 0)
main_setting = split(main_style(2, 0), "|||")
mainstyle = main_style(1, 0)
'mainstyle = replace(mainstyle, "{$installdir}", readinstalldir(binddomain))
mainstyle = replace(mainstyle, "{$skinpath}", skinpath)
mainstyle = split(mainstyle, "|||")
htmlcss = mainstyle(0)
htmltop = mainstyle(1)
htmlfoot = mainstyle(2)
if pageid <> 0 then
name = "templates" & channelid & skinid & pageid
if objisempty() then
templatestocache channelid, pageid
end if
byvalue = value
end if
end sub
private sub templatestocache(channelid, pageid)
on error resume next
dim rs, sql, rstmp
sql = "select skinid,page_content,page_setting from [nc_template] where channelid = " & channelid & " and skinid = " & skinid & " and pageid = " & pageid
set rs = execute(sql)
if not rs.eof then
value = rs.getrows(1)
else
set rstmp = execute("select skinid,page_content,page_setting from [nc_template] where channelid = " & channelid & " and isdefault = 1 and pageid = " & pageid)
value = rstmp.getrows(1)
set rstmp = nothing
end if
set rs = nothing
end sub
private sub templatesmaincache(skinid)
on error resume next
dim rs, sql, rstmp
sql = "select templatedir,page_content,page_setting from [nc_template] where pageid = 0 and skinid = " & skinid & " and channelid = 0"
set rs = execute(sql)
if not rs.eof then
value = rs.getrows(1)
else
set rstmp = execute("select templatedir,page_content,page_setting from [nc_template] where pageid = 0 and isdefault = 1 and channelid = 0")
value = rstmp.getrows(1)
set rstmp = nothing
end if
set rs = nothing
end sub
public property let byvalue(byval vnewvalue)
dim tmpstr
tmpstr = vnewvalue
html_setting = tmpstr(2, 0)
html_setting = split(html_setting, "|||")
htmlcontent = tmpstr(1, 0)
if cint(html_setting(0)) <> 0 then
htmlcontent = htmltop & htmlcontent & htmlfoot
end if
htmlcontent = replace(htmlcontent, "{$style_css}", htmlcss)
htmlcontent = replace(htmlcontent, "{$skinpath}", skinpath)
htmlcontent = replace(htmlcontent, "{$width}", main_setting(0))
htmlcontent = replace(htmlcontent, "{$channelmenu}", channelmenu)
htmlcontent = replace(htmlcontent, "{$websitename}", sitename)
htmlcontent = replace(htmlcontent, "{$websiteurl}", siteurl)
htmlcontent = replace(htmlcontent, "{$mastermail}", mastermail)
htmlcontent = replace(htmlcontent, "{$keyword}", keywords)
htmlcontent = replace(htmlcontent, "{$copyright}", copyright)
htmlcontent = replace(htmlcontent, "{$indexname}", indexname)
htmlcontent = replace(htmlcontent, "{$version}", "")
htmlcontent = htmlcontent
end property
public property get byvalue()
byvalue = htmlcontent
end property
public property let htmlvalue(byval vnewvalue)
dim tempstr
tempstr = vnewvalue
tempstr = replace(tempstr, "{$style_css}", htmlcss)
tempstr = replace(tempstr, "{$skinpath}", skinpath)
tempstr = replace(tempstr, "{$width}", main_setting(0))
tempstr = replace(tempstr, "{$channelmenu}", channelmenu)
tempstr = replace(tempstr, "{$websitename}", sitename)
tempstr = replace(tempstr, "{$websiteurl}", siteurl)
tempstr = replace(tempstr, "{$mastermail}", mastermail)
tempstr = replace(tempstr, "{$keyword}", keywords)
tempstr = replace(tempstr, "{$copyright}", copyright)
tempstr = replace(tempstr, "{$indexname}", indexname)
tempstr = replace(tempstr, "{$version}", "")
shtmlcontent = tempstr
end property
public property get htmlvalue()
htmlvalue = shtmlcontent
end property
public property get htmlsetting(n)
htmlsetting = html_setting(n)
end property
public property get mainsetting(n)
mainsetting = main_setting(n)
end property
'================================================
'過程名：getsiteurl
'作 用：取得帶端口的url
'================================================
public property get getsiteurl()
if request.servervariables("server_port") = "80" then
getsiteurl = "http://" & request.servervariables("server_name")
else
getsiteurl = "http://" & request.servervariables("server_name") & ":" & request.servervariables("server_port")
end if
end property
'================================================
'函數名：formencode
'作 用：過慮提交的表單數據
'參 數：str ----原字符串 n ----字符長度
'================================================
public function formencode(byval str, byval n)
if not isnull(str) and trim(str) <> "" then
str = left(str, n)
str = replace(str, ">", ">")
str = replace(str, "<", "<")
str = replace(str, ">", ">")
str = replace(str, "<", "<")
str = replace(str, "'", "'")
str = replace(str, chr(34), """)
str = replace(str, "%", "％")
str = replace(str, vbnewline, "")
formencode = trim(str)
else
formencode = ""
end if
end function
'================================================
'函數名：chkkeyword
'作 用：過濾關鍵字
'參 數：keyword ----關鍵字
'================================================
public function chkkeyword(byval keyword)
dim fobwords, i
on error resume next
fobwords = array(91, 92, 304, 305, 430, 431, 437, 438, 12460, 12461, 12462, 12463, 12464, 12465, 12466, 12467, 12468, 12469, 12470, 12471, 12472, 12473, 12474, 12475, 12476, 12477, 12478, 12479, 12480, 12481, 12482, 12483, 12485, 12486, 12487, 12488, 12489, 12490, 12496, 12497, 12498, 12499, 12500, 12501, 12502, 12503, 12504, 12505, 12506, 12507, 12508, 12509, 12510, 12521, 12532, 12533, 65339, 65340)
for i = 1 to ubound(fobwords, 1)
if instr(keyword, chrw(fobwords(i))) > 0 then
keyword = replace(keyword, chrw(fobwords(i)), "")
end if
next
keyword = left(keyword, 100)
fobwords = array("~", "!", "@", "#", "$", "%", "^", "&", "*", "(", ")", "_", "+", "=", "`", "[", "]", "{", "}", ";", ":", """", "'", ",", "<", ">", ".", "/", "\", "?", "_")
for i = 0 to ubound(fobwords, 1)
if instr(keyword, fobwords(i)) > 0 then
keyword = replace(keyword, fobwords(i), "")
end if
next
chkkeyword = keyword
end function
'================================================
'函數名：japencode
'作 用：日文片假名編碼
'參 數：str ----原字符
'================================================
public function japencode(byval str)
dim fobwords, i
on error resume next
if isnull(str) or trim(str) = "" then
japencode = ""
exit function
end if
fobwords = array(92, 304, 305, 430, 431, 437, 438, 12460, 12461, 12462, 12463, 12464, 12465, 12466, 12467, 12468, 12469, 12470, 12471, 12472, 12473, 12474, 12475, 12476, 12477, 12478, 12479, 12480, 12481, 12482, 12483, 12485, 12486, 12487, 12488, 12489, 12490, 12496, 12497, 12498, 12499, 12500, 12501, 12502, 12503, 12504, 12505, 12506, 12507, 12508, 12509, 12510, 12521, 12532, 12533, 65340)
for i = 1 to ubound(fobwords, 1)
if instr(str, chrw(fobwords(i))) > 0 then
str = replace(str, chrw(fobwords(i)), "&#" & fobwords(i) & ";")
end if
next
japencode = str
end function
'================================================
'函數名：japuncode
'作 用：日文片假名解碼
'參 數：str ----原字符
'================================================
public function japuncode(byval str)
dim fobwords, i
on error resume next
if isnull(str) or trim(str) = "" then
japuncode = ""
exit function
end if
fobwords = array(92, 304, 305, 430, 431, 437, 438, 12460, 12461, 12462, 12463, 12464, 12465, 12466, 12467, 12468, 12469, 12470, 12471, 12472, 12473, 12474, 12475, 12476, 12477, 12478, 12479, 12480, 12481, 12482, 12483, 12485, 12486, 12487, 12488, 12489, 12490, 12496, 12497, 12498, 12499, 12500, 12501, 12502, 12503, 12504, 12505, 12506, 12507, 12508, 12509, 12510, 12521, 12532, 12533, 65340)
for i = 1 to ubound(fobwords, 1)
if instr(str, "&#" & fobwords(i) & ";") > 0 then
str = replace(str, "&#" & fobwords(i) & ";", chrw(fobwords(i)))
end if
next
str = replace(str, chr(0), "")
str = replace(str, "'", "''")
japuncode = str
end function
'=============================================================
'函數作用：帶臟話過濾
'=============================================================
public function chkbadwords(byval str)
if isnull(str) then exit function
dim i, bwords, bwordr
bwords = split(badwords, "|")
bwordr = split(badwordr, "|")
for i = 0 to ubound(bwords)
if i > ubound(bwordr) then
str = replace(str, bwords(i), "*")
else
str = replace(str, bwords(i), bwordr(i))
end if
next
chkbadwords = str
end function
'=============================================================
'函數作用：過濾html代碼，帶臟話過濾
'=============================================================
public function htmlencode(byval fstring)
if not isnull(fstring) then
fstring = replace(fstring, ">", ">")
fstring = replace(fstring, "<", "<")
fstring = replace(fstring, chr(32), " ")
fstring = replace(fstring, chr(9), " ")
fstring = replace(fstring, chr(34), """)
fstring = replace(fstring, chr(39), "'")
fstring = replace(fstring, chr(13), "")
fstring = replace(fstring, " ", " ")
fstring = replace(fstring, chr(10), "
")
fstring = chkbadwords(fstring)
htmlencode = fstring
end if
end function
'=============================================================
'函數作用：過濾html代碼，不帶臟話過濾
'=============================================================
public function htmlencodes(byval fstring)
if not isnull(fstring) then
fstring = replace(fstring, "'", "'")
fstring = replace(fstring, ">", ">")
fstring = replace(fstring, "<", "<")
fstring = replace(fstring, chr(32), " ")
fstring = replace(fstring, chr(9), " ")
fstring = replace(fstring, chr(34), """)
fstring = replace(fstring, chr(39), "'")
fstring = replace(fstring, chr(13), "")
fstring = replace(fstring, chr(10), "
")
fstring = replace(fstring, " ", " ")
htmlencodes = fstring
end if
end function
'=============================================================
'函數作用：判斷發言是否來自外部
'=============================================================
public function checkpost()
on error resume next
dim server_v1, server_v2
checkpost = 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
checkpost = true
end if
end function
'=============================================================
'函數作用：判斷來源url是否來自外部
'=============================================================
public function checkouterurl()
on error resume next
dim server_v1, server_v2
server_v1 = replace(lcase(trim(request.servervariables("http_referer"))), "http://", "")
server_v2 = lcase(trim(request.servervariables("server_name")))
if server_v1 <> "" and left(server_v1, len(server_v2)) <> server_v2 then
checkouterurl = false
else
checkouterurl = true
end if
end function
'================================================
'函數名：gottopic
'作 用：顯示字符串長度
'參 數：str ----原字符串
' strlen ----顯示字符長度
'================================================
public function gottopic(byval str, byval strlen)
dim l, t, c, i
dim strtemp
on error resume next
str = trim(str)
str = replace(str, " ", " ")
str = replace(str, ">", ">")
str = replace(str, "<", "<")
str = replace(str, ">", ">")
str = replace(str, "<", "<")
str = replace(str, "'", "'")
str = replace(str, """, chr(34))
str = replace(str, vbnewline, "")
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
strtemp = left(str, i) & "..."
exit for
else
strtemp = str & " "
end if
next
gottopic = checktopic(strtemp)
end function
public function checktopic(byval strcontent)
dim re
on error resume next
set re = new regexp
re.ignorecase = true
re.global = true
re.pattern = "($2")
re.pattern = "(\[flash=*([0-9]*),*([0-9]*)\])(.[^\[]*)(\[\/flash\])"
strcontent = re.replace(strcontent, "
ASP技巧