%@LANGUAGE="VBSCRIPT" CODEPAGE="65001"%>
<%option explicitdim objconn,conndim king_db:king_db="../db/kingcms#tianzll466037827.asp"objconn="Provider=Microsoft.Jet.OLEDB.4.0;Data Source="&server.mapPath(king_db)%>
<%
'----------------------------------------------------------
'***************** 风声无组件上传类 2.0B ****************
'作者:风声
'网站:http://www.17560.net http://www.54nb.com
'邮件:Rumor@17560.net
'版权:版权全体,源代码公开,各种用途均可免费使用
'**********************************************************
'此上传类代码 Sin.CS 已进行了适当的修改,不要自行覆盖升级.
'----------------------------------------------------------
Class UpLoadClass
Private p_MaxSize,p_TotalSize,p_FileType,p_SavePath,p_AutoSave,p_Error
Private objForm,binForm,binItem,strDate,lngTime
Public FormItem,FileItem
Public Property Get Version
Version="Rumor UpLoadClass Version 2.0B"
End Property
Public Property Get Error
Error=p_Error
End Property
Public Property Get MaxSize
MaxSize=p_MaxSize
End Property
Public Property Let MaxSize(lngSize)
if isNumeric(lngSize) then
p_MaxSize=clng(lngSize)
end if
End Property
Public Property Get TotalSize
TotalSize=p_TotalSize
End Property
Public Property Let TotalSize(lngSize)
if isNumeric(lngSize) then
p_TotalSize=clng(lngSize)
end if
End Property
Public Property Get FileType
FileType=p_FileType
End Property
Public Property Let FileType(strType)
p_FileType=strType
End Property
Public Property Get SavePath
SavePath=p_SavePath
End Property
Public Property Let SavePath(strPath)
p_SavePath=replace(strPath,chr(0),"")
End Property
Public Property Get AutoSave
AutoSave=p_AutoSave
End Property
Public Property Let AutoSave(byVal Flag)
select case Flag
case 0:
case 1:
case 2:
case false:Flag=2
case else:Flag=0
end select
p_AutoSave=Flag
End Property
Private Sub Class_Initialize
p_Error = -1
p_MaxSize = 10485760 '默认为10mb
p_FileType = "jpg/gif/jpeg/png/bmp"
p_SavePath = "../"&king_upath&"/"
p_AutoSave = 2
p_TotalSize= 0
strDate = replace(cstr(Date()),"-","")
lngTime = clng(timer()*1000)
Set binForm = Server.CreateObject(king_stm)
Set binItem = Server.CreateObject(king_stm)
Set objForm = Server.CreateObject("Scripting.Dictionary")
objForm.CompareMode = 1
End Sub
Private Sub Class_Terminate
objForm.RemoveAll
Set objForm = nothing
Set binItem = nothing
if p_Error<>4 then binForm.Close()
Set binForm = nothing
End Sub
Public Sub Open()
if p_Error=-1 then
p_Error=0
else
Exit Sub
end if
Dim lngRequestSize,binRequestData,strFormItem,strFileItem
Const strSplit="'"">"
lngRequestSize=Request.TotalBytes
if lngRequestSize<1 or (lngRequestSize>p_TotalSize and p_TotalSize<>0) then
p_Error=4
Exit Sub
end if
binRequestData=Request.BinaryRead(lngRequestSize)
binForm.Type = 1
binForm.Open
binForm.Write binRequestData
Dim bCrLf,strSeparator,intSeparator
bCrLf=ChrB(13)&ChrB(10)
intSeparator=InstrB(1,binRequestData,bCrLf)-1
strSeparator=LeftB(binRequestData,intSeparator)
Dim p_start,p_end,strItem,strInam,intTemp,strTemp
Dim strFtyp,strFnam,strFext,lngFsiz
p_start=intSeparator+2
Do
p_end =InStrB(p_start,binRequestData,bCrLf&bCrLf)+3
binItem.Type=1
binItem.Open
binForm.Position=p_start
binForm.CopyTo binItem,p_end-p_start
binItem.Position=0
binItem.Type=2
binItem.Charset="utf-8"
strItem=binItem.ReadText
binItem.Close()
p_start=p_end
p_end =InStrB(p_start,binRequestData,strSeparator)-1
binItem.Type=1
binItem.Open
binForm.Position=p_start
lngFsiz=p_end-p_start-2
binForm.CopyTo binItem,lngFsiz
intTemp=Instr(39,strItem,"""")
strInam=Mid(strItem,39,intTemp-39)
if Instr(intTemp,strItem,"filename=""")<>0 then
if not objForm.Exists(strInam&"_From") then
strFileItem=strFileItem&strSplit&strInam
if binItem.Size<>0 then
intTemp=intTemp+13
strFtyp=Mid(strItem,Instr(intTemp,strItem,"Content-Type: ")+14)
strTemp=Mid(strItem,intTemp,Instr(intTemp,strItem,"""")-intTemp)
intTemp=InstrRev(strTemp,"\")
strFnam=Mid(strTemp,intTemp+1)
objForm.Add strInam&"_Type",strFtyp
objForm.Add strInam&"_Name",strFnam
objForm.Add strInam&"_Path",Left(strTemp,intTemp)
objForm.Add strInam&"_Size",lngFsiz
if Instr(intTemp,strTemp,".")<>0 then
strFext=Mid(strTemp,InstrRev(strTemp,".")+1)
else
strFext=""
end if
if left(strFtyp,6)="image/" then
binItem.Position=0
binItem.Type=1
strTemp=binItem.read(10)
if strcomp(strTemp,chrb(255) & chrb(216) & chrb(255) & chrb(224) & chrb(0) & chrb(16) & chrb(74) & chrb(70) & chrb(73) & chrb(70),0)=0 then
if Lcase(strFext)<>"jpg" then strFext="jpg"
binItem.Position=3
do while not binItem.EOS
do
intTemp = ascb(binItem.Read(1))
loop while intTemp = 255 and not binItem.EOS
if intTemp < 192 or intTemp > 195 then
binItem.read(Bin2Val(binItem.Read(2))-2)
else
Exit do
end if
do
intTemp = ascb(binItem.Read(1))
loop while intTemp < 255 and not binItem.EOS
loop
binItem.Read(3)
objForm.Add strInam&"_Height",Bin2Val(binItem.Read(2))
objForm.Add strInam&"_Width",Bin2Val(binItem.Read(2))
elseif strcomp(leftB(strTemp,8),chrb(137) & chrb(80) & chrb(78) & chrb(71) & chrb(13) & chrb(10) & chrb(26) & chrb(10),0)=0 then
if Lcase(strFext)<>"png" then strFext="png"
binItem.Position=18
objForm.Add strInam&"_Width",Bin2Val(binItem.Read(2))
binItem.Read(2)
objForm.Add strInam&"_Height",Bin2Val(binItem.Read(2))
elseif strcomp(leftB(strTemp,6),chrb(71) & chrb(73) & chrb(70) & chrb(56) & chrb(57) & chrb(97),0)=0 or strcomp(leftB(strTemp,6),chrb(71) & chrb(73) & chrb(70) & chrb(56) & chrb(55) & chrb(97),0)=0 then
if Lcase(strFext)<>"gif" then strFext="gif"
binItem.Position=6
objForm.Add strInam&"_Width",BinVal2(binItem.Read(2))
objForm.Add strInam&"_Height",BinVal2(binItem.Read(2))
elseif strcomp(leftB(strTemp,2),chrb(66) & chrb(77),0)=0 then
if Lcase(strFext)<>"bmp" then strFext="bmp"
binItem.Position=18
objForm.Add strInam&"_Width",BinVal2(binItem.Read(4))
objForm.Add strInam&"_Height",BinVal2(binItem.Read(4))
end if
end if
objForm.Add strInam&"_Ext",strFext
objForm.Add strInam&"_From",p_start
intTemp=GetFerr(lngFsiz,strFext)
if p_AutoSave<>2 then
objForm.Add strInam&"_Err",intTemp
if intTemp=0 then
if p_AutoSave=0 then
strFnam=GetTimeStr()
if strFext<>"" then strFnam=strFnam&"."&strFext
end if
binItem.SaveToFile Server.MapPath(p_SavePath&strFnam),2
objForm.Add strInam,strFnam
end if
end if
else
objForm.Add strInam&"_Err",-1
end if
end if
else
binItem.Position=0
binItem.Type=2
binItem.Charset="utf-8"
strTemp=binItem.ReadText
if objForm.Exists(strInam) then
objForm(strInam) = objForm(strInam)&","&strTemp
else
strFormItem=strFormItem&strSplit&strInam
objForm.Add strInam,strTemp
end if
end if
binItem.Close()
p_start = p_end+intSeparator+2
loop Until p_start+3>lngRequestSize
FormItem=split(strFormItem,strSplit)
FileItem=split(strFileItem,strSplit)
End Sub
Private Function GetTimeStr()
lngTime=lngTime+1
GetTimeStr=strDate&lngTime
End Function
Private Function GetFerr(lngFsiz,strFext)
dim intFerr
intFerr=0
if lngFsiz>p_MaxSize and p_MaxSize>0 then
if p_Error=0 or p_Error=2 then p_Error=p_Error+1
intFerr=intFerr+1
end if
if Instr(1,LCase("/"&p_FileType&"/"),LCase("/"&strFext&"/"))=0 and p_FileType<>"" then
if p_Error<2 then p_Error=p_Error+2
intFerr=intFerr+2
end if
GetFerr=intFerr
End Function
Public Function Save(Item,strFnam)
Save=false
if objForm.Exists(Item&"_From") then
dim intFerr,strFext
strFext=objForm(Item&"_Ext")
intFerr=GetFerr(objForm(Item&"_Size"),strFext)
if objForm.Exists(Item&"_Err") then
if intFerr=0 then
objForm(Item&"_Err")=0
end if
else
objForm.Add Item&"_Err",intFerr
end if
if intFerr<>0 then Exit Function
if VarType(strFnam)=2 then
select case strFnam
case 0:strFnam=GetTimeStr()
if strFext<>"" then strFnam=strFnam&"."&strFext
case 1:strFnam=objForm(Item&"_Name")
end select
end if
binItem.Type = 1
binItem.Open
binForm.Position = objForm(Item&"_From")
binForm.CopyTo binItem,objForm(Item&"_Size")
binItem.SaveToFile Server.MapPath(p_SavePath&strFnam),2
binItem.Close()
if objForm.Exists(Item) then
objForm(Item)=strFnam
else
objForm.Add Item,strFnam
end if
Save=true
end if
End Function
Public Function GetData(Item)
GetData=""
if objForm.Exists(Item&"_From") then
if GetFerr(objForm(Item&"_Size"),objForm(Item&"_Ext"))<>0 then Exit Function
binForm.Position = objForm(Item&"_From")
GetData=binFormStream.Read(objForm(Item&"_Size"))
end if
End Function
Public Function Form(Item)
if objForm.Exists(Item) then
Form=objForm(Item)
else
Form=""
end if
End Function
Private Function BinVal2(bin)
dim lngValue,i
lngValue = 0
for i = lenb(bin) to 1 step -1
lngValue = lngValue *256 + ascb(midb(bin,i,1))
next
BinVal2=lngValue
End Function
Private Function Bin2Val(bin)
dim lngValue,i
lngValue = 0
for i = 1 to lenb(bin)
lngValue = lngValue *256 + ascb(midb(bin,i,1))
next
Bin2Val=lngValue
End Function
End Class
%>
<%
' Edit: Sin.CS
' Date: 2006-1-21
' Memo: (此文件为系统文件,若您是新手,不建议直接编辑)
' Memo: (编辑完后需要"加载"一次)
' Memo: (
' 金钱不会提高程序代码的质量, 只有技巧和时间才能够做到;
' KingCMS 作为共享程序发布, 并非为了赚取高额利润;
' 希望尊重别人的劳动成果,商用时别忘获得商业授权;
' 有意见问题请到 论坛 去反馈!
' 若 购买程序或支持本项目,请发邮件到: kingcms@gmail.com
' 衷心感谢您对我们 KingCMS 项目的关注!
' )
const king_key="KingCMS" '一个url下安装多个kingcms的时候,可以把这个参数设为不同的值.
const king_salt="8h10di39c3" '密码筛子参数, + + + 强烈建议修改这个值,建议不要超过10个字符 + + + 必须为[a-zA-Z0-9]的字符构成
'上传目录,不建议修改这个目录,若要修改,请同步修改Fckeditor编辑器中的上传路径。
const king_upath="up_files"
'非图像文件的上传目录,把图像上传路径和文件上传路径分开是为了防止直接找到文件的路径.
rem 1 如果你希望不被人盗连论坛或下载系统中上传了的文件,请修改下面的路径
rem 2 如果你的路径被暴露了,或你在稍晚些时候看见了这个功能,也可以修改下面路径,但必须需要手工修改原上传目录 up_files/down(原目录) 重命名为新的目录名
const king_dpath="down"
'0:异步生成 1:同步生成 (可能有的空间问题,无法生成html页面的时候,改成同步生成)
const king_async=0
'导航输出方式,1:输出htm代码,0:部分输出js代码
const king_out=0
'分页
'标签
const king_break="
"
'
const king_paging=1500'默认的分页字符串数量
'注册用户名长度设定
const king_user_min=2
const king_user_max=20'不能超过30
'系统默认语言
const king_lang="zh-cn"
'日期格式
const king_datestyle=0
'0: 2006-5-9
'1: 2006-05-09
'2: 06-05-09
'3: 20060509
'4: 060509
'每页显示数量参数 rn 的最大值
const king_maxrn=100
'在线人数时间设置
const king_onlinetime=20'分钟
'xml文档头信息
const king_xmlhead=""
'论坛统计图片的大小
const king_votewidth=300
const king_voteheight=11
'论坛远程截图,这个功能消耗你空间:(
const king_isbbsimgsnap=0'0 默认关闭,1 开启
'论坛中的图片自动缩放时候的大小
const king_maximgwidth=550 '宽度
'发帖时间限制
const power_time=15 '单位:秒
'论坛页面里的网址是否自动带连接
const king_ubblink=1 '1 自动解析 0 不解析
'货币设置,网站中使用的货币类型
const king_money="RMB"
'短信息提示显示时间设置,单位:秒
const king_msgtime=3
'在线时间Rank比值,默认为10,和腾讯原在线时间级别一致
const king_rank=10
'非展开状态下的栏目是否显示在菜单中,(0)显示,(1)不显示。
'当栏目数量超过100个的时候,可以选择不显示。
const king_ismenudir=0
'类似网页搜索连接,{king}为关键字,必须小写!
const king_link="http://www.google.com/search?hl=zh-CN&q={king}"
'采集的时候过滤的HTML标签,自己扩展吧.
const king_clstags="iframe,font,object,script,div,img,a,b,i,span,center,pre,form,input,table,tr,td,th"
'采集打开自动搜集url的时候的后缀,多个项目之间用垂直线分开;如果搜集动态页面,请留空
const king_collext="(.html|.htm|.shtml|.shtm|.aspx|.asp|.php4|.php)"
'const king_collext=""
'自动获取文章地址参数 0=中文转拼音+字母;1=字母,不转中文 2=随机数
const king_pathtype=0
const king_collsize=200'单位为MB,采集数据库的分库大小,要大于100MB,小于1000MB
'0:默认关闭水印 1:打开
const king_imgsy=1
'水印位置 0:中间 1:左上角 2:右上角 3:左下角 4:右下角
const king_imgsyweight=0
'水印不透明度
const king_imgsyalpha=0.3
'Google Sitemaps XML 文件的名称
const king_gxml="sitemaps" 'xml文件头
const king_grn=5000 '一个sitemaps文件里的url数量,max=50000 FileSize<10Mb
'广告文件夹目录
const king_ads="ads"
'aspjpeg开关(因考虑到某些空间验证码过期,但检测结果返回可用状态)
const king_jpeg=1'关掉 0, 1为打开
'采集的时候目标网站的默认编码,因为有的网站没有charset值,所以需要设置默认值
const king_collcode="gb2312"
'爬虫参数设置 爬虫之间用垂直线区分,不分大小写,@前面的是包含项目,后面的是爬虫名称
const king_robots= "Baiduspider+@Baidu|Googlebot@Google|ia_archiver@Alexa|IAArchiver@Alexa|ASPSeek@ASPSeek|YahooSeeker@Yahoo|sohu-search@Sohu|help.yahoo.com/help/us/ysearch/slurp@Yahoo|sohu-search@SOHU|MSN@MSN|sohu-search@SOHU|sohu-search@Sohu|Sqworm/2.9.81-BETA (beta_release; 20011102-760; i686-pc-linux-gnu)@AOL"
'rss显示数量设置
const king_rssnumber=20
'下载系统,多个项目之间用逗号分开,请自行定制自己喜欢的预选项
'语言设置
const king_languages="简体中文,繁体中文,English,Corea,多语言版"
'操作系统
const king_os="WIN9X/ME/XP/NT/2000/2003,LongHorn/Vista,Linux,Mac OS,UNIX,ASP,PHP,ASP.NET,CGI,JSP"
'积分设置
const mark_topic=3 '发新主题,为鼓励发布主题贴(主题贴多,论坛内容丰富),多加两分
const mark_board=1 '发回复
const mark_reboard=1 '被回复贴
const mark_del=-5 '被删除一个主题或跟贴
const mark_best=30 '加入精华
const mark_upfile=0 '发表附件
const mark_down=-5 '下载附件
const mark_msg=-1 '发短信息
const mark_delmsg=1 '删除一个短信息
const mark_search=-2 '搜索
const mark_login=5 '访问一次加分
const mark_sub=0 '积分低于0,则限制发帖
const mark_report1=5 '举报帖子,若被评为有效举报,就加积分。
const mark_report2=-3 '举报帖子,若被评为无效举报,就减积分。
'威望设置
const prestige_topic=0 '发新主题
const prestige_board=0 '发回复
const prestige_reboard=1 '被回复贴
const prestige_del=-5 '被删除一个主题或跟贴
const prestige_best=10 '加入精华
const prestige_upfile=0 '发表附件
const prestige_down=0 '下载附件
const prestige_msg=0 '发短信息
const prestige_delmsg=0 '删除一个短信息
const prestige_search=0 '搜索
const prestige_login=1 '访问一次加分
const prestige_sub=-10 '威望低于-10,则限制发帖,发短信息等..
const prestige_report1=3 '举报帖子,若被评为有效举报,就加威望。
const prestige_report2=-1 '举报帖子,若被评为无效举报,就减威望。
dim upload,ol,kingtitle,king_ehr,kingguide,tconn,tnow,king_chr,asp
king_chr="1,2,3,4,5,6,7,8,9,10,14,15,16,17,18,19,20,21,22,23,24,25,26,27,32,33,34,35,36,37,38,39,40,41,"
king_chr=king_chr&"42,43,44,45,46,47,58,59,60,61,62,63,64,91,92,93,94,95,96,123,123,124,125,126"
'请自行增加您可能用到的编码
const king_code="utf-8,unicode,big5,gb2312,ISO-8859-1,ks_c_5601-1987"
'这个就不解释了...
const king_fso="Scripting.FileSystemObject"
const king_stm="ADODB.Stream"
'Google Sitemaps版本信息
const king_gxmlhead=""
const king_gxmlvers="http://www.google.com/schemas/sitemap/0.84"
'其他全局变量
tnow=formatdate(now)
response.buffer=true
%>
<%
Private Const BITS_TO_A_BYTE = 8
Private Const BYTES_TO_A_WORD = 4
Private Const BITS_TO_A_WORD = 32
Private m_lOnBits(30)
Private m_l2Power(30)
Private Function LShift(lValue, iShiftBits)
If iShiftBits = 0 Then
LShift = lValue
Exit Function
ElseIf iShiftBits = 31 Then
If lValue And 1 Then
LShift = &H80000000
Else
LShift = 0
End If
Exit Function
ElseIf iShiftBits < 0 Or iShiftBits > 31 Then
Err.Raise 6
End If
If (lValue And m_l2Power(31 - iShiftBits)) Then
LShift = ((lValue And m_lOnBits(31 - (iShiftBits + 1))) * m_l2Power(iShiftBits)) Or &H80000000
Else
LShift = ((lValue And m_lOnBits(31 - iShiftBits)) * m_l2Power(iShiftBits))
End If
End Function
Private Function RShift(lValue, iShiftBits)
If iShiftBits = 0 Then
RShift = lValue
Exit Function
ElseIf iShiftBits = 31 Then
If lValue And &H80000000 Then
RShift = 1
Else
RShift = 0
End If
Exit Function
ElseIf iShiftBits < 0 Or iShiftBits > 31 Then
Err.Raise 6
End If
RShift = (lValue And &H7FFFFFFE) \ m_l2Power(iShiftBits)
If (lValue And &H80000000) Then
RShift = (RShift Or (&H40000000 \ m_l2Power(iShiftBits - 1)))
End If
End Function
Private Function RotateLeft(lValue, iShiftBits)
RotateLeft = LShift(lValue, iShiftBits) Or RShift(lValue, (32 - iShiftBits))
End Function
Private Function AddUnsigned(lX, lY)
Dim lX4
Dim lY4
Dim lX8
Dim lY8
Dim lResult
lX8 = lX And &H80000000
lY8 = lY And &H80000000
lX4 = lX And &H40000000
lY4 = lY And &H40000000
lResult = (lX And &H3FFFFFFF) + (lY And &H3FFFFFFF)
If lX4 And lY4 Then
lResult = lResult Xor &H80000000 Xor lX8 Xor lY8
ElseIf lX4 Or lY4 Then
If lResult And &H40000000 Then
lResult = lResult Xor &HC0000000 Xor lX8 Xor lY8
Else
lResult = lResult Xor &H40000000 Xor lX8 Xor lY8
End If
Else
lResult = lResult Xor lX8 Xor lY8
End If
AddUnsigned = lResult
End Function
Private Function md5_F(x, y, z)
md5_F = (x And y) Or ((Not x) And z)
End Function
Private Function md5_G(x, y, z)
md5_G = (x And z) Or (y And (Not z))
End Function
Private Function md5_H(x, y, z)
md5_H = (x Xor y Xor z)
End Function
Private Function md5_I(x, y, z)
md5_I = (y Xor (x Or (Not z)))
End Function
Private Sub md5_FF(a, b, c, d, x, s, ac)
a = AddUnsigned(a, AddUnsigned(AddUnsigned(md5_F(b, c, d), x), ac))
a = RotateLeft(a, s)
a = AddUnsigned(a, b)
End Sub
Private Sub md5_GG(a, b, c, d, x, s, ac)
a = AddUnsigned(a, AddUnsigned(AddUnsigned(md5_G(b, c, d), x), ac))
a = RotateLeft(a, s)
a = AddUnsigned(a, b)
End Sub
Private Sub md5_HH(a, b, c, d, x, s, ac)
a = AddUnsigned(a, AddUnsigned(AddUnsigned(md5_H(b, c, d), x), ac))
a = RotateLeft(a, s)
a = AddUnsigned(a, b)
End Sub
Private Sub md5_II(a, b, c, d, x, s, ac)
a = AddUnsigned(a, AddUnsigned(AddUnsigned(md5_I(b, c, d), x), ac))
a = RotateLeft(a, s)
a = AddUnsigned(a, b)
End Sub
Private Function ConvertToWordArray(sMessage)
Dim lMessageLength
Dim lNumberOfWords
Dim lWordArray()
Dim lBytePosition
Dim lByteCount
Dim lWordCount
Const MODULUS_BITS = 512
Const CONGRUENT_BITS = 448
lMessageLength = Len(sMessage)
lNumberOfWords = (((lMessageLength + ((MODULUS_BITS - CONGRUENT_BITS) \ BITS_TO_A_BYTE)) \ (MODULUS_BITS \ BITS_TO_A_BYTE)) + 1) * (MODULUS_BITS \ BITS_TO_A_WORD)
ReDim lWordArray(lNumberOfWords - 1)
lBytePosition = 0
lByteCount = 0
Do Until lByteCount >= lMessageLength
lWordCount = lByteCount \ BYTES_TO_A_WORD
lBytePosition = (lByteCount Mod BYTES_TO_A_WORD) * BITS_TO_A_BYTE
lWordArray(lWordCount) = lWordArray(lWordCount) Or LShift(Asc(Mid(sMessage, lByteCount + 1, 1)), lBytePosition)
lByteCount = lByteCount + 1
Loop
lWordCount = lByteCount \ BYTES_TO_A_WORD
lBytePosition = (lByteCount Mod BYTES_TO_A_WORD) * BITS_TO_A_BYTE
lWordArray(lWordCount) = lWordArray(lWordCount) Or LShift(&H80, lBytePosition)
lWordArray(lNumberOfWords - 2) = LShift(lMessageLength, 3)
lWordArray(lNumberOfWords - 1) = RShift(lMessageLength, 29)
ConvertToWordArray = lWordArray
End Function
Private Function WordToHex(lValue)
Dim lByte
Dim lCount
For lCount = 0 To 3
lByte = RShift(lValue, lCount * BITS_TO_A_BYTE) And m_lOnBits(BITS_TO_A_BYTE - 1)
WordToHex = WordToHex & Right("0" & Hex(lByte), 2)
Next
End Function
Public Function MD5(sMessage,stype)
m_lOnBits(0) = CLng(1)
m_lOnBits(1) = CLng(3)
m_lOnBits(2) = CLng(7)
m_lOnBits(3) = CLng(15)
m_lOnBits(4) = CLng(31)
m_lOnBits(5) = CLng(63)
m_lOnBits(6) = CLng(127)
m_lOnBits(7) = CLng(255)
m_lOnBits(8) = CLng(511)
m_lOnBits(9) = CLng(1023)
m_lOnBits(10) = CLng(2047)
m_lOnBits(11) = CLng(4095)
m_lOnBits(12) = CLng(8191)
m_lOnBits(13) = CLng(16383)
m_lOnBits(14) = CLng(32767)
m_lOnBits(15) = CLng(65535)
m_lOnBits(16) = CLng(131071)
m_lOnBits(17) = CLng(262143)
m_lOnBits(18) = CLng(524287)
m_lOnBits(19) = CLng(1048575)
m_lOnBits(20) = CLng(2097151)
m_lOnBits(21) = CLng(4194303)
m_lOnBits(22) = CLng(8388607)
m_lOnBits(23) = CLng(16777215)
m_lOnBits(24) = CLng(33554431)
m_lOnBits(25) = CLng(67108863)
m_lOnBits(26) = CLng(134217727)
m_lOnBits(27) = CLng(268435455)
m_lOnBits(28) = CLng(536870911)
m_lOnBits(29) = CLng(1073741823)
m_lOnBits(30) = CLng(2147483647)
m_l2Power(0) = CLng(1)
m_l2Power(1) = CLng(2)
m_l2Power(2) = CLng(4)
m_l2Power(3) = CLng(8)
m_l2Power(4) = CLng(16)
m_l2Power(5) = CLng(32)
m_l2Power(6) = CLng(64)
m_l2Power(7) = CLng(128)
m_l2Power(8) = CLng(256)
m_l2Power(9) = CLng(512)
m_l2Power(10) = CLng(1024)
m_l2Power(11) = CLng(2048)
m_l2Power(12) = CLng(4096)
m_l2Power(13) = CLng(8192)
m_l2Power(14) = CLng(16384)
m_l2Power(15) = CLng(32768)
m_l2Power(16) = CLng(65536)
m_l2Power(17) = CLng(131072)
m_l2Power(18) = CLng(262144)
m_l2Power(19) = CLng(524288)
m_l2Power(20) = CLng(1048576)
m_l2Power(21) = CLng(2097152)
m_l2Power(22) = CLng(4194304)
m_l2Power(23) = CLng(8388608)
m_l2Power(24) = CLng(16777216)
m_l2Power(25) = CLng(33554432)
m_l2Power(26) = CLng(67108864)
m_l2Power(27) = CLng(134217728)
m_l2Power(28) = CLng(268435456)
m_l2Power(29) = CLng(536870912)
m_l2Power(30) = CLng(1073741824)
Dim x
Dim k
Dim AA
Dim BB
Dim CC
Dim DD
Dim a
Dim b
Dim c
Dim d
Const S11 = 7
Const S12 = 12
Const S13 = 17
Const S14 = 22
Const S21 = 5
Const S22 = 9
Const S23 = 14
Const S24 = 20
Const S31 = 4
Const S32 = 11
Const S33 = 16
Const S34 = 23
Const S41 = 6
Const S42 = 10
Const S43 = 15
Const S44 = 21
x = ConvertToWordArray(sMessage)
a = &H67452301
b = &HEFCDAB89
c = &H98BADCFE
d = &H10325476
For k = 0 To UBound(x) Step 16
AA = a
BB = b
CC = c
DD = d
md5_FF a, b, c, d, x(k + 0), S11, &HD76AA478
md5_FF d, a, b, c, x(k + 1), S12, &HE8C7B756
md5_FF c, d, a, b, x(k + 2), S13, &H242070DB
md5_FF b, c, d, a, x(k + 3), S14, &HC1BDCEEE
md5_FF a, b, c, d, x(k + 4), S11, &HF57C0FAF
md5_FF d, a, b, c, x(k + 5), S12, &H4787C62A
md5_FF c, d, a, b, x(k + 6), S13, &HA8304613
md5_FF b, c, d, a, x(k + 7), S14, &HFD469501
md5_FF a, b, c, d, x(k + 8), S11, &H698098D8
md5_FF d, a, b, c, x(k + 9), S12, &H8B44F7AF
md5_FF c, d, a, b, x(k + 10), S13, &HFFFF5BB1
md5_FF b, c, d, a, x(k + 11), S14, &H895CD7BE
md5_FF a, b, c, d, x(k + 12), S11, &H6B901122
md5_FF d, a, b, c, x(k + 13), S12, &HFD987193
md5_FF c, d, a, b, x(k + 14), S13, &HA679438E
md5_FF b, c, d, a, x(k + 15), S14, &H49B40821
md5_GG a, b, c, d, x(k + 1), S21, &HF61E2562
md5_GG d, a, b, c, x(k + 6), S22, &HC040B340
md5_GG c, d, a, b, x(k + 11), S23, &H265E5A51
md5_GG b, c, d, a, x(k + 0), S24, &HE9B6C7AA
md5_GG a, b, c, d, x(k + 5), S21, &HD62F105D
md5_GG d, a, b, c, x(k + 10), S22, &H2441453
md5_GG c, d, a, b, x(k + 15), S23, &HD8A1E681
md5_GG b, c, d, a, x(k + 4), S24, &HE7D3FBC8
md5_GG a, b, c, d, x(k + 9), S21, &H21E1CDE6
md5_GG d, a, b, c, x(k + 14), S22, &HC33707D6
md5_GG c, d, a, b, x(k + 3), S23, &HF4D50D87
md5_GG b, c, d, a, x(k + 8), S24, &H455A14ED
md5_GG a, b, c, d, x(k + 13), S21, &HA9E3E905
md5_GG d, a, b, c, x(k + 2), S22, &HFCEFA3F8
md5_GG c, d, a, b, x(k + 7), S23, &H676F02D9
md5_GG b, c, d, a, x(k + 12), S24, &H8D2A4C8A
md5_HH a, b, c, d, x(k + 5), S31, &HFFFA3942
md5_HH d, a, b, c, x(k + 8), S32, &H8771F681
md5_HH c, d, a, b, x(k + 11), S33, &H6D9D6122
md5_HH b, c, d, a, x(k + 14), S34, &HFDE5380C
md5_HH a, b, c, d, x(k + 1), S31, &HA4BEEA44
md5_HH d, a, b, c, x(k + 4), S32, &H4BDECFA9
md5_HH c, d, a, b, x(k + 7), S33, &HF6BB4B60
md5_HH b, c, d, a, x(k + 10), S34, &HBEBFBC70
md5_HH a, b, c, d, x(k + 13), S31, &H289B7EC6
md5_HH d, a, b, c, x(k + 0), S32, &HEAA127FA
md5_HH c, d, a, b, x(k + 3), S33, &HD4EF3085
md5_HH b, c, d, a, x(k + 6), S34, &H4881D05
md5_HH a, b, c, d, x(k + 9), S31, &HD9D4D039
md5_HH d, a, b, c, x(k + 12), S32, &HE6DB99E5
md5_HH c, d, a, b, x(k + 15), S33, &H1FA27CF8
md5_HH b, c, d, a, x(k + 2), S34, &HC4AC5665
md5_II a, b, c, d, x(k + 0), S41, &HF4292244
md5_II d, a, b, c, x(k + 7), S42, &H432AFF97
md5_II c, d, a, b, x(k + 14), S43, &HAB9423A7
md5_II b, c, d, a, x(k + 5), S44, &HFC93A039
md5_II a, b, c, d, x(k + 12), S41, &H655B59C3
md5_II d, a, b, c, x(k + 3), S42, &H8F0CCC92
md5_II c, d, a, b, x(k + 10), S43, &HFFEFF47D
md5_II b, c, d, a, x(k + 1), S44, &H85845DD1
md5_II a, b, c, d, x(k + 8), S41, &H6FA87E4F
md5_II d, a, b, c, x(k + 15), S42, &HFE2CE6E0
md5_II c, d, a, b, x(k + 6), S43, &HA3014314
md5_II b, c, d, a, x(k + 13), S44, &H4E0811A1
md5_II a, b, c, d, x(k + 4), S41, &HF7537E82
md5_II d, a, b, c, x(k + 11), S42, &HBD3AF235
md5_II c, d, a, b, x(k + 2), S43, &H2AD7D2BB
md5_II b, c, d, a, x(k + 9), S44, &HEB86D391
a = AddUnsigned(a, AA)
b = AddUnsigned(b, BB)
c = AddUnsigned(c, CC)
d = AddUnsigned(d, DD)
Next
if stype=0 then
MD5 = LCase(WordToHex(b) & WordToHex(c))
else
MD5 = LCase(WordToHex(a) & WordToHex(b) & WordToHex(c) & WordToHex(d)) '32byte
end if
End Function
%>
<%
'create *** *** www.KingCMS.com *** ***
sub king_creates(l1)
dim l2,l3,l4,I1,i
l4=l1&"&"
l2=l11(l4,"cmd=","&")
l3=l11(l4,"sub2=","&"):if II11(l3,6) then king_sub2_page l3,0
l3=l11(l4,"sub3=","&"):if II11(l3,6) then king_sub3_page l3,0
l3=l11(l4,"sub10=","&"):if II11(l3,6) then king_sub10_page l3,0
l3=l11(l4,"ad=","&"):if II11(l3,6) then king_ad l3
l3=l11(l4,"menuid=","&")
'这个menuid值是一个数组,需要分开.
if II11(l3,6) then
I1=split(l3,",")
for i=0 to ubound(I1)
if len(I1(i))>0 then
if ll11(l2,"page") then
king_menus I1(i),1
else
king_menus I1(i),0
end if
end if
next
end if
l3=l11(l4,"coll=","&"):if len(l3)>0 then king_collarticle
if ll11(l2,"all") then king_menus 0,1 '全站生成
if ll11(l2,"alllist") then king_menus 0,0 '全列表生成
if ll11(l2,"one") then king_sub1
if ll11(l2,"menu") then king_jsmenu
if ll11(l2,"map") then king_map 'sitemap
if ll11(l2,"bbs") then king_bbs
end sub
'rss *** *** www.KingCMS.com *** ***
sub king_rss(l1)
dim rs,data,i,sql
dim classid,menuid,menuname,menupath,menulanguage,bbstype,invalue
set rs=conn.execute("select classid,menuname,menupath,menulanguage,bbstype from kingmenu where menuid="&l1&";")
if not rs.eof and not rs.bof then
classid=rs(0)
menuname=htmlencode(rs(1))
menupath=rs(2)
menulanguage=rs(3)
bbstype=rs(4)
end if
rs.close
set rs=nothing
invalue=""
invalue=invalue&""
invalue=invalue&""
invalue=invalue&""&xmlencode(menuname&" - "&king.sitename)&""
invalue=invalue&""&xmlencode(king.siteurl)&""
invalue=invalue&""&menulanguage&""
invalue=invalue&""&xmlencode(king.thisurl&king.inst&"sitemaps/index"&king.ext)&""
invalue=invalue&""&xmlencode(king.thisurl)&""
invalue=invalue&"5"
'title
'link
'description
'category
'author
'pubdate
select case cstr(classid)
case"2"
sql=" artid,arttitle,artdescription,artfrom,artauthor,artdate,sysdate,artpath,artgrade"'8
set rs=conn.execute("select top "&king_rssnumber&sql&" from kingart where menuid="&l1&" and artshow=1 order by artorder desc;")
if not rs.eof and not rs.bof then
data=rs.getrows()
for i=0 to ubound(data,2)
invalue=invalue&""
invalue=invalue&""&xmlencode(data(1,i))&""
if cstr(data(8,i))="0" then'静态输出
if cstr(king.named)="1" then'日期
invalue=invalue&""&xmlencode(king.thisurl&king.inst&menupath&"/"&III11(data(6,i))&"/"&data(7,i))&king.ext&""
else
invalue=invalue&""&xmlencode(king.thisurl&king.inst&menupath&"/"&data(7,i))&king.ext&""
end if
else
invalue=invalue&""&xmlencode(king.thisurl&king.inst&king.path&"/article.asp?/"&data(0,i))&king.ext&""
end if
invalue=invalue&""
invalue=invalue&""&xmlencode(data(3,i))&""
invalue=invalue&""&xmlencode(data(4,i))&""
invalue=invalue&""&formatdate(data(5,i))&""
invalue=invalue&""
next
else
invalue=invalue&""
invalue=invalue&""&xmlencode(king.lang("common/none"))&""
invalue=invalue&""&xmlencode(king.thisurl)&""
invalue=invalue&""
invalue=invalue&""
end if
rs.close
set rs=nothing
case"10"
sql=" topicid,bbstitle,bbscontent,username,bbsdate,sysdate,isface,isubb"
set rs=conn.execute("select top "&king_rssnumber&sql&" from kingtopic where menuid="&l1&";")
if not rs.eof and not rs.bof then
data=rs.getrows()
for i=0 to ubound(data,2)
invalue=invalue&""
invalue=invalue&""&xmlencode(data(1,i))&""
if ll11("0,1",bbstype) then'静态输出
invalue=invalue&""&xmlencode(king.thisurl&king.inst&menupath&"/"&III11(data(5,i))&"/"&data(0,i))&king.ext&""
else
invalue=invalue&""&xmlencode(king.thisurl&king.inst&king.path&"/topic.asp?/"&data(0,i))&king.ext&""
end if
invalue=invalue&""
invalue=invalue&""&xmlencode(king.bbsname)&""
invalue=invalue&""&xmlencode(data(3,i))&""
invalue=invalue&""&formatdate(data(4,i))&""
invalue=invalue&""
next
else
invalue=invalue&""
invalue=invalue&""&xmlencode(king.lang("common/none"))&""
invalue=invalue&""&xmlencode(king.thisurl)&""
invalue=invalue&""
invalue=invalue&""
end if
rs.close
set rs=nothing
end select
invalue=invalue&""
'out invalue
Ill "../"&menupath
I11 "../"&menupath&"/rss.xml",invalue
end sub
'menu *** *** www.KingCMS.com *** ***
sub king_menus(l1,l2)'调用栏目生成
'l1:栏目id,0代表全部
'l2:参数 0代表只生成列表,1代表page页面也一并生成
dim i,rs,sql,data
'其他被调用的函数
king_sub1
if cstr(l1)="0" then
king_load
king_jsmenu
king_map
king_bbs
end if
' menuid=l1ll("menuid",0)
if cstr(l1)="0" then
sql=""
else
if II11(l1,6) then
sql=" where menuid in ("&l1&")"
else
exit sub
end if
end if
set rs=conn.execute("select menuid,classid from kingmenu "&sql&";")
if not rs.eof and not rs.bof then
data=rs.getrows()
else
redim data(0,-1)
end if
set rs=nothing
'单页面不需要单独生成,不管什么操作,每次都要生成的.
'king_subX_page 0,menuid 当l1=0时,生成menuid指定的全部栏目内容
for i=0 to ubound(data,2)
if cstr(data(0,i))<>"0" then
select case cstr(data(1,i))
case"1"
case"2"
if cstr(l2)="1" or cstr(l1)="0" then king_sub2_page 0,data(0,i)
king_sub2_list data(0,i)
king_rss data(0,i)
case"3"
if cstr(l2)="1" or cstr(l1)="0" then king_sub3_page 0,data(0,i)
king_sub3_list data(0,i)
case"4"
king_sub4_list data(0,i)
case"10"
if cstr(l2)="1" or cstr(l1)="0" then king_sub10_page 0,data(0,i)
king_sub10_list data(0,i)
if king.ispath then'仅在后台的时候生成
king_sitemaps data(0,i)
end if
king_rss data(0,i)
end select
end if
next
end sub
'load *** *** www.KingCMS.com *** ***
sub king_load()
dim rs,data,sql,datamenu,i,tmphtm,tmphtmlist
'删除文件夹
IIl "../"&king.path&"/inc"
IIl "../"&king.path&"/image"
IIl "../"&king.path&"/templates"
IIl "../"&king.path&"/images"
'创建文件夹
Ill "../"&king.path&"/inc"
Ill "../"&king.path&"/image"
Ill "../"&king.path&"/templates"
Ill "../"&king_upath&"/image/not"
king.copyfolder "page","../"&king.path
king.copyfolder "inc","../"&king.path&"/inc"
king.copyfolder "language","../"&king.path&"/language"
' king.copyfolder "inside","../"&king.path&"/inside"
' king.copyfile "image/code.gif","../"&king.path&"/image/code.gif"
king.copyfile "image/logo.gif","../"&king.path&"/logo.gif"
king.copyfile "image/drawimage.gif","../"&king.path&"/image/drawimage.gif"
king.copyfile "image/notpic.gif","../"&king_upath&"/image/not/notpic.gif"
king.copyfile "image/nolink.gif","../"&king_upath&"/image/not/nolink.gif"
IIl "../"&king.path&"/images"'删除图像文件夹,并复制图像文件夹
IIl "../"&king.path&"/inside/image"
king.copyfolder "templates/"&king.template&"/images","../"&king.path&"/images"
king.copyfolder "templates/"&king.template,"../"&king.path&"/templates/"&king.template
king.copyfile "create.asp","../"&king.path&"/create.asp"
'拷贝bbs样式文件
'删除多余的文件
II1 "../"&king.path&"/inc/style.css"
II1 "../"&king.path&"/inc/fun.js"
sql="themeface,themelevel,themeubb,themeicon,themetype,themeinfo,themetopic,templatesearch,templatereg,templatepost,templatelogin"'10
sql=sql&",templateuser,templatecomment,themerank,themeforum,templatelink"'15
set rs=conn.execute("select "&sql&" from kingsystem where systemname='KingCMS';")
if not rs.eof and not rs.bof then
data=rs.getrows()
end if
rs.close
set rs=nothing
'生成动态文件
king_file data(7,0),"search.asp","search"
king_file data(15,0),"addlink.asp","addlink"
if lllll("user.asp") then'如果有用户系统
king_file data(8,0),"reg.asp","reg" 'reg.asp
king_file data(10,0),"login.asp","login"'login.asp
king_file data(11,0),"user.asp","user"'user.asp
king_file data(12,0),"comment.asp","comment"'comment.asp
if lllll("sub10.asp") then'有论坛
king.copyfolder "image/face/"&data(0,0),"../"&king.path&"/image/face"
king.copyfolder "image/emot/"&data(0,0),"../"&king.path&"/image/emot"
king.copyfolder "image/level/"&data(1,0),"../"&king.path&"/image/level"
king.copyfolder "image/ubb/"&data(2,0),"../"&king.path&"/image/ubb"
king.copyfolder "image/icon/"&data(3,0),"../"&king.path&"/image/icon"
king.copyfolder "image/type/"&data(4,0),"../"&king.path&"/image/type"
king.copyfolder "image/info/"&data(5,0),"../"&king.path&"/image/info"
king.copyfolder "image/topic/"&data(6,0),"../"&king.path&"/image/topic"
king.copyfolder "image/rank/"&data(13,0),"../"&king.path&"/image/rank"
king.copyfolder "image/forum/"&data(14,0),"../"&king.path&"/image/forum"
king_file data(9,0),"post.asp","post"'post.asp
end if
else
II1 "../"&king.path&"/reg.asp"
II1 "../"&king.path&"/login.asp"
II1 "../"&king.path&"/user.asp"
end if
set rs=conn.execute("select classid,menuid,menutemplate,menutemplatelist,menutemplate1,menutemplate2 from kingmenu;")'5
if not rs.eof and not rs.bof then
datamenu=rs.getrows()
for i=0 to ubound(datamenu,2)
select case cstr(datamenu(0,i))
case"2"
tmphtm=king.read(datamenu(4,i),"article[page]/"&datamenu(5,i))
conn.execute "update kingmenu set menutmp='"&lll1(tmphtm)&"' where menuid="&datamenu(1,i)&";"
' case"3"
' tmphtm=king.read(datamenu(4,i),"job[page]/"&datamenu(5,i))
' tmphtmlist=king.read(datamenu(2,i),"job[list]/"&data(3,i))
' conn.execute "update kingmenu set menutmp='"&lll1(tmphtm)&"',menutmplist='"&lll1(tmphtmlist)&"' where menuid="&datamenu(1,i)&";"
case"10"
tmphtm=king.read(datamenu(4,i),"bbs[page]/"&datamenu(5,i))
tmphtmlist=king.read(datamenu(2,i),"bbs[list]/"&datamenu(3,i))
conn.execute "update kingmenu set menutmp='"&lll1(tmphtm)&"',menutmplist='"&lll1(tmphtmlist)&"' where menuid="&datamenu(1,i)&";"
end select
next
end if
set rs=nothing
end sub
'file *** *** www.KingCMS.com *** ***
sub king_file(l1,l3,l4)
'l1: 目标模板名称
'l3: 对应文件名 search.asp
'l4: 要替换的标签
'读取指定的模板
dim tmphtm,invalue,file_asp,outhtm
tmphtm=king.read(l1,"")
invalue="title:"&I11II("<%=kingtitle%"&">")
invalue=invalue&"|keyword:"&I11II("<%=kingtitle%"&">")
invalue=invalue&"|description:"&I11II("<%=kingtitle%"&">")
invalue=invalue&"|guide:"&I11II("<%=kingguide%"&">")
invalue=invalue&"|inside:"&I11II("<%=ol%"&">")
file_asp=l1l1("page/"&l3)
outhtm=tmphtm
outhtm=llllI(outhtm,"","\{king:(topmenu|menutop) {0,}?\/\}")
outhtm=llllI(outhtm,"","(\{king:)(menu|centermenu) {0,}?\/\}")
outhtm=llllI(outhtm,"","(\{king:)(bottommenu|menubot|botmenu) {0,}?\/\}")
outhtm=king.create(outhtm,invalue,0)
outhtm=llllI(file_asp,outhtm,"\{king:"&l4&" {0,}?\/\}")
I11 "../"&king.path&"/"&l3,outhtm'创建文件
end sub
'jsmenu *** *** www.KingCMS.com *** ***
sub king_jsmenu()
dim rs,data,i,topmenu,botmenu,centermenu
set rs=conn.execute("select distinct menulanguage from kingmenu")
if not rs.eof and not rs.bof then
data=rs.getrows()
for i=0 to ubound(data,2)
topmenu=king.ll1l("top",data(0,i))
botmenu=king.ll1l("bot",data(0,i))
centermenu=king.ll1l("center",data(0,i))
Ill "../"&king.path&"/menu"
I11 "../"&king.path&"/menu/topmenu_"&data(0,i)&".js",lllIl(topmenu)
I11 "../"&king.path&"/menu/bottommenu_"&data(0,i)&".js",lllIl(botmenu)
I11 "../"&king.path&"/menu/menu_"&data(0,i)&".js",lllIl(centermenu)
next
end if
rs.close
set rs=nothing
end sub
'map *** *** www.KingCMS.com *** ***
sub king_map()
'创建htm导航
dim outhtm,insidehtm,tmphtm,invalue
dim rs,data,outxml,i,j,menucount,j_end
insidehtm="
"&king__menu(0,0)&"
"
tmphtm=king.read("default","")
invalue="title:"&I11II(king.lang("menu/rove/sitemaps"))
invalue=invalue&"|keyword:"&I11II(king.lang("menu/rove/sitemaps"))
invalue=invalue&"|description:"&I11II(king.lang("menu/rove/sitemaps"))
invalue=invalue&"|guide:"&I11II(""&king.lang("common/home")&" >> "&king.lang("menu/rove/sitemaps"))
invalue=invalue&"|inside:"&I11II(insidehtm)
outhtm=king.create(tmphtm,invalue,0)'替换charset值
Ill "../sitemaps"
I11 "../sitemaps/index"&king.ext,outhtm
'创建googleSitemaps索引
set rs=conn.execute("select menuid,classid from kingmenu where not classid in (0,1);")'1
if not rs.eof and not rs.bof then
data=rs.getrows()
else
exit sub
end if
rs.close
set rs=nothing
outxml=king_xmlhead&""
outxml=outxml&""&xmlencode(king.thisurl&king.inst&king_gxml&"_onepage.xml")&""
for i=0 to ubound(data,2)
select case cstr(data(1,i))
case"2" menucount=conn.execute("select count(artid) from kingart where menuid="&data(0,i)&" and artshow=1;")(0)
case"3" menucount=conn.execute("select count(jobid) from kingjob where menuid="&data(0,i)&" and jobshow=1;")(0)
case"10" menucount=conn.execute("select count(topicid) from kingtopic where menuid="&data(0,i)&" and topicdel=0;")(0)
end select
if len(menucount)>0 then
else
menucount=0
end if
j_end=menucount/king_grn
if j_end>int(j_end) then j_end=int(j_end)+1
for j=1 to j_end
outxml=outxml&""
outxml=outxml&""&xmlencode(king.thisurl&king.inst&king_gxml&"_"&data(0,i)&"_"&j&".xml")&""
outxml=outxml&""
next
next
outxml=outxml&""
I11 "../"&king_gxml&".xml",outxml
end sub
' out menucount
'menu *** *** www.KingCMS.com *** ***
function king__menu(l1,l2)'站点地图的附属
dim data,sql,l4,l6,l8,rs,i
sql="classid,menupath,menuname,menuid,bbstype"
set rs=conn.execute("select "&sql&" from kingmenu where menuid1="&l1&" and menuisopen=0 order by menuorder asc,menuid")
if not rs.eof and not rs.bof then
data=rs.getrows()
else
exit function
end if
rs.close
set rs=nothing
l4="
"
for i=0 to ubound(data,2)
select case cstr(data(0,i))
case"0"
l6=data(1,i)'浏览
case"1"
l6=king.inst&data(1,i)
case"10"
if ll11("0,1",cstr(data(4,i))) then
l6=king.inst&data(1,i)&"/index"&king.ext
else
l6=king.inst&king.path&"/topiclist.asp?/"&data(3,i)&king.ext
end if
case else
l6=king.inst&data(1,i)&"/index"&king.ext
end select
if cstr(l1)="0" then
l4=l4&"
"
end if
l8=conn.execute("select count(menuid) from kingmenu where menuid1="&data(3,i))(0)
if l8>=1 then l4=l4&king__menu(data(3,i),l2+1)
next
king__menu=l4&"
"
end function
'sitemaps *** *** www.KingCMS.com *** ***
sub king_sitemaps(l1)
dim mapxml,strloc,item,loc,thispid,tcount,locs
dim rs,i,data,classid,insql,menupath,bbstype
if cstr(l1)="0" then'当l1为0的时候,更新单页面
classid=1
else
set rs=conn.execute("select classid,menupath,bbstype from kingmenu where menuid="&l1&";")
if not rs.eof and not rs.bof then
classid=rs(0)
menupath=rs(1)
bbstype=rs(2)
else
exit sub
end if
rs.close
set rs=nothing
end if
set mapxml=createobject("microsoft.xmldom")
mapxml.async=false
mapxml.loadxml(king_xmlhead&king_gxmlhead)
select case cstr(classid)
case"1"
if lllll("sub10.asp") then'开通论坛的情况下更新论坛首页
strloc=xmlencode(king.thisurl&king.inst&king.bbspath)
set item=mapxml.createelement("url")
mapxml.documentElement.selectsinglenode("//urlset").appendChild item
set loc=mapxml.createelement("loc")
loc.text=strloc
item.appendChild loc
set loc=nothing
set item=nothing
end if
locs=array("sitemaps/index"&king.ext)'站点地图等系统自动输出的页面
for i=0 to ubound(locs)
strloc=xmlencode(king.thisurl&king.inst&locs(i))
set item=mapxml.createelement("url")
mapxml.documentElement.selectsinglenode("//urlset").appendChild item
set loc=mapxml.createelement("loc")
loc.text=strloc
item.appendChild loc
set loc=nothing
set item=nothing
next
set rs=conn.execute("select menupath from kingmenu where classid=1;")'单页面
if not rs.eof and not rs.bof then
data=rs.getrows()
else
exit sub
end if
rs.close
set rs=nothing
for i=0 to ubound(data,2)
strloc=xmlencode(king.thisurl&king.inst&data(0,i))
set item=mapxml.createelement("url")
mapxml.documentElement.selectsinglenode("//urlset").appendChild item
set loc=mapxml.createelement("loc")
loc.text=strloc
item.appendChild loc
set loc=nothing
set item=nothing
next
mapxml.documentElement.setattribute "xmlns",king_gxmlvers
mapxml.save(server.mappath("../"&king_gxml&"_onepage.xml"))
set mapxml=nothing
case"2"
set rs=conn.execute("select artid,artpath,artgrade,sysdate from kingart where menuid="&l1&";")
if not rs.eof and not rs.bof then
data=rs.getrows()
tcount=ubound(data,2)
else
exit sub
end if
rs.close
set rs=nothing
for i=0 to tcount
if ll11("0",data(2,i)) then'静态页面
if cstr(king.named)="0" then
strloc=xmlencode(king.thisurl&king.inst&menupath&"/"&data(1,i)&king.ext)
else
strloc=xmlencode(king.thisurl&king.inst&menupath&"/"&III11(data(3,i))&"/"&data(1,i)&king.ext)
end if
else
strloc=xmlencode(king.thisurl&king.inst&king.path&"/article.asp?/"&data(0,i)&king.ext)
end if
set item=mapxml.createelement("url")
mapxml.documentElement.selectsinglenode("//urlset").appendChild item
set loc=mapxml.createelement("loc")
loc.text=strloc
item.appendChild loc
set loc=nothing
set item=nothing
if ((i+1) mod king_grn)=0 or i=tcount then
thispid=(i+1)/king_grn
if i=tcount then
thispid=(i+1)/king_grn
if thispid>int(thispid) then thispid=int(thispid)+1
end if
mapxml.documentElement.setattribute "xmlns",king_gxmlvers
mapxml.save(server.mappath("../"&king_gxml&"_"&l1&"_"&thispid&".xml"))
set mapxml=nothing
if cstr(i)<>cstr(king.count) then
set mapxml=createobject("microsoft.xmldom")
mapxml.async=false
mapxml.loadxml(king_xmlhead&king_gxmlhead)
end if
end if
next
case"3"
set rs=conn.execute("select jobpath,sysdate from kingjob where menuid="&l1&";")
if not rs.eof and not rs.bof then
data=rs.getrows()
tcount=ubound(data,2)
else
exit sub
end if
rs.close
set rs=nothing
for i=0 to tcount
strloc=xmlencode(king.thisurl&king.inst&menupath&"/"&III11(data(1,i))&"/"&data(0,i)&king.ext)
set item=mapxml.createelement("url")
mapxml.documentElement.selectsinglenode("//urlset").appendChild item
set loc=mapxml.createelement("loc")
loc.text=strloc
item.appendChild loc
set loc=nothing
set item=nothing
if ((i+1) mod king_grn)=0 or i=tcount then
thispid=(i+1)/king_grn
if i=tcount then
thispid=(i+1)/king_grn
if thispid>int(thispid) then thispid=int(thispid)+1
end if
mapxml.documentElement.setattribute "xmlns",king_gxmlvers
mapxml.save(server.mappath("../"&king_gxml&"_"&l1&"_"&thispid&".xml"))
set mapxml=nothing
if cstr(i)<>cstr(king.count) then
set mapxml=createobject("microsoft.xmldom")
mapxml.async=false
mapxml.loadxml(king_xmlhead&king_gxmlhead)
end if
end if
next
case"4"
case"10"
set rs=conn.execute("select topicid,sysdate from kingtopic where menuid="&l1&";")
if not rs.eof and not rs.bof then
data=rs.getrows
tcount=ubound(data,2)
else
exit sub
end if
rs.close
set rs=nothing
for i=0 to tcount
if ll11("0,1",bbstype) then'静态论坛
strloc=xmlencode(king.thisurl&king.inst&menupath&"/"&III11(data(1,i))&"/"&data(0,i)&king.ext)
else
strloc=xmlencode(king.thisurl&king.inst&king.path&"/topic.asp?/"&data(0,i)&king.ext)
end if
set item=mapxml.createelement("url")
mapxml.documentElement.selectsinglenode("//urlset").appendChild item
set loc=mapxml.createelement("loc")
loc.text=strloc
item.appendChild loc
set loc=nothing
set item=nothing
if ((i+1) mod king_grn)=0 or i=tcount then
thispid=(i+1)/king_grn
if i=tcount then
thispid=(i+1)/king_grn
if thispid>int(thispid) then thispid=int(thispid)+1
end if
mapxml.documentElement.setattribute "xmlns",king_gxmlvers
mapxml.save(server.mappath("../"&king_gxml&"_"&l1&"_"&thispid&".xml"))
set mapxml=nothing
if cstr(i)<>cstr(king.count) then
set mapxml=createobject("microsoft.xmldom")
mapxml.async=false
mapxml.loadxml(king_xmlhead&king_gxmlhead)
end if
end if
next
end select
end sub
'sub1 *** *** www.KingCMS.com *** ***
sub king_sub1()
dim tmphtm,outhtm,i,sql,menupath,metainfo,rs,invalue,data
sql=" menutitle,menupath,menutemplate1,menutemplate2,menulanguage,menudesc,menukeyword,menudescription,menuid1,menuname,menuid"'10
set rs=conn.execute("select "&sql&" from kingmenu where classid=1;")
if not rs.eof and not rs.bof then
data=rs.getrows()
else
redim data(9,-1)
end if
rs.close
set rs=nothing
for i=0 to ubound(data,2)
tmphtm=king.read(data(2,i),"onepage/"&data(3,i))
king.language=data(4,i)'设置调用的语言(设置导航栏目的语言用)
invalue="title:"&I11II(htmlencode(data(0,i)))
invalue=invalue&"|keyword:"&I11II(htmlencode(king.cls(data(6,i))))
invalue=invalue&"|description:"&I11II(htmlencode(king.cls(data(7,i))))
invalue=invalue&"|guide:"&I11II(king.guide(data(8,i))&htmlencode(data(9,i)))
invalue=invalue&"|content:"&I11II(data(5,i))
invalue=invalue&"|menuid:"&data(10,i)
invalue=invalue&"|path:"&I11II(king.inst&data(1,i))'当前文件路径,做加入收藏夹用??
outhtm=king.create(tmphtm,invalue,1)
menupath=left(data(1,i),instrrev(data(1,i),"/"))
Ill "../"&menupath
I11 "../"&data(1,i),lIIllI(outhtm)'创建文件
next
king_sitemaps 0
end sub
'sub2 page *** *** www.KingCMS.com *** ***
sub king_sub2_page(l1,l2)'artid,menuid若menuid=0,只生成指定的artid
dim i,j,rs,outhtm,outfname,sql,insql,menuid
dim menupath,menulanguage,tmphtm,menuname'中间变量部分
dim arrcontent,invalue,data
sql ="artid,menuid,arttitle,artauthor,artfrom,artcontent,artinput,artkeyword,artdescription"'8
sql=sql&",artpath,artimg,artdate,sysdate"'12
if cstr(l1)<>"0" then insql=" and artid in ("&l1&") "
if cstr(l2)<>"0" then insql=insql&" and menuid="&l2&" "
' king.open "select "&sql&" from kingart where menuid<>0 and artgrade=0 "&insql&" order by artid desc;","",0
set rs=conn.execute("select "&sql&" from kingart where menuid<>0 and artgrade=0 "&insql&" order by artid desc;")
if not rs.eof and not rs.bof then
data=rs.getrows()
else
redim data(8,-1)
end if
rs.close
set rs=nothing
for i=0 to ubound(data,2)
'如果前一次的和这次的menuid值不相等的时候,读取
if cstr(menuid)<>cstr(data(1,i)) then
menuid=data(1,i)
set rs=conn.execute("select menupath,menulanguage,menutemplate1,menutemplate2,menuname from kingmenu where menuid="&menuid&";")
if not rs.eof and not rs.bof then
menupath=rs(0)
menuname=rs(4)
king.language=rs(1)
tmphtm=king.read(rs(2),"article[page]/"&rs(3))
end if
rs.close
set rs=nothing
end if
arrcontent=split(data(5,i),king_break)
for j=0 to ubound(arrcontent)
invalue="title:"&I11II(htmlencode(data(2,i)))
invalue=invalue&"|keyword:"&I11II(htmlencode(data(7,i)))
invalue=invalue&"|date:"&I11II(data(11,i))
invalue=invalue&"|menuid:"&menuid
invalue=invalue&"|guide:"&I11II(king.guide(data(1,i))&htmlencode(data(2,i)))
invalue=invalue&"|description:"&I11II(htmlencode(king.cls(data(8,i))))
invalue=invalue&"|pagelist:"&I11II(I1I11(data(9,i),j+1,ubound(arrcontent)+1))
invalue=invalue&"|artid:"&data(0,i)
invalue=invalue&"|from:"&I11II(htmlencode(data(4,i)))
if len(data(10,i))>0 then
invalue=invalue&"|image:"&I11II(III11(data(12,i))&"/"&data(10,i))
else
invalue=invalue&"|image:"&I11II("not/notpic.gif")
end if
invalue=invalue&"|author:"&I11II(htmlencode(data(3,i)))
invalue=invalue&"|input:"&I11II(htmlencode(data(6,i)))
if cstr(king.named)="0" then
invalue=invalue&"|path:"&I11II(king.inst&menupath&"/"&data(9,i)&king.ext)
else
invalue=invalue&"|path:"&I11II(king.inst&menupath&"/"&III11(data(12,i))&"/"&data(9,i)&king.ext)
end if
invalue=invalue&"|content:"&I11II(arrcontent(j))
invalue=invalue&"|comment:"&I11II(king.inst&king.path&"/comment.asp?supid="&data(0,i)&"&classid=2")
invalue=invalue&"|menupath:"&I11II(king.inst&menupath&"/index"&king.ext)
invalue=invalue&"|menuname:"&I11II(htmlencode(menuname))
invalue=invalue&"|hit:"&I11II("")
invalue=invalue&"|revert:"&I11II("")
outhtm=king.create(tmphtm,invalue,0)
'生成输出
if j=0 then
outfname=data(9,i)
else
outfname=data(9,i)&"_"&j+1
end if
IIII "../"&menupath,outfname,outhtm,data(12,i)
next
next
end sub
'sub2 list *** *** www.KingCMS.com *** ***
sub king_sub2_list(l1)
if cstr(l1)="" then exit sub
dim tmphtmlist,intmp,menuname,menupath'intmp内部模板
dim vmenuname,vmenupath,artpath
dim data,rs,i,sql
dim jshtm,invalues,intmplist,jsnumber,jsorder
dim invalue,insidehtm,outhtm,listhtm,thispid'thispid:当前页数 listhtm:导航列表的代码
dim outxml,zebra
'读取模板,获得参数
sql="menutemplate,menutemplatelist,menulanguage,menupath,menutitle,menukeyword,menudescription,menuid1,menuname"
set rs=conn.execute("select "&sql&" from kingmenu where menuid="&l1&";") '8
if not rs.bof and not rs.eof then
data=rs.getrows()
king.language=data(2,0)
tmphtmlist=king.read(data(0,0),"article[list]/"&data(1,0))'设置waibu模板
menupath=data(3,0)
menuname=data(4,0)
king.rn=20
intmplist=king.getlist(tmphtmlist,"article",1)'king.match(tmphtmlist,"(\{king:)(article|news).+?type=\""list\"".{0,}?(\})(.|\n)+?\{\/king\}")'
jshtm=king.getlabel(intmplist,0)
zebra=king.getlabel(intmplist,"zebra")
jsorder=king.getlabel(intmplist,"order")
jsnumber=king.getlabel(intmplist,"number")
if II11(jsnumber,2) then king.rn=jsnumber
if lcase(jsorder)="asc" then jsorder="asc" else jsorder="desc"
invalues="title:"&I11II(htmlencode(data(4,0)))'页面总参数
invalues=invalues&"|keyword:"&I11II(htmlencode(king.cls(data(5,0))))
invalues=invalues&"|guide:"&I11II(king.guide(data(7,0))&data(8,0))
invalues=invalues&"|description:"&I11II(htmlencode(king.cls(data(6,0))))
invalues=invalues&"|menuid:"&l1
invalues=invalues&"|rsspath:"&I11II(king.inst&menupath&"/rss.xml")
invalues=invalues&"|rss:"&I11II("["&king.lang("common/rss")&"]")
else'如果为空,这输出临时文件
exit sub
end if
rs.close
set rs=nothing
sql="artid,menuid,arttitle,artauthor,artfrom,artdescription,artpath,artimg,artdate,sysdate,artgrade" '10
king.open "select "&sql&" from kingart where artshow=1 and (menuid="&l1&" or menuids like '%,"&l1&",%') order by artup desc,artorder "&jsorder&",artid desc;",1,0
'king.data()的值为空的时候,生成一个临时页面。免得出现404错误
if cstr(king.length)="-1" then
outhtm=replace(tmphtmlist,intmplist,king.lang("sub1/tempdesc"))
outhtm=king.create(outhtm,invalues,0)
Ill "../"&data(3,0)
I11 "../"&data(3,0)&"/index"&king.ext,outhtm '创建文件
exit sub
end if
'如果article type=list为空值的时候,就不需要输出全部列表,直接输出本页
if len(intmplist)=0 then
outhtm=king.create(tmphtmlist,invalues,0)
IIII "../"&menupath,"index",outhtm,0
exit sub
end if
' set gmapxml=createobject("microsoft.xmldom")
' gmapxml.async=false
' gmapxml.loadxml(king_xmlhead&king_gxmlhead)
for i=0 to king.length'循环一遍
if cstr(king.data(1,i))=cstr(l1) then
vmenuname=menuname:vmenupath=menupath
else
set rs=conn.execute("select menuname,menupath from kingmenu where menuid="&king.data(1,i)&";")
vmenuname=rs(0):vmenupath=rs(1)
set rs=nothing
end if
'每页显示数
invalue="title:"&I11II(htmlencode(king.data(2,i)))
invalue=invalue&"|menuid:"&l1
invalue=invalue&"|author:"&I11II(htmlencode(king.data(3,i)))
invalue=invalue&"|from:"&I11II(htmlencode(king.data(4,i)))
invalue=invalue&"|description:"&I11II(htmlencode(king.data(5,i)))
invalue=invalue&"|date:"&I11II(king.data(8,i))
invalue=invalue&"|image:"&I11II(III11(king.data(9,i))&"/"&king.data(7,i))
if cstr(king.data(10,i))="0" then
if cstr(king.named)="0" then
artpath=vmenupath&"/"&king.data(6,i)&king.ext
else
artpath=vmenupath&"/"&III11(king.data(9,i))&"/"&king.data(6,i)&king.ext
end if
invalue=invalue&"|path:"&I11II(king.inst&artpath)
if lllll("../"&artpath)=false then king_sub2_page king.data(0,i),0
else
invalue=invalue&"|path:"&I11II(king.inst&king.path&"/article.asp?/"&king.data(0,i)&king.ext)
end if
invalue=invalue&"|menuname:"&I11II(htmlencode(vmenuname))
invalue=invalue&"|menupath:"&I11II(king.inst&vmenupath)&"/index"&king.ext
if i mod zebra then
invalue=invalue&"|zebra:0"
else
invalue=invalue&"|zebra:F"
end if
insidehtm=insidehtm&king.createhtm(jshtm,invalue)
if ((i+1) mod king.rn)=0 or i+1=king.count then
thispid=(i+1)/king.rn
if i+1=king.count then thispid=king.pagecount
listhtm=IlI("index$"&king.ext,thispid,king.pagecount)'url,pid当前页数,总页数
outhtm=replace(tmphtmlist,intmplist,chr(3)&"kingarticlelist"&chr(2))
outhtm=king.create(outhtm,invalues&"|pagelist:"&I11II(listhtm),0)
outhtm=replace(outhtm,chr(3)&"kingarticlelist"&chr(2),insidehtm)
if cstr(thispid)="1" then'导航首页
IIII "../"&menupath,"index",outhtm,0
else
if i+1=king.count then
if thispid>int(thispid) then
IIII "../"&menupath,"index"&cstr(int(thispid)+1),outhtm,0
else
IIII "../"&menupath,"index"&cstr(thispid),outhtm,0
end if
else
IIII "../"&menupath,"index"&cstr(thispid),outhtm,0
end if
end if
insidehtm=""
end if
next
king_sitemaps l1
end sub
'sub3 page *** *** www.KingCMS.com *** ***
sub king_sub3_page(l1,l2)
dim rs,data,datamenu,i,tmphtm,outhtm,sql,insql,invalue
dim menuid,sqlmenu,menuname,menupath
sql="jobid,menuid,jobname,jobaddress,jobcontent,jobduties,jobask,jobpath,jobdate,sysdate,jobnumber"'10
sqlmenu="menuname,menupath,menutemplate1,menutemplate2,menulanguage"'4
if cstr(l1)<>"0" then insql=" and jobid in ("&l1&") "
if cstr(l2)<>"0" then insql=insql&" and menuid="&l2
set rs=conn.execute("select "&sql&" from kingjob where jobshow=1 "&insql&";")
if not rs.eof and not rs.bof then
data=rs.getrows()
else
exit sub
end if
rs.close
set rs=nothing
for i=0 to ubound(data,2)
if cstr(menuid)<>cstr(data(1,i)) then'当栏目有改变的时候,读取模板
menuid=data(1,i)
set rs=conn.execute("select "&sqlmenu&" from kingmenu where menuid="&menuid&";")
if not rs.eof and not rs.bof then
menuname=htmlencode(rs(0))
menupath=htmlencode(rs(1))
tmphtm=king.read(rs(2),"job[page]/"&rs(3))
king.language=rs(4)
else
exit sub
end if
rs.close
set rs=nothing
end if
invalue="title:"&I11II(htmlencode(data(2,i)))
invalue=invalue&"|menuid:"&data(1,i)
invalue=invalue&"|keyword:"&I11II(I1111(data(2,i),0))
invalue=invalue&"|guide:"&I11II(king.guide(menuid)&htmlencode(data(2,i)))
invalue=invalue&"|description:"&I11II(htmlencode(king.lefte(king.cls(data(4,i)),200)))
invalue=invalue&"|jobid:"&data(0,i)
invalue=invalue&"|path:"&I11II(king.inst&menupath&"/"&III11(data(9,i))&"/"&data(7,i)&king.ext)
invalue=invalue&"|address:"&I11II(htmlencode(data(3,i)))
invalue=invalue&"|content:"&I11II(ll111(data(4,i)))
invalue=invalue&"|number:"&I11II(htmlencode(data(10,i)))
invalue=invalue&"|duties:"&I11II(ll111(data(5,i)))
invalue=invalue&"|ask:"&I11II(ll111(data(6,i)))
invalue=invalue&"|date:"&I11II(data(8,i))
outhtm=king.create(tmphtm,invalue,0)
'生成输出
Ill "../"&menupath&"/"&III11(data(9,i))&"/"
I11 "../"&menupath&"/"&III11(data(9,i))&"/"&data(7,i)&king.ext,outhtm
next
end sub
'sub3 list *** *** www.KingCMS.com *** ***
sub king_sub3_list(l1)
dim rs,data,datamenu,i,tmphtmlist,outhtm,sql,insql,invalue,invalues
dim menuid,sqlmenu,menuname,menupath,intmplist
dim jsnumber,jshtm,zebra,insidehtm
dim thispid,listhtm
sqlmenu="menutemplate,menutemplatelist,menulanguage,menupath,menutitle,menukeyword,menudescription,menuid1,menuname"'8
'读取模板,获得参数
set rs=conn.execute("select "&sqlmenu&" from kingmenu where menuid="&l1&";") '8
if not rs.bof and not rs.eof then
datamenu=rs.getrows()
king.language=datamenu(2,0)
tmphtmlist=king.read(datamenu(0,0),"job[list]/"&datamenu(1,0))'设置waibu模板
menupath=datamenu(3,0)
menuname=datamenu(4,0)
intmplist=king.getlist(tmphtmlist,"job",1)
jsnumber=king.getlabel(intmplist,"number")
if II11(jsnumber,2) then king.rn=jsnumber
jshtm=king.getlabel(intmplist,0)
zebra=king.getlabel(intmplist,"zebra")
invalues="title:"&I11II(htmlencode(datamenu(4,0)))'页面总参数
invalues=invalues&"|keyword:"&I11II(htmlencode(king.cls(datamenu(5,0))))
invalues=invalues&"|guide:"&I11II(king.guide(datamenu(7,i))&datamenu(8,i))
invalues=invalues&"|description:"&I11II(htmlencode(king.cls(datamenu(6,0))))
else'如果为空,这输出临时文件
exit sub
end if
rs.close
set rs=nothing
sql="jobid,jobname,jobnumber,jobaddress,jobpath,jobdate,sysdate"'5
king.open "select "&sql&" from kingjob where jobshow=1 and menuid="&l1&" order by joborder desc,jobid desc",1,0
'如果为空值,就生成临时的空文件
if cstr(king.length)="-1" then
outhtm=replace(tmphtmlist,intmplist,king.lang("sub1/tempdesc"))
outhtm=king.create(outhtm,invalues,0)
Ill "../"&menupath
I11 "../"&menupath&"/index"&king.ext,outhtm '创建文件
exit sub
end if
'如果article type=list为空值的时候,就不需要输出全部列表,直接输出本页
if len(intmplist)=0 then
outhtm=king.create(tmphtmlist,invalues,0)
Ill "../"&menupath
I11 "../"&menupath&"/index"&king.ext,outhtm '创建文件
exit sub
end if
for i=0 to king.length'循环一遍
'每页显示数
invalue="title:"&I11II(htmlencode(king.data(1,i)))
invalue=invalue&"|menuid:"&l1
invalue=invalue&"|number:"&I11II(htmlencode(king.data(2,i)))
invalue=invalue&"|address:"&I11II(htmlencode(king.data(3,i)))
invalue=invalue&"|path:"&I11II(king.inst&menupath&"/"&III11(king.data(6,i))&"/"&king.data(4,i)&king.ext)
invalue=invalue&"|date:"&I11II(king.data(5,i))
if lllll("../"&menupath&"/"&III11(king.data(6,i))&"/"&king.data(4,i)&king.ext)=false then king_sub3_page king.data(0,i),0
if i mod zebra then
invalue=invalue&"|zebra:0"
else
invalue=invalue&"|zebra:F"
end if
insidehtm=insidehtm&king.createhtm(jshtm,invalue)
if ((i+1) mod king.rn)=0 or i+1=king.count then
thispid=(i+1)/king.rn
if i+1=king.count then thispid=king.pagecount
listhtm=IlI("index$"&king.ext,thispid,king.pagecount)'url,pid当前页数,总页数
outhtm=replace(tmphtmlist,intmplist,chr(3)&"kingjoblist"&chr(2))
outhtm=king.create(outhtm,invalues&"|pagelist:"&I11II(listhtm),0)
outhtm=replace(outhtm,chr(3)&"kingjoblist"&chr(2),insidehtm)
if cstr(thispid)="1" then'导航首页
I11 "../"&menupath&"/index"&king.ext,outhtm
else
if i+1=king.count then
if thispid>int(thispid) then
I11 "../"&menupath&"/index"&cstr(int(thispid)+1)&king.ext,outhtm
else
I11 "../"&menupath&"/index"&cstr(thispid)&king.ext,outhtm
end if
else
I11 "../"&menupath&"/index"&cstr(thispid)&king.ext,outhtm
end if
end if
insidehtm=""
end if
next
king_sitemaps l1
end sub
'sub4 list *** *** www.KingCMS.com *** ***
'sub10 page *** *** www.KingCMS.com *** ***
sub king_sub10_page(l1,l2)
if len(l1)=0 then exit sub
dim sql,insql,sqltopic,sqlboard,sqlmenu,sqluser
dim rs,data,datatopic,idata,datamenu,datauser,i,j,menuid,topicid,userid
dim xmlvote,votenum,maxnum,votecount,outvote
dim outmanage,paperclip
dim tmphtm,menupath,rn,intmplist,jsnumber,jshtm,zebra
dim tcount,tpagecount
dim invalue,invalues,listhtm,metainfo,outhtm,userip,insidehtm,thispid
dim strqq,stricq,stryahoo,match,filepath
if cstr(l1)<>"0" then insql=" and topicid in ("&l1&") "
if cstr(l2)<>"0" then insql=insql&" and menuid="&l2
sqlboard="boardid,bbstitle,bbscontent,bbsimg,boarddel,isface,isubb,issign,sysdate,lastdate,bbsdate,userid,userip,useragent,lastusername,downhit"
sqltopic="topicid,bbstitle,bbscontent,bbsimg,topicdel,isface,isubb,issign,sysdate,lastdate,bbsdate,userid,userip,useragent,lastusername,downhit"'15
sqlmenu="menutemplate1,menutemplate2,menulanguage,menupath,menutitle,menukeyword,menudescription,menuid1,menuname,bbstype,bbsmaster"'10
sqluser="username,usersign,usertitle,usersex,userclass,usermark,userprestige,userphoto,userwidth,userheight,userim"'10
sqluser=sqluser&",joindate,isusermail,usermail,userfrom,userskill,counttopic,counttopicbest,counttopicdel,usersite"'19
sql="topicid,sysdate,menuid,isvote,votetext,votetype,voteend,topicup,topicbest,topiclock"
' isvote,votetext,votetype,voteend,topicup,topicbest,topiclock
set rs=conn.execute("select "&sql&" from kingtopic where topicdel=0 "&insql&";")
if not rs.eof and not rs.bof then
datatopic=rs.getrows()
else
exit sub
end if
rs.close
set rs=nothing
for j=0 to ubound(datatopic,2)'循环topic
topicid=datatopic(0,j)
'如果是投票
maxnum=1:votecount=0:outvote=""
if cstr(datatopic(3,j))="1" then
set xmlvote=createobject("microsoft.xmldom")
xmlvote.async=false
xmlvote.loadxml(datatopic(4,j))
for each match in xmlvote.documentelement.childnodes
votenum=match.selectsinglenode("//vote/"&match.nodename&"/@number").text
if cint(votenum)>cint(maxnum) then
maxnum=votenum
end if
votecount=votecount+cint(votenum)
next
if votecount=0 then votecount=1'votecount不能零除
outvote=""
set xmlvote=nothing
end if
'管理菜单的显示
if cstr(datatopic(7,j))="2" then
outmanage="取消总置顶"
else
outmanage="总置顶"
end if
if cstr(datatopic(7,j))="1" then
outmanage=outmanage&"·取消置顶"
else
outmanage=outmanage&"·置顶"
end if
if cstr(datatopic(8,j))="1" then
outmanage=outmanage&"·取消精华"
else
outmanage=outmanage&"·精华"
end if
if cstr(datatopic(9,j))="1" then
outmanage=outmanage&"·解除锁定"
else
outmanage=outmanage&"·锁定"
end if
outmanage=outmanage&"·删除"
outmanage=outmanage&"·移动"
outmanage=outmanage&"·提升"
' sqlboard="boardid,bbstitle,bbscontent,bbsimg,boarddel,isface,isubb,issign,sysdate,lastdate,bbsdate,userid,userip,useragent,lastusername,downhit"
' sqltopic="topicid,bbstitle,bbscontent,bbsimg,topicdel,isface,isubb,issign,sysdate,lastdate,bbsdate,userid,userip,useragent,lastusername,downhit"'15
set rs=conn.execute("select "&sqltopic&" from kingtopic where topicid="&topicid&" union all select "&sqlboard&" from kingboard where topicid="&topicid&" and boarddel=0 order by sysdate;")
if not rs.eof and not rs.bof then
data=rs.getrows()
tcount=ubound(data,2)
else
exit sub
end if
rs.close
set rs=nothing
' sqlmenu="menutemplate1,menutemplate2,menulanguage,menupath,menutitle,menukeyword,menudescription,menuid1,menuname,bbstype,bbsmaster"'10
' if cstr(menuid)<>cstr(datatopic(2,j)) then'栏目有变动的时候,进行更新
set rs=conn.execute("select "&sqlmenu&" from kingmenu where menuid="&datatopic(2,j)&";") '10
if not rs.bof and not rs.eof then
datamenu=rs.getrows()
'如果这个栏目类型不为普通论坛,就不进行生成操作
if ll11("0,1",datamenu(9,0))=false then tcount=-1'redim data(15,-1)
menuid=datatopic(2,j)
king.language=datamenu(2,0)
tmphtm=king.read(datamenu(0,0),"bbs[page]/"&datamenu(1,0))'设置waibu模板
menupath=datamenu(3,0)
rn=10
intmplist=king.getlist(tmphtm,"bbs",1)
jsnumber=king.getlabel(intmplist,"number"):if II11(jsnumber,2) then rn=cdbl(jsnumber)
jshtm=king.getlabel(intmplist,0)
zebra=king.getlabel(intmplist,"zebra")
tpagecount=int((tcount+1)/rn):if tpagecount<((tcount+1)/rn) then tpagecount=tpagecount+1
else
exit sub
end if
rs.close
set rs=nothing
' end if
' sql="topicid,sysdate,menuid,isvote,votetext,votetype,voteend,topicup,topicbest,topiclock"
'页面循环体外的参数
if cstr(ubound(data,2))<>"-1" then
invalues="title:"&I11II(htmlencode(data(1,0)))'页面总参数
invalues=invalues&"|menuid:"&menuid
invalues=invalues&"|keyword:"&I11II(I1111(data(1,0),0))
invalues=invalues&"|guide:"&I11II(king.guide(menuid)&htmlencode(left(data(1,0),30)))
invalues=invalues&"|description:"&I11II(left(llIIl(htmlencode(data(2,0))),120))
invalues=invalues&"|menuname:"&I11II(htmlencode(datamenu(8,0)))
if ll11("0,1",datamenu(9,0)) then
invalues=invalues&"|menupath:"&I11II(king.inst&datamenu(3,0)&"/index"&king.ext)
else
invalues=invalues&"|menupath:"&I11II(king.inst&king.path&"/topiclist.asp?"&menuid&king.ext)
end if
invalues=invalues&"|addtopic:"&I11II("")
invalues=invalues&I11II("")
invalues=invalues&"|addvote:"&I11II("")
invalues=invalues&I11II("")
invalues=invalues&"|replytopic:"&I11II("")
invalues=invalues&I11II("")
invalues=invalues&"|#bottom:"&I11II("")
' invalues=invalues&"|refresh:"&I11II("")
invalues=invalues&"|manage:"&I11II(outmanage)'"·总置顶·置顶·精华·锁定·删除·移动·提升·"
if len(datamenu(10,0))>0 then
invalues=invalues&"|masters:"&I11II(datamenu(10,0))
else
invalues=invalues&"|masters:"&I11II(king.lang("common/none"))
end if
invalues=invalues&"|topicid:"&topicid
invalues=invalues&"|vote:"&I11II(outvote)
invalues=invalues&"|hit:"&I11II("")
invalues=invalues&"|revert:"&I11II("")
end if
for i=0 to tcount'循环topic+board
invalue="title:"&I11II(htmlencode(data(1,i)))
invalue=invalue&"|menuid:"&menuid
if len(data(3,i))>0 then'如果有附件
filepath=king.inst&king_upath&"/image/"&III11(data(10,i))&"/"&data(3,i)
if ll11("jpeg,jpg,png,gif,bmp",lIl(data(3,i))) then'图片类型,直接贴图
if i=0 then'topic
paperclip="
"
paperclip=paperclip&""&data(3,i)&" [][下载 "&data(15,i)&" 次]"
end if
end if
else
paperclip=""
end if
' sqlboard="boardid,bbstitle,bbscontent,bbsimg,boarddel,isface,isubb,issign,sysdate,lastdate,bbsdate,userid,userip,useragent,lastusername,downhit"
' sqltopic="topicid,bbstitle,bbscontent,bbsimg,topicdel,isface,isubb,issign,sysdate,lastdate,bbsdate,userid,userip,useragent,lastusername,downhit"'15
invalue=invalue&"|content:"&I11II(king.ubbencode(data(2,i),data(5,i),data(6,i),true)&paperclip)
invalue=invalue&"|date:"&I11II(data(8,i))
if data(9,i)<>"" then
invalue=invalue&"|lastdate:"&I11II(" "&king.lang("bbs/tip/lastedit|date:"&I11II(data(9,i))&";user:"&data(14,i))&"")
end if
invalue=invalue&"|#top:"&I11II("")
if i=0 then'如果是主题贴
invalue=invalue&"|floor:"&king.lang("bbs/floor")
invalue=invalue&"|edit:"&I11II("")
invalue=invalue&"|quote:"&I11II("")
invalue=invalue&"|del:"&I11II("")
invalue=invalue&"|report:"&I11II("")
else'回复贴
invalue=invalue&"|floor:#"&i+1
invalue=invalue&"|edit:"&I11II("")
invalue=invalue&"|quote:"&I11II("")
invalue=invalue&"|del:"&I11II("")
invalue=invalue&"|report:"&I11II("")
end if
'用户信息
if cstr(userid)<>cstr(data(11,i)) then
set rs=conn.execute("select "&sqluser&" from kinguser where userid="&data(11,i)&";")
datauser=rs.getrows()
userid=data(11,i)
rs.close
set rs=nothing
end if
invalue=invalue&"|username:"&I11II(htmlencode(datauser(0,0)))
invalue=invalue&"|userid:"&data(11,i)
if len(datauser(2,0))>0 then'头衔
invalue=invalue&"|usertitle:"&I11II(htmlencode(datauser(2,0)))
else
invalue=invalue&"|usertitle:--"
end if
invalue=invalue&"|usersex:"&I11II(htmlencode(king.lang("user/sex/sex"&datauser(3,0))))'性别
invalue=invalue&"|userlevel:"&I11II(king.grade(datauser(4,0),datauser(5,0),0))'级别
invalue=invalue&"|userlevelimage:"&I11II(king.grade(datauser(4,0),datauser(5,0),1))'级别图像
invalue=invalue&"|usermark:"&datauser(5,0)'积分
invalue=invalue&"|userprestige:"&datauser(6,0)'威望
invalue=invalue&"|counttopic:"&datauser(16,0)'发帖数
invalue=invalue&"|counttopicbest:"&datauser(17,0)'精华
invalue=invalue&"|counttopicdel:"&datauser(18,0)'被删除
invalue=invalue&"|userprofile:"&I11II(king.inst&king.path&"/user.asp?userid="&data(11,i))
invalue=invalue&"|userskill:"&I11II(htmlencode(datauser(15,0)))'特长
invalue=invalue&"|userfrom:"&I11II(htmlencode(datauser(14,0)))'来自
if ll11("swf",lIl(datauser(7,0))) then'flash头像
invalue=invalue&"|userphoto:"&I11II("")
else
invalue=invalue&"|userphoto:"&I11II("")
end if
invalue=invalue&"|joindate:"&I11II(datauser(11,0))
userip=left(data(12,i),instrrev(data(12,i),"."))&"*"
invalue=invalue&"|userip:"&I11II(userip)
invalue=invalue&"|useragent:"&I11II(htmlencode(data(13,i)))
if datauser(1,0)<>"" and data(7,i) then
invalue=invalue&"|usersign:"&I11II("
"&king.ubbencode(datauser(1,0),1,1,true)&"
")
end if
invalue=invalue&"|blog:"&I11II("")
invalue=invalue&"|pm:"&I11II("")
invalue=invalue&"|profile:"&I11II("")
if cstr(datauser(12,0))="1" then
invalue=invalue&"|mail:"&I11II("")
end if
if len(datauser(19,0))>0 then
invalue=invalue&"|site:"&I11II("")
end if
if i mod zebra=0 then
invalue=invalue&"|zebra:0"
else
invalue=invalue&"|zebra:F"
end if
if datauser(10,0)<>"" then
strqq=l11(datauser(10,0),"","")
stricq=l11(datauser(10,0),"","")
stryahoo=l11(datauser(10,0),"","")
if strqq<>"" then
invalue=invalue&"|qq:"&I11II("")
end if
if stricq<>"" then
invalue=invalue&"|icq:"&I11II("")
end if
if stryahoo<>"" then
invalue=invalue&"|yahoo:"&I11II("")
end if
end if
if (i mod rn)=0 then
insidehtm=insidehtm&king.createhtm(jshtm,invalue)
else
insidehtm=insidehtm&king.createhtm(king.clsre(jshtm,"\(king\:ad .+?\/\)"),invalue)
end if
if ((i+1) mod rn)=0 or i=tcount then
'topicid,sysdate,menuid,isvote,votetext,votetype,voteend,topicup,topicbest,topiclock
thispid=(i+1)/rn
if i=tcount then thispid=tpagecount
listhtm=I1I11(topicid,thispid,tpagecount)
' out""&topicid&"|"&thispid&"|"&tpagecount
outhtm=replace(tmphtm,intmplist,chr(3)&"kingbbslist"&chr(2))
outhtm=king.create(outhtm,invalues&"|pagelist:"&I11II(listhtm),0)
outhtm=replace(outhtm,chr(3)&"kingbbslist"&chr(2),insidehtm)
metainfo=chr(60)&chr(104)&"ead"&chr(62)&vbcr
metainfo=metainfo&""&vbcr
metainfo=metainfo&""&vbcr
metainfo=metainfo&""
outhtm=llllI(outhtm,metainfo,"("&chr(60)&"h"&"ead).{0,}?\"&chr(62))
if cstr(thispid)="1" then'首页
IIII "../"&menupath&"/"&III11(datatopic(1,j)),datatopic(0,j),outhtm,0
else
if i=tcount then
if thispid>int(thispid) then
IIII "../"&menupath&"/"&III11(datatopic(1,j)),datatopic(0,j)&"_"&cstr(int(thispid)+1),outhtm,0
else
IIII "../"&menupath&"/"&III11(datatopic(1,j)),datatopic(0,j)&"_"&cstr(thispid),outhtm,0
end if
else
IIII "../"&menupath&"/"&III11(datatopic(1,j)),datatopic(0,j)&"_"&cstr(thispid),outhtm,0
end if
end if
insidehtm=""
end if
next
next
end sub
'sub10 list *** *** www.KingCMS.com *** ***
sub king_sub10_list(l1)
if cstr(l1)="" then exit sub
dim tmphtm,tmphtmlist,menupath
dim datamenu,info,rs,i,sql,metainfo
dim pagenumber,intmplist,jsnumber,jshtm
dim invalues
dim invalue,insidehtm,outhtm,listhtm,thispid'thispid:当前页数 listhtm:导航列表的代码
dim themetype,topicattrib,topiclist,vmenupath,topiccount,topicpagecount,zebra,bbstype
set rs=conn.execute("select hotreply from kingsystem where systemname='KingCMS';")'0
if not rs.bof and not rs.eof then
info=rs.getrows()
end if
rs.close
set rs=nothing
sql="menutemplate,menutemplatelist,menulanguage,menupath,menutitle,menukeyword"'5
sql=sql&",menudescription,menuid1,menuname,bbsmaster,menutemplate1,menutemplate2"'11
'读取模板,获得参数
set rs=conn.execute("select "&sql&" from kingmenu where menuid="&l1&" and bbstype=1;") '11
if not rs.bof and not rs.eof then
datamenu=rs.getrows()
else
exit sub
end if
rs.close
set rs=nothing
invalues="title:"&I11II(htmlencode(datamenu(4,0)))'页面总参数
invalues=invalues&"|menuid:"&l1
invalues=invalues&"|keyword:"&I11II(htmlencode(king.cls(datamenu(5,0))))
invalues=invalues&"|guide:"&I11II(king.guide(datamenu(7,0))&datamenu(8,0))
invalues=invalues&"|description:"&I11II(htmlencode(king.cls(datamenu(6,0))))
invalues=invalues&"|addtopic:"&I11II("")
invalues=invalues&I11II("")
invalues=invalues&"|addvote:"&I11II("")
invalues=invalues&I11II("")
invalues=invalues&"|besttopic:"&I11II("")
invalues=invalues&I11II("")
if len(datamenu(9,0))>0 then
invalues=invalues&"|masters:"&I11II(datamenu(9,0))
else
invalues=invalues&"|masters:"&I11II(king.lang("common/none"))
end if
invalues=invalues&"|rsspath:"&I11II(king.inst&datamenu(3,0)&"/rss.xml")
invalues=invalues&"|rss:"&I11II("["&king.lang("common/rss")&"]")
tmphtmlist=king.read(datamenu(0,0),"bbs[list]/"&datamenu(1,0))
tmphtm=king.read(datamenu(10,0),"bbs[page]/"&datamenu(11,0))
intmplist=king.getlist(tmphtmlist,"bbs",1)
menupath=datamenu(3,0)
zebra=king.getlabel(intmplist,"zebra")
jshtm=king.getlabel(intmplist,0)
jsnumber=king.getlabel(intmplist,"number")
if II11(jsnumber,2) then king.rn=jsnumber
pagenumber=king.getlist(tmphtm,"bbs","number")
sql=" topicid,bbstitle,topictype,bbscontent,topiclock,topichit,topicreply,topicup,topicbest,bbsimg,"'9
sql=sql&"sysdate,lastdate,lastpostuser,lastpostdate,isvote,userid,username,topicicon,menuid "'18
king.open "select top "&king.rn*7&" "&sql&" from kingtopic where topicdel=0 and (menuid="&l1&" or topicup=2) order by topicup desc,lastpostdate desc,topicid desc;",1,0
if king.length=-1 then'如果记录集为空,就输出空页面.
outhtm=replace(tmphtmlist,intmplist,"")
outhtm=king.create(outhtm,invalues,0)
IIII "../"&menupath,"index",outhtm,0
exit sub
end if
'out menupath
topiccount=conn.execute("select count(topicid) from kingtopic where topicdel=0 and (menuid="&l1&" or topicup=2);")(0)'topic总数
king.count=topiccount
topicpagecount=int(topiccount/king.rn):if (topiccount/king.rn)>topicpagecount then topicpagecount=topicpagecount+1'总页数
for i=0 to king.length'不循环所有的,只循环前7页
invalue="topictitle:"&I11II(htmlencode(king.data(1,i)))
invalue=invalue&"|menuid:"&king.data(18,i)
invalue=invalue&"|description:"&I11II(htmlencode(king.cls(king.data(3,i))))
invalue=invalue&"|title:"&I11II(htmlencode(king.data(1,i)))
if datediff("h",king.data(10,i),tnow)<=8 then
invalue=invalue&"|topicnew:"&I11II("")
end if
if cstr(king.data(4,i))="1" then'锁定
themetype="lock"
else
if datediff("h",king.data(13,i),tnow)<=8 then themetype="new" else themetype="old"'8小时内是否有回复贴
if king.data(6,i)>=info(0,0) then themetype=themetype&"hot" else themetype=themetype'多余10个帖子,就是热门
end if
invalue=invalue&"|type:"'图标
if cstr(king.data(17,i))<>"0" then
invalue=invalue&"|icon:"'帖子类型?
end if
invalue=invalue&"|reply:"&king.data(6,i)'回复数
invalue=invalue&"|hit:"&king.data(5,i)'查看次数
invalue=invalue&"|topicuser:"&I11II(htmlencode(king.data(16,i)))'作者
invalue=invalue&"|topicprofile:"&I11II(king.inst&king.path&"/user.asp?userid="&king.data(15,i))'作者信息
invalue=invalue&"|topicdate:"&I11II(king.data(10,i))'创贴时间
if cstr(king.data(7,i))="2" then'如果是总置顶贴,需要重新计算menupath值
set rs=conn.execute("select menupath,bbstype from kingmenu where menuid="&king.data(18,i)&";")
if not rs.eof and not rs.bof then
vmenupath=rs(0)
bbstype=rs(1)
else
king.error("system/error")
end if
rs.close
set rs=nothing
else
vmenupath=datamenu(3,0)
bbstype=1
end if
if cstr(bbstype)="1" then
invalue=invalue&"|topicpath:"&I11II(king.inst&vmenupath&"/"&III11(king.data(10,i))&"/"&king.data(0,i)&king.ext)
'如果找不到文件就生成
if lllll("../"&vmenupath&"/"&III11(king.data(10,i))&"/"&king.data(0,i)&king.ext)=false then
king_sub10_page king.data(0,i),0
end if
else
invalue=invalue&"|topicpath:"&I11II(king.inst&king.path&"/topic.asp?/"&king.data(0,i)&king.ext)
end if
'属性
if cstr(king.data(7,i))="2" then topicattrib=" " else topicattrib=""
if cstr(king.data(7,i))="1" then topicattrib=topicattrib&" "
if cstr(king.data(14,i))="1" then topicattrib=topicattrib&" "
if cstr(king.data(8,i))="1" then topicattrib=topicattrib&" "
if len(king.data(9,i))>0 then
if ll11("jpeg,jpg,gif,png,bmp",lIl(king.data(9,i))) then
topicattrib=topicattrib&""
else
topicattrib=topicattrib&""
end if
end if
'( 1 2 ..5 )
topiclist=lllllI(king.inst&vmenupath&"/"&III11(king.data(10,i))&"/"&king.data(0,i),king.data(6,i),pagenumber,bbstype)'路径,总回贴数,每页显示数(这个需要单独获取:( )
if king.data(2,i)<>"" then
invalue=invalue&"|topictype:["&I11II(htmlencode(king.data(2,i)))&"]"
end if
invalue=invalue&"|topiclist:"&I11II(topiclist)
invalue=invalue&"|topicattrib:"&I11II(topicattrib)
invalue=invalue&"|lastuser:"&I11II(htmlencode(king.data(12,i)))'回复作者
invalue=invalue&"|lastprofile:"&I11II(king.inst&king.path&"/user.asp?username="&server.urlencode(king.data(12,i)))'回复者信息
invalue=invalue&"|lastdate:"&I11II(king.data(13,i))'最后回复
if i mod zebra=0 then
invalue=invalue&"|zebra:0"
else
invalue=invalue&"|zebra:F"
end if
insidehtm=insidehtm&king.createhtm(jshtm,invalue)
if ((i+1) mod king.rn)=0 or i+1=king.count then
thispid=(i+1)/king.rn
if i+1=king.count then thispid=king.pagecount
listhtm=III1("/topiclist.asp?pid=$&rn="&king.rn&"&/"&l1&king.ext,thispid,topicpagecount,menupath)'url参数,pid当前页数,总页数
outhtm=replace(tmphtmlist,intmplist,insidehtm)
metainfo=chr(60)&chr(104)&"ead"&chr(62)&vbcr
metainfo=metainfo&""&vbcr
metainfo=metainfo&""&vbcr
metainfo=metainfo&""
outhtm=llllI(outhtm,metainfo,"("&chr(60)&"h"&"ead).{0,}?\"&chr(62))
outhtm=king.create(outhtm,invalues&"|pagelist:"&I11II(listhtm),0)
if cstr(thispid)="1" then'导航首页
IIII "../"&menupath,"index",outhtm,0
else
if i+1=king.count then
if thispid>int(thispid) then
IIII "../"&menupath,"index"&cstr(int(thispid)+1),outhtm,0
else
IIII "../"&menupath,"index"&cstr(thispid),outhtm,0
end if
else
IIII "../"&menupath,"index"&cstr(thispid),outhtm,0
end if
end if
insidehtm=""
end if
next
end sub
'bbs *** *** www.KingCMS.com *** ***
sub king_bbs()
dim rs,i,j,data,bbspath,info(5,0),sql
dim tmphtm,bbslist,intmplist
dim invalues,invalue,insidehtm,jshtm,outlisthtm,outhtm,listvalue
dim sqlmenu
dim topiccount,allcount
sql="templatebbshome,templatebbshomeinc,bbsname,bbspath,bbslanguage"'4
set rs=conn.execute("select "&sql&" from kingsystem where systemname='KingCMS';")
if not rs.eof and not rs.bof then
info(0,0)=rs(0)'论坛外部模板
info(1,0)=rs(1)'论坛内部模板
info(2,0)=rs(2)'论坛名称
info(3,0)=info(2,0)'论坛关键字
info(4,0)=info(2,0)'论坛说明 descripiton
info(5,0)=rs(3)
if lllll("language/"&rs(4)&".xml") then
king.language=rs(4)
else
king.language=king_lang
end if
end if
rs.close
set rs=nothing
sqlmenu="menuid,menuname,menupath,bbsdesc,bbsmaster,bbslistid,bbslogo,menucount,bbslogo,bbstype"'9 menucount:今日发贴数
tmphtm=king.read(info(0,0),"bbs[home]/"&info(1,0))
bbslist=king.match(tmphtm,"(\{bbslist).{0,}?(\})(.|\n)+?\{\/bbslist\}")'{bbslist}{/bbslist}之间的内容
intmplist=king.match(bbslist,"(\{king:bbs).+?type=\""home"".{0,}?(\})(.|\n)+?\{\/king\}")'{king:bbs type="home"}{/king}之间的内容
jshtm=king.getlabel(intmplist,0)
king.open "select listid,listname from kingbbslist order by listorder;",0,0
for j=0 to king.length
set rs=conn.execute("select "&sqlmenu&" from kingmenu where classid=10 and bbslistid="&king.data(0,j)&" order by bbsorder desc;")
if not rs.eof and not rs.bof then
data=rs.getrows()
else
redim data(0,-1)
end if
rs.close
set rs=nothing
insidehtm=""
for i=0 to ubound(data,2)
topiccount=conn.execute("select count(topicid) from kingtopic where menuid="&data(0,i)&" and topicdel=0;")(0)
allcount=conn.execute("select sum(topicreply) from kingtopic where menuid="&data(0,i)&" and topicdel=0;")(0)+topiccount
set rs=conn.execute("select top 1 topicid,lastpostuser,lastpostdate,bbstitle,sysdate from kingtopic where menuid="&data(0,i)&" and topicdel=0 order by lastpostdate desc;")
if not rs.eof and not rs.bof then
if datediff("d",rs(2),date())=0 then'今日有新帖
invalue="icon:"&I11II("")
else
invalue="icon:"&I11II("")
end if
if ll11("0,1",data(9,i)) then
invalue=invalue&"|bbsname:"&I11II(""&htmlencode(data(1,i))&"")
else
invalue=invalue&"|bbsname:"&I11II(""&htmlencode(data(1,i))&"")
end if
invalue=invalue&"|bbsdescription:"&I11II(data(3,i))
invalue=invalue&"|menuid:"&data(0,i)
invalue=invalue&"|topiccount:"&topiccount
invalue=invalue&"|allcount:"&allcount
invalue=invalue&"|todaycount:"&data(7,i)
invalue=invalue&"|lastdate:"&I11II(rs(2))
invalue=invalue&"|lastuser:"&I11II(""&htmlencode(rs(1))&"")
invalue=invalue&"|masters:"&I11II(data(4,i))
if len(data(8,i))>0 then
invalue=invalue&"|bbslogo:"&I11II("")
end if
invalue=invalue&"|topictitle:"&I11II(htmlencode(rs(3)))
if ll11("0,1",data(9,i)) then
invalue=invalue&"|topicpath:"&I11II(king.inst&data(2,i)&"/"&III11(rs(4))&"/"&rs(0)&king.ext)
else
invalue=invalue&"|topicpath:"&I11II(king.inst&king.path&"/topic.asp?/"&rs(0)&king.ext)
end if
else
invalue="icon:"&I11II("")
if ll11("0,1",data(9,i)) then
invalue=invalue&"|bbsname:"&I11II(""&htmlencode(data(1,i))&"")
else
invalue=invalue&"|bbsname:"&I11II(""&htmlencode(data(1,i))&"")
end if
invalue=invalue&"|bbsdescription:"&I11II(data(3,i))
invalue=invalue&"|topiccount:0"
invalue=invalue&"|allcount:0"
invalue=invalue&"|todaycount:0"
invalue=invalue&"|lastdate:--"
invalue=invalue&"|lastuser:--"
invalue=invalue&"|masters:"&I11II(data(4,i))
if len(data(8,i))>0 then
invalue=invalue&"|bbslogo:"&I11II("")
end if
invalue=invalue&"|topictitle:--"
invalue=invalue&"|topicpath:#"
end if
insidehtm=insidehtm&king.createhtm(jshtm,invalue)
rs.close
set rs=nothing
next
listvalue=replace(bbslist,intmplist,insidehtm)
outlisthtm=outlisthtm&king.create(listvalue,"listname:"&I11II(king.data(1,j)),0)'替换charset值
next
outhtm=replace(tmphtm,bbslist,outlisthtm)
invalues="title:"&I11II(htmlencode(info(2,0)))
invalues=invalues&"|guide:"&I11II(""&king.lang("common/home")&" >> "&htmlencode(info(2,0)))
invalues=invalues&"|keyword:"&I11II(king.cls(info(3,0)))
invalues=invalues&"|description:"&I11II(king.cls(info(4,0)))
outhtm=king.create(outhtm,invalues,0)
outhtm=king.clsre(outhtm,"\{[/]{0,}?bbslist.{0,}?\}")
dim metainfo:metainfo=chr(60)&chr(104)&"ead"&chr(62)&vbcr
metainfo=metainfo&""&vbcr
metainfo=metainfo&""&vbcr
metainfo=metainfo&""
outhtm=llllI(outhtm,metainfo,"("&chr(60)&"h"&"ead).{0,}?\"&chr(62))
bbspath=left(info(5,0),instrrev(info(5,0),"/"))
Ill "../"&bbspath
I11 "../"&info(5,0),outhtm '创建文件
end sub
'ad *** *** www.KingCMS.com *** ***
sub king_ad(l1)
dim i
dim sql:if trim(l1)="" then exit sub
if cstr(l1)="0" then'全部生成
sql="select adfile,adtext from kingad where adtype=1;"
else
sql="select adfile,adtext from kingad where adtype=1 and adid in("&l1&");"
end if
Ill "../"&king.path&"/"&king_ads
king.open sql,"",0
for i=0 to king.length
I11 "../"&king.path&"/"&king_ads&"/"&king.data(0,i),king.data(1,i)
next
end sub
'collarticle *** *** www.KingCMS.com *** ***
sub king_collarticle()
on error resume next'必须打开错误忽略.
dim cofile,i,j,k,rs,data,datacoll,urlpath,gohtm,sql,urlid,artid,irs,url
dim arttitle,artauthor,artfrom,artcontent,artguide,artplist'采集成功失败
dim allurl,urls,urlcls,isurl,tags,plists,arrplist,plistcontent
dim fso,dbfile,dbname,dbext,dbname_num,cofile1
dim iscoll:iscoll=false
cofile=l1ll("coll",0)
url=l1ll("url",0)
if len(url)>0 then
if II11(url,5)=false then out"采集失败,URL格式不正确"&vbcr&url
end if
'urlcls 过滤网址
king.topen "db#collect/"&cofile
set rs=tconn.execute("select iscoll,urlinclude,iscollurl,starturl,urlcls from kingcoll;")
if not rs.eof and not rs.bof then
datacoll=rs.getrows()
else
exit sub
end if
rs.close
set rs=nothing
'后增加的,如果采集文件大小太大,就进行分库操作
set fso=server.createobject(king_fso)
set dbfile=fso.getfile(server.mappath("db#collect/"&cofile))
if dbfile.size>king_collsize*1024*1024 then'如果大于500mb,就下一个
dbext=lIl(cofile)'文件扩展名
dbname=lllI(cofile)'文件名
if instr(dbname,"_")>0 then
dbname_num=cdbl(split(dbname,"_")(1))+1
dbname=split(dbname,"_")(0)
cofile1=dbname&"_"&dbname_num&"."&dbext
else
cofile1=dbname&"_1."&dbext
end if
if lllll("db#collect/"&cofile1) then'如果新数据库文件存在
king.tclose
king.topen "db#collect/"&cofile1
conn.execute "update kingcoll set iscoll=1;"
ll "coll="&server.urlencode(cofile1),""
else
tconn.execute "update kingcoll set iscoll=0;"
king.copyfile "db#collect/"&cofile,"db#collect/"&cofile1'拷贝文件
king.tclose'关闭当前数据连接
king.topen "db#collect/"&cofile1'创建新的数据库连接
tconn.execute "update kingcoll set iscoll=1;"
tconn.execute "delete from kingart;"'删除所有的文章数据
king.tclose'再次关闭
king.press "db#collect/"&cofile1'压缩当前数据
ll "coll="&server.urlencode(cofile1),""
end if
end if
if cstr(datacoll(0,0))="0" and len(url)=0 then exit sub'停止采集
if len(url)>0 then
urlpath=url
urlid=0
else
set rs=tconn.execute("select top 1 urlid,urlpath from kingurl where iscoll=0;")
if not rs.eof and not rs.bof then
urlpath=rs(1)
urlid=rs(0)
'采集准备
if len(url)=0 then
tconn.execute "update kingurl set iscoll=2 where urlid="&urlid&";"
end if
else
urlpath=datacoll(3,0)'首页主要是获得url列表.
urlid=0
if tconn.execute("select count(urlid) from kingurl;")(0)>0 then'如果已经有采集项目,也就是说采集完成后自动停止
if len(url)>0 then
else
exit sub
end if
else'没有采集项目,也就是第一次采集
tconn.execute "insert into kingurl (urlpath,iscoll) values ('"&lll1(urlpath)&"',2);"
end if
end if
rs.close
set rs=nothing
end if
gohtm=king.gethtm(lIllIl(urlpath),4)
if len(gohtm)>0 then
else
ll "coll="&server.urlencode(cofile1),""
end if
sql="rulename,ruletitle1,ruletitle2,ruletitlecls,ruleauthor1,ruleauthor2,ruleauthorcls,rulefrom1,rulefrom2,rulefromcls,"'9
sql=sql&"rulecontent1,rulecontent2,rulecontentcls,ruleguide1,ruleguide2,ruleguidecls,ruleplist1,ruleplist2,ruleplistcls,"'18
sql=sql&"artfrom,artauthor,iscollimg,rulecls"'22
set rs=tconn.execute("select "&sql&" from kingrule;")
if not rs.eof and not rs.bof then
data=rs.getrows()
else
exit sub
end if
rs.close
set rs=nothing
for i=0 to ubound(data,2)
if instr(lcase(gohtm),lcase(data(1,i)))>0 and instr(lcase(gohtm),lcase(data(2,i)))>0 and instr(lcase(gohtm),lcase(data(10,i)))>0 and instr(lcase(gohtm),lcase(data(11,i)))>0 then'必须要包含标题和内容过滤中的内容
'截取 标题 和 内容
arttitle=left(king.cls(king.sect(gohtm,data(1,i),data(2,i),data(3,i))),100)
artcontent=king.sect(gohtm,data(10,i),data(11,i),data(12,i))
if len(arttitle)>0 and len(artcontent)>60 then'分离成功,跳出循环
'作者
if len(data(20,i))>0 then'如果预设的作者有值,就不采集
artauthor=data(20,i)
else
artauthor=left(king.cls(king.sect(gohtm,data(4,i),data(5,i),data(6,i))),30)
end if
if len(artauthor)=0 then artauthor="不详"
'来源
if len(data(19,i))>0 then
artfrom=data(19,i)
else
artfrom=left(king.cls(king.sect(gohtm,data(7,i),data(8,i),data(9,i))),50)
end if
'分类
artguide=king.sect(gohtm,data(13,i),data(14,i),data(15,i)&chr(13)&chr(10)&arttitle&chr(13)&chr(10)&"(<(.|\n)+?>)")
if len(artguide)>0 then artguide=replace(artguide,",","")
artguide=king.cls(artguide)
if len(artguide)=0 then artguide="A"
'分页
artplist=king.sect(gohtm,data(16,i),data(17,i),data(18,i))
if len(artplist)>0 then'如果分页有值,格式化URL路径,并获得URL值,采集内容部分
artplist=king.formaturl(artplist,urlpath)
plists=king_upurl(artplist,urlpath)
arrplist=split(plists,"||")
for j=0 to ubound(arrplist)
if lcase(arrplist(j))<>lcase(urlpath) then
plistcontent=king.gethtm(arrplist(j),4)
if len(plistcontent)>10 then
artcontent=artcontent&king_break&king.sect(plistcontent,data(10,i),data(11,i),data(12,i))
end if
tconn.execute "insert into kingurl (urlpath,iscoll) values ('"&lll1(arrplist(j))&"',1);"
end if
next
end if
'过滤标签
tags=split(data(22,i),",")
for j=0 to ubound(tags)
artcontent=king.clsre(artcontent,"(\<"&tags(j)&"(.|\n){0,}?\>|\<\/"&tags(j)&"\>)")
next
'先格式化地址
artcontent=king.formaturl(artcontent,urlpath)
'以XHTML标准格式化内容
artcontent=king.xhtmlencode(artcontent)
'预览
if len(url)>0 then out "规则:"&data(0,i)&vbcr&"标题:"&arttitle&vbcr&"作者:"&artauthor&vbcr&"来源:"&artfrom&vbcr&"导航: "&artguide&vbcr&"内容:"&vbcr&artcontent
'下载图片
if cstr(data(21,i))="1" then artcontent=king.snap(artcontent)
'录入数据
tconn.execute "insert into kingart (artguide,arttitle,artauthor,artfrom,artcontent,sysdate) values ('"&lll1(artguide)&"','"&lll1(arttitle)&"','"&lll1(artauthor)&"','"&lll1(artfrom)&"','"&lll1(artcontent)&"','"&tnow&"');"
tconn.execute "update kingurl set iscoll=1 where urlpath='"&urlpath&"';"
iscoll=true
exit for'录入成功的话,当然退出for循环了
end if
end if
next
if len(url)>0 then
out "不符合目前的所有采集规则或有重复项目,请创建新的规则"
end if
if cstr(datacoll(2,0))="1" and iscoll=false then'不符合规则的时候自动收集url
if len(artplist)>0 then gohtm=replace(gohtm,artplist,"")'注释掉分页部分
allurl=king_upurl(gohtm,urlpath)'获得url页面中的所有列表
urls=split(allurl,"||")'格式化url,获得地址,并插入到kingurl
if len(datacoll(4,0))>0 then urlcls=split(datacoll(4,0),vbcrlf)
for i=0 to ubound(urls)
'判断是否包含指定的url地址和是否属于黑名单
if instr(lcase(urls(i)),datacoll(1,0))>0 then
'黑名单
isurl=true
if len(datacoll(4,0))>0 then
for j=0 to ubound(urlcls)
if len(trim(lcase(urlcls(j))))>0 then
if instr(lcase(urls(i)),trim(lcase(urlcls(j))))>0 then isurl=false
end if
next
end if
if isurl then tconn.execute "insert into kingurl (urlpath) values ('"&lll1(urls(i))&"');"
end if
next
end if
tconn.execute "update kingcoll set lastdate='"&tnow&"';"
king.tclose
if err.number<>0 then err.clear
ll "coll="&server.urlencode(cofile),""
end sub
'upurl *** *** www.KingCMS.com *** ***
function king_upurl(l1,l2)'内容 url
dim objregex,l4,i,l5,l7
dim I1,I2,I3,I4
I1=replace(l1,chr(13),"")
I1=replace(I1,chr(10),"")
I1=replace(I1,chr(9),"")
I1=king.formaturl(I1,l2)
if len(I1)>0 then
set objregex=new regexp
objregex.ignorecase=true
objregex.global=true
objregex.pattern="()"
set I2=objregex.execute(I1)
for each I3 in I2
l5=king.match(I3.value,"(http|https|ftp):(\/\/|\\\\)(([\w\/\\\+\-~`@:%])+\.)+([\w\/\\\.\=\?\+\-~`@\':!%#]|(&)|&)+"&king_collext)
if instr(l5,"#")>0 then l5=left(l5,instr(l5,"#")-1)
if len(l4)>2 then'第一个项目
l7=true
I4=split(l4,"||")
for i=0 to ubound(I4)
if lcase(I4(i))=lcase(l5) then
l7=false
end if
next
if l7 then l4=l4&"||"&l5
else
l4=l5
end if
' response.write l5&" "
next
set I2=nothing
set objregex=nothing
end if
king_upurl=l4
end function
%>
<%
' Edit: Sin.CS
' Date: 2006-4-4
' Memo: 此文件为系统核心文件,不要随便修改.
' Memo: 当然,你若真的看明白了这个代码,你就可以跟我联系
' Memo: 共同开发国际领先的KingCMS系统,我们要走的路还很长
'kingcms *** *** www.KingCMS.com *** ***
dim king_ver:king_ver="Beta"
class kingcms
public id,ip,name,theme,language,editorname,adminkey,level,input,fontsize,mode'管理员
public lastdate'前台会员的最后一次访问时间,因为读写次数太多,单独列出来
public sitename,named,systemname,version,ext,xml,page,template,path,inst,dbver,bbsname,bbspath,siteurl,systempath'系统属性 path:前台系统安装路径,inst系统所在的目录
private sitedescription,sitebottominfo,sitelink'系统属性
private cookiesname,cookiespass,odoc,oBox'对象及参数,oBox:inc/language.xml
public tdiff,checkerr,pop,admincheck'验证错误,提示,管理员验证
public pid,rn,code'页数,每页显示数,编码
public data,length,plist,count,pagecount'link:分页的连接,如果不定义这个就不运行
public js'动态标签数组
public ispath'是否为后台,后台true,前台false。
public isdb'数据库类型 1:mssql 0:access
private grades'级别数组
public vip'是否为vip用户
public badlanguage,lockip
private switch,carry'贯通样式
public thisurl'当前url,如:http://www.kingcms.com
private sub class_initialize()
dim scriptname'获得目录
scriptname=request.servervariables("script_name")
page=replace(scriptname,"\","/")
page=lcase(right(page,len(page)-instrrev(page,"/")))
systempath=left(scriptname,len(scriptname)-len(page)-1)
systempath=right(systempath,len(systempath)-instrrev(systempath,"/"))
'验证数据库连接
on error resume next
set conn=server.createobject("adodb.connection")
conn.open objconn
if err.number<>0 then
Il"Can not find database! [Install] [Help]"
response.end()
end if
err.clear
tdiff=timer()
redim outer(-1,2)'外部模板,此为二维数组
redim inside(-1,1)'内部模板,
redim js(8,-1)'动态标签
'初始化系统信息,必须有数据库的情况下才可以
dim rs,idata,port,sql
sql="sitename,siteurl,sitebottominfo,sitelink,systemver,siteextname,xmlsetting,sitetemplate"'7
sql=sql&",systempath,systemnamed,dbversion,bbsname,badlanguage,lockip,switch,bbspath"'15
set rs=conn.execute("select "&sql&" from kingsystem where systemname='KingCMS';")
if not rs.eof and not rs.bof then
idata=rs.getrows()
sitename=idata(0,0)
systemname="KingCMS"
siteurl=idata(1,0)
sitebottominfo=idata(2,0)
sitelink=idata(3,0)
bbsname=idata(11,0)
bbspath=idata(15,0)
version=idata(4,0)&chr(32)&king_ver
ext=idata(5,0)'扩展名
xml=idata(6,0)'0:默认 1:输出xml文件
template=idata(7,0)'系统采用的模板
path=idata(8,0)'前台文件夹目录
named=idata(9,0)
dbver=idata(10,0)
inst=scriptname
inst=left(inst,len(inst)-(len(page)+1))
inst=left(inst,instrrev(inst,"/"))
badlanguage=idata(12,0)
lockip=idata(13,0)
switch=idata(14,0)
ip=request.servervariables("http_x_forwarded_for")
if ip="" then ip=request.servervariables("remote_addr")
port=request.servervariables("server_port")
if cstr(port)="80" then port="" else port=":"&port
thisurl=l11(siteurl,"://","/")
if len(thisurl)>0 then
thisurl="http://"&thisurl&port
else
thisurl=siteurl&port
end if
if lllll("templates/"&template)=false and page<>"template.asp" then response.redirect "template.asp?alert=setemplate"
else
Il l1l(0)
end if
set rs=nothing
'给Err赋值
checkerr=true'如果变成了false,就无法打开save
pop=0
admincheck=false'关闭状态,如果通过认证过程就为true
if lcase(systempath)=lcase(path) then
ispath=false
else
ispath=true
end if
isdb=instr(objconn,"provider=SQLOLEDB.1;")
end sub
'dirty *** *** www.KingCMS.com *** ***
public function dirty(l1)
dim bads,I1,I2,i
I1=l1
if len(l1)>0 then
if len(badlanguage)>0 then
bads=split(badlanguage,",")
set I2=new regexp
I2.global=true
I2.ignorecase=true
for i=0 to ubound(bads)
I2.pattern="("&bads(i)&")"
I1=I2.replace(I1,string(len(bads(i)),42))
next
dirty=I1
set I2=nothing
end if
end if
end function
'cn2en *** *** www.KingCMS.com *** ***
public function cn2en(l1)
dim I1,I2,l2,l3,l4,i,rs
on error resume next
set I2=server.createobject("adodb.connection")
I2.open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source="&server.mappath("inc/pinyin.asp")
if err.number<>0 then king.error("system/error")
l4=true
for i=1 to len(l1)
l3=l4
l2=mid(l1,i,1)
if len(trim(l2))=1 then'长度为1
set rs=I2.execute("select top 1 pinyin from kingpy where content like '%"&lll1(l2)&"%';")
if not rs.eof and not rs.bof then'中文
l2=rs(0)
l4=true'当前为中文,即true
else
'英文
l4=false'当前为英文,false
end if
rs.close
set rs=nothing
else
l2=" "'换行替换为空格
end if
if l3=l4 then' l2=l2&" "
I1=I1&l2
else
I1=I1&" "&l2
end if
next
I2.close
set.I2=nothing
cn2en=trim(I1)
end function
'getpath *** *** www.KingCMS.com *** ***
public function getpath(l1)
dim I1
select case cstr(king_pathtype)
case"0" I1=king.geteng(king.cn2en(l1))
case"1" I1=king.geteng(l1)
case"2" I1=right(year(tnow),2)&month(tnow)&day(tnow)&replace(cstr(timer()),".","")
case else king.error("system/error/config|name:king_pathtype")
end select
if len(I1)>0 then
getpath=I1
else
getpath=right(year(tnow),2)&month(tnow)&day(tnow)&replace(cstr(timer()),".","")
end if
end function
'geteng *** *** www.KingCMS.com *** ***
public function geteng(l1)'获得英文标题
dim I1,I2,I3,I7
set I7=new regexp
I7.ignorecase=true
I7.global=true
I7.pattern="[a-zA-Z0-9\- ]"
set I2=I7.execute(l1)
for each I3 in I2
I1=I1&I3.value
next
set I2=nothing
set I7=nothing
I1=trim(I1)
if len(I1)>0 then I1=replace(I1," ","-")
while (instr(I1,"--")>0)
I1=replace(I1,"--","-")
wend
geteng=I1
end function
'clsre *** *** www.KingCMS.com *** ***
public function clsre(l1,l2)'内容,正则
on error resume next
dim l3,objregex
if len(l1)>0 then
l3=l1
set objregex=New regexp
objregex.IgnoreCase=True
objregex.Global=True
objregex.pattern=l2
clsre=objregex.replace(l3,"")
set objregex=nothing
end if
if err.number<>0 then err.clear
end function
'grade *** *** www.KingCMS.com *** ***
public function grade(l1,l2,l3)'l1:级别 l2:积分 l3:输出类型(0,名称;1,图片;2,可上传文件数)
dim rs,i
if isarray(grades)=false then
set rs=conn.execute("select levelid,levelname,usermark,upfilenum from kinglevel order by usermark desc")'3
if not rs.eof and not rs.bof then
grades=rs.getrows()
end if
set rs=nothing
end if
select case cstr(l1)'0普通会员 1版主 2超级版主
case"0"
for i=0 to ubound(grades,2)'100 400 800 1600 234fen
if l2>grades(2,i) then
select case cstr(l3)
case"0" : grade=grades(1,i)
case"1" : grade=""
case"2" : grade=grades(3,i)
end select
exit function
end if
next
case"1"
select case cstr(l3)
case"0" : grade=lang("user/class/master")
case"1" : grade=""
case"2" : grade=9999
end select
case"2"
select case cstr(l3)
case"0" : grade=lang("user/class/super")
case"1" : grade=""
case"2" : grade=9999
end select
end select
end function
'head *** *** www.KingCMS.com *** ***
public sub head(l1,l2)'登陆验证,如果验证通过,就调用头(l1:级别 l2:标题)
if cstr(l1)<>"" then
dim rs,sql,i,chrs:chrs=split(king_chr,",")
'后台验证及参数
if ispath then
'如果,l2=0 则为ajax调用框
'设置管理员的信息
cookiesname=lll1(request.cookies("admin"&king_key)("name"))
cookiespass=lll1(request.cookies("admin"&king_key)("pass"))
if II11(cookiespass,3)=false then response.redirect "login.asp"
for i=0 to ubound(chrs)
if instr(cookiesname,chr(chrs(i)))>0 then response.redirect "login.asp"
next
set rs=conn.execute("select adminid,admintheme,adminlanguage,admineditor,adminlevel,adminkey,admininput,adminpass,adminfontsize,adminmode from kingadmin where onoff=0 and adminlock<=7 and adminname='"&cookiesname&"';")'10
if not rs.eof and not rs.bof then
level=rs(4)
id=rs(0)
name=cookiesname
theme=rs(1)
language=rs(2)
editorname=rs(3)
adminkey=rs(5)
input=rs(6)
fontsize=rs(8)
if cstr(rs(9))="1" then mode=true else mode=false
if ll11("0,1",l1ll("mode",2)) then
if l1ll("mode",2)="1" then mode=true else mode=false
end if
dim adminpass:adminpass=rs(7)
if md5(adminkey&left(adminpass,4)&king_salt,1)<>cookiespass then response.redirect "login.asp"
else
'转到登录页面
response.redirect "login.asp"
end if
set rs=nothing
'验证
if ll11(level,l1) or level="admin" then
if isdb=1 then
sql="select count(logid) from kinglog where adminid="&id&" and getdate()-logdate<0.25;"
else
sql="select count(logid) from kinglog where adminid="&id&" and now()-logdate<0.25;"
end if
if conn.execute(sql)(0)=0 then
conn.execute "update kingadmin set admincount=admincount+1,admindate='"&tnow&"' where adminname='"&name&"';"
call log("login/cookies")
end if
admincheck=true
else
error("login/level")
end if
if cstr(l2)<>"" then
l1ll1 l2
if cstr(l2)="0" then
carry=false'微缩样式
else
carry=true'标准样式
end if
end if
'前台验证
else
if II11(ip,10)=false and page<>"count.asp" then error("system/error")
if switch=1 then
if ll11("count.asp",page) or lcase(page&"?"&request.servervariables("query_string"))<>"user.asp?action=nav" then
error("login/switch")
end if
end if
vip=0:name="Guest":id=0
if len(lockip)>0 then
dim lockips:lockips=split(lockip,",")
for i=0 to ubound(lockips)
if left(cstr(ip),len(cstr(lockips(i))))=lockips(i) and trim(lockips(i))<>"" then
if ll11("user.asp,count.asp",page)=false then
error("login/lockip")
end if
end if
next
end if
cookiesname=lll1(request.cookies("user"&king_key)("name"))
cookiespass=lll1(request.cookies("user"&king_key)("pass"))
for i=0 to ubound(chrs)
if instr(cookiesname,chr(chrs(i)))>0 then response.redirect "login.asp"
next
if II11(cookiespass,3) then'会员参数设置
set rs=conn.execute("select userid,userclass,userlanguage,isvip,userpass,userkey,lastdate,useractivate from kinguser where userdel=0 and userlock=0 and username='"&cookiesname&"';")'7
if not rs.eof and not rs.bof then
if md5(rs(5)&left(rs(4),4)&king_salt,1)=cookiespass then
name=cookiesname
id=rs(0)
level=rs(1)
language=rs(2)
vip=rs(3)
adminkey=rs(5)
lastdate=rs(6)
if cstr(rs(7))<>"ok" then
if ll11("login.asp",page) then
if ll11("activate,youactivate",request("action"))=false then
response.redirect "login.asp?action=activate"'需要输入激活码
end if
elseif ll11("user.asp",page) then
if ll11("nav",request("action"))=false then
response.redirect "login.asp?action=activate"
end if
else
if ll11("count.asp",page)=false then
response.redirect "login.asp?action=activate"
end if
end if
end if
end if
end if
set rs=nothing
end if
end if
end if
'公共参数
pid=l1ll("pid",2):if cstr(pid)="" then pid=1
rn=l1ll("rn",2):if cstr(rn)="" or cstr(rn)="0" then rn=20
if cdbl(rn)>cdbl(king_maxrn) then rn=king_maxrn
code=l1ll("code",0):if cstr(code)="" then code=llll("code"):if code="" then code="utf-8"
if ll11(king_code,code)=false then call error("system/error")
if len(language)=0 then language=l1ll("language",0)
if len(language)=0 then language=king_lang
end sub
'bound *** *** www.KingCMS.com *** ***
public sub bound()
dim rs
if king.id>0 then
set rs=conn.execute("select lastpostdate from kinguser where userid="&king.id&" and usermark>="&mark_sub&" and userprestige>"&prestige_sub&" and userdel=0 and userlock=0;")
if not rs.eof and not rs.bof then
if datediff("s",rs("lastpostdate"),tnow)(king:title size=""30""/)"
end if
else
l3=king.match(l1,"\{king\:.+?\}")
I1=l11(l3,l2&"=""","""")
end if
if len(I1)=0 then
select case cstr(l2)
case"number" I1="20"
case"width" I1="120"
case"height" I1="90"
case"zebra" I1="1"
end select
end if
getlabel=I1
end function
'getlist *** *** www.KingCMS.com *** ***
public function getlist(l1,l3,l4)
dim l5,l2
l2=king.match(l1,"(\{king:"&l3&").+?type=\""list\"".{0,}?(\})(.|\n)+?\{\/king\}")
if cstr(l4)="0" then
l5=l11(l2,"(\})","(\{\/king\})")
if len(l5)=0 then l5="
"
elseif cstr(l4)="1" then
l5=l2
else
l5=getlabel(l2,l4)
end if
getlist=l5
end function
'range *** *** www.KingCMS.com *** ***
public sub range(l1,l2)
select case cstr(l1)
case"0"
case"1" : if cstr(id)="0" then error("system/error/range")
case"2" : if ll11(l2,name)=false then error("system/error/range")
case"3" : if ll11(l2,name)=false and cstr(level)<>"2" then error("system/error/range")
case"4" : if cstr(vip)="0" then error("system/error/range")
case"5" : if cstr(level)<>"2" then error("system/error/range")
end select
end sub
'date *** *** www.KingCMS.com *** ***
public function date(l1)
dim l2,l3
if isdate(l1) then
l2=month(l1):if len(l2)=1 then l2=string(1,48)&l2
l3=day(l1):if len(l3)=1 then l3=string(1,48)&l3
date=year(l1)&string(1,45)&l2&string(1,45)&l3
end if
end function
'editor *** *** www.KingCMS.com *** ***
public sub editor(l1,l2)
Il"
"
select case lcase(editorname)
case"fckeditor"
dim ofckeditor
set ofckeditor=new fckeditor
if ll11(llll("submits"),lang("editor/full")&"[F]") then
' out page
if ll11(page,"sub2.asp") then
ofckeditor.toolbarset="Article1"
else
ofckeditor.toolbarset="Default"
end if
elseif ll11(llll("submits"),lang("editor/base")&"[F]") then
if ll11(page,"sub2.asp") then
ofckeditor.toolbarset="Article2"
else
ofckeditor.toolbarset="Basic"
end if
else
if ll11(page,"sub2.asp") then
ofckeditor.toolbarset="Article2"
else
ofckeditor.toolbarset="Basic"
end if
end if
ofckeditor.value =l2
ofckeditor.create l1
set ofckeditor=nothing
case"ewebeditor"
Il""
Il""
case else'包括html
Il""
end select
Il"
"
end sub
'end *** *** www.KingCMS.com *** ***
private sub class_terminate()
on error resume next
if len(l1ll("alert",1))>0 then Il alert(l1ll("alert",1))
if admincheck then l1lll
set odoc=nothing
set upload=nothing
if err.number<>0 then err.clear
end sub
'read *** *** www.KingCMS.com *** ***
public function read(l1,l2)'读取模板 l1:外部 l2:内部
dim l3,l4,l7,l8,l9
l7="templates/"&template&"/"&l1
if lllll(l7)=false then l7="templates/"&template&"/default.htm"
l8=l1l1(l7)'读取waibu模板内容
l8=lIllI(l8)'格式化图片,js文件及style样式文件的路径
l3="templates/"&template&"/inside/"&l2'读取内部模板
if lllll(l3)=false then l3="templates/"&template&"/inside/"&split(l2,"/")(0)&"/default.htm"
l4=l1l1(l3)
if cstr(l2)="" then
l9=l8
else
l9=llllI(l8,l4,"(\{king:)(include|inside) {0,}?(\/\})")
end if
read=l9
end function
'lIllI *** *** www.KingCMS.com *** ***
private function lIllI(l1)
'修改图片,style,js文件的路径
dim objregex,I1,I2,I3
I1=l1
set objregex=new regexp
objregex.pattern="(<(script|link|img|input|embed|param|object|base|area|map|table).+?(src|href|background)=.+?)(images\/.{0,}?\>)"
objregex.ignorecase=true
objregex.global=true
I1=objregex.replace(I1,"$1"&inst&path&"/$4")
set objregex=nothing
lIllI=I1
end function
'II111 *** *** www.KingCMS.com *** ***
private function II111(l1)
dim adname,rs,jshtm
adname=l11(l1,"name=""","""")
set rs=conn.execute("select adtype,adfile,adwidth,adheight,adtext from kingad where adname='"&lll1(adname)&"';")
if not rs.eof and not rs.bof then
select case cstr(rs(0))
case"1"
II111=lllII(rs(0),rs(1),rs(2),rs(3),adname)
case"0"
II111=rs(4)
case"2"
asp=""
on error resume next
execute rs(4)
jshtm=getlabel(l1,0)
if cstr(jshtm)<>"" then
execute jshtm
end if
if err.number<>0 then asp=lang("ad/tip/asperror|name:"&I11II(adname)&";source:"&I11II(err.source)&";description:"&I11II(err.description))
II111=asp
asp=""
end select
else
II111=king.lang("ad/tip/not|name:"&I11II(adname))'"广告位招
end if
set rs=nothing
end function
'lllII *** *** www.KingCMS.com *** ***
private function lllII(l1,l2,l3,l4,l5)
if lIl(l2)="js" then'
lllII=""
else
lllII=""
end if
end function
'guide *** *** www.KingCMS.com *** ***
public function guide(l1)
dim rs,menupath
if l1>0 then
set rs=conn.execute("select menuid1,menuname,menupath,classid,bbstype from kingmenu where menuid="&l1&";")'4
if not rs.eof and not rs.bof then
select case cstr(rs(3))
case"0":menupath=rs(2)
case"1":menupath=inst&rs(2)
case"10"
if ll11("0,1",rs(4)) then
'out rs(4)&"|"&l1
menupath=inst&rs(2)&"/index"&ext
else
menupath=inst&path&"/topiclist.asp?/"&l1&ext
end if
case else menupath=inst&rs(2)&"/index"&ext
end select
guide=guide(rs(0))&" "&htmlencode(rs(1))&" >> "
end if
set rs=nothing
else
guide=""&htmlencode(sitename)&""&" >> "&guide
end if
end function
'sect *** *** www.KingCMS.com *** ***
public function sect(l1,l2,l3,l4)'内容 开始 结束 清理
dim l5,l6,I1
if len(l2)>0 and len(l3)>0 then
l5=instr(lcase(l1),lcase(l2))
if l5=0 then exit function
l6=instr(lcase(right(l1,len(l1)-l5-len(l2)+1)),lcase(l3))
if l5>0 and l6>0 then
I1=trim(mid(l1,l5+len(l2),l6-1))
end if
if len(I1)>0 then
sect=clshtml(I1,l4)
end if
else
exit function
end if
end function
'clshtml *** *** www.KingCMS.com *** ***
public function clshtml(l1,l2)
dim I2,i,I1,l3
I1=l1
I2=split(l2,chr(13)&chr(10))
for i=0 to ubound(I2)
l3=trim(I2(i))
if len(l3)>0 then
if left(l3,1)="(" and right(l3,1)=")" then'正则表达式过滤
I1=king.clsre(I1,l3)
else
I1=replace(I1,l3,"")
end if
end if
next
clshtml=I1'king.xhtmlencode(I1)
end function
'create *** *** www.KingCMS.com *** ***
public function create(l1,l2,l3)
dim I1,I2,I3,I4,I6,I7:I1=l1
if king_out=1 then l3=1
set I7=new regexp
I7.ignorecase=true
I7.global=true
I7.pattern="(\{king:).+?(\/\})|(\{king:).+?(\})(.|\n)+?(\{\/king\})"
set I2=I7.execute(I1)
for each I3 in I2
I1=replace(I1,I3.value,lIll(I3.value,l2,l3))
next
set I2=nothing
set I7=nothing
create=I1
end function
'createhtm *** *** www.KingCMS.com *** ***
public function createhtm(l1,l2)
dim I1,I2,I3,I4,I6,I7
I1=l1
set I7=new regexp
I7.pattern="(\(king:).+?(\/\))"
I7.ignorecase=true
I7.global=true
set I2=I7.execute(I1)
for each I3 in I2
I1=replace(I1,I3.value,lIll(I3.value,l2,1))
next
set I2=nothing
set I7=nothing
createhtm=I1
end function
'lIll *** *** www.KingCMS.com *** ***
private function lIll(l1,l2,l3)
dim I1,I2,I3,I4
I3=l1
I3=replace(I3,""",""""):I3=replace(I3," "," ")
I3=replace(I3,">",">"):I3=replace(I3,"<","<")
I4=replace(I3," ","/"):I4=replace(I4,"}","/")
I4=replace(I4,")","/"):I2=lcase(l11(I4,"king:","/"))
select case I2
case"sitename","sitetitle" I1=sitename
case"siteurl","url" I1=siteurl
case"bottom","sitebottom","bottominfo" I1=""&sitebottominfo&""
case"sitelogo","logo" I1=""
case"cms" I1="Powered By: KingCMS "&version&""
case"count","counter"
if request.servervariables("query_string")="action=vote" then
I1=""
else
I1=""
case"info" I1=I1III(I3)
case"link" I1=lIIIll(I3)
case"now" I1=tnow
case"sitemap","sitemaps" I1=king__menu(0,0)'llIIIl()
case"prepage","prepagetitle","prepagepath" I1=lllIll(I2,l2)'上一篇
case"nextpage","nextpagetitle","nextpagepath" I1=lllIll(I2,l2)'下一篇
case"asp" I1=lllIIl(I3)'自定义标签,直接在模板里插入asp
case else
I1=I1I1I(I3,l2,I2)
end select
lIll=I1
end function
'lllIIl *** *** www.KingCMS.com *** ***
private function lllIIl(l1)
dim jsasp:jsasp=getlabel(l1,0)'获得代码
asp=""
on error resume next
execute jsasp
if err.number<>0 then asp=lang("asp/error|name:"&I11II(adname)&";source:"&I11II(err.source)&";description:"&I11II(err.description))
lllIIl=asp
asp=""
end function
'I1III *** *** www.KingCMS.com *** ***
private function I1III(l1)'获取信息
dim jshtm,I1,I2(20),invalue'I2为数组
dim rs,data,sql
dim today,yest,cumonth,ultimo
dim maxip,maxpv,onlinetime
jshtm=getlabel(l1,0)
sql="commentisopen,ipall,pvall,countstart"'3
today=year(tnow)&"-"&month(tnow)&"-"&day(tnow)
yest=dateadd("d",-1,today):yest=year(yest)&"-"&month(yest)&"-"&day(yest)
cumonth=year(tnow)&"-"&month(tnow)
ultimo=dateadd("M",-1,today):ultimo=year(ultimo)&"-"&month(ultimo)
set rs=conn.execute("select "&sql&" from kingsystem where systemname='KingCMS';")
data=rs.getrows()
rs.close
set rs=nothing
I2(0)=conn.execute("select count(*) from kingmenu;")(0)'menucount
I2(1)=conn.execute("select count(*) from kingart where artshow=1;")(0)'artcount
I2(2)=conn.execute("select count(*) from kingtopic where topicdel=0;")(0)'topiccount
I2(3)=conn.execute("select count(*) from kingboard where boarddel=0;")(0)'boardcount
I2(4)=conn.execute("select count(*) from kinguser where userdel=0;")(0)'usercount
I2(5)=conn.execute("select count(*) from kinglink where linkshow=1;")(0)'linkcount
I2(6)=conn.execute("select count(*) from kingrefer;")(0)'refer
if data(0,0) then'评论关闭状态
I2(7)=0
else
I2(7)=conn.execute("select count(*) from kingcomment where iscomment=0;")(0)'评论数
end if
I2(8)=conn.execute("select count(*) from kingtopic where topicdel=0 and topicbest=1;")(0)'精华贴
if isdb then'mssql
I2(9)=conn.execute("select count(*) from kingart where artshow=1 and datediff(day,artdate,getdate())=0;")(0)'今日新增文章
else
I2(9)=conn.execute("select count(*) from kingart where artshow=1 and date()-artdate<1;")(0)'今日新增文章
end if
set rs=conn.execute("select ipday,pvday from kingday where ipdate='"&today&"';")'今日
if not rs.eof and not rs.bof then
I2(10)=rs(0):I2(11)=rs(1)
else
I2(10)=0:I2(11)=0
end if
rs.close
set rs=nothing
'昨日
set rs=conn.execute("select ipday,pvday from kingday where ipdate='"&yest&"';")'昨日
if not rs.eof and not rs.bof then
I2(12)=rs(0):I2(13)=rs(1)
else
I2(12)=0:I2(13)=0
end if
rs.close
set rs=nothing
'本月
set rs=conn.execute("select ipmonth,pvmonth from kingmonth where ipdate='"&cumonth&"';")
if not rs.eof and not rs.bof then
I2(14)=rs(0):I2(15)=rs(1)
else
I2(14)=0:I2(15)=0
end if
rs.close
set rs=nothing
'上月
set rs=conn.execute("select ipmonth,pvmonth from kingmonth where ipdate='"&ultimo&"';")
if not rs.eof and not rs.bof then
I2(16)=rs(0):I2(17)=rs(1)
else
I2(16)=0:I2(17)=0
end if
rs.close
set rs=nothing
'最新注册会员
set rs=conn.execute("select top 1 username,userid from kinguser where userdel=0 order by userid desc;")
if not rs.eof and not rs.bof then
I2(18)=rs(0):I2(19)=inst&path&"/user.asp?userid="&rs(1)
else
I2(18)="None":I2(19)="#"
end if
rs.close
set rs=nothing
'在线人数
I2(20)=1
onlinetime=cdbl(king_onlinetime)/24/15
if instr(lcase(l1),"(king:online")>0 then
if lllll("../"&path&"/log/"&today&".asp") then
topen "../"&path&"/log/"&today&".asp"
set rs=tconn.execute("select distinct userip from kinglog where time()-logdate<"&onlinetime&";")
if not rs.eof and not rs.bof then
I2(20)=ubound(rs.getrows(),2)+1
end if
rs.close
set rs=nothing
tclose
end if
end if
invalue="countmenu:"&I11II(I2(0))
invalue=invalue&"|countarticle:"&I11II(I2(1))
invalue=invalue&"|counttopic:"&I11II(I2(2))
invalue=invalue&"|countboard:"&I11II(I2(3))
invalue=invalue&"|countuser:"&I11II(I2(4))
invalue=invalue&"|countlink:"&I11II(I2(5))
invalue=invalue&"|countrefer:"&I11II(I2(6))
invalue=invalue&"|countcomment:"&I11II(I2(7))
invalue=invalue&"|countbesttopic:"&I11II(I2(8))
invalue=invalue&"|countip:"&I11II(data(1,0))'所有ip
invalue=invalue&"|countpv:"&I11II(data(2,0))
invalue=invalue&"|startdate:"&I11II(data(3,0))'起始统计
invalue=invalue&"|articletoday:"&I11II(I2(9))'今日添加文章
invalue=invalue&"|todayip:"&I11II(I2(10))'今日ip
invalue=invalue&"|todaypv:"&I11II(I2(11))'今日pv
invalue=invalue&"|yestip:"&I11II(I2(12))'昨日ip
invalue=invalue&"|yestpv:"&I11II(I2(13))'昨日pv
invalue=invalue&"|monthip:"&I11II(I2(14))'本月ip
invalue=invalue&"|monthpv:"&I11II(I2(15))'本月pv
invalue=invalue&"|ultimoip:"&I11II(I2(16))'上月ip
invalue=invalue&"|ultimopv:"&I11II(I2(17))'上月pv
invalue=invalue&"|newuser:"&I11II(""&I2(18)&"")
invalue=invalue&"|newusername:"&I11II(I2(18))'新加入会员
invalue=invalue&"|newuserpath:"&I11II(I2(19))'新加入会员的信息连接
invalue=invalue&"|online:"&I11II(I2(20))'在线人数
I1=king.createhtm(jshtm,invalue)
I1III=I1
end function
'lllIll *** *** www.KingCMS.com *** ***
private function lllIll(l1,l2)
dim menuid,menupath,bbstype
dim rs,classid,insql,l3'l3=artid,topicid..
dim I1,I2,I3'I1=路径 I2=标题 I3=输出
menuid=l11l(l2,"menuid"):if len(menuid)=0 then exit function
set rs=conn.execute("select classid,menupath,bbstype from kingmenu where menuid="&menuid&";")
if not rs.eof and not rs.bof then
classid=rs(0)
menupath=rs(1)
bbstype=rs(2)
else
exit function
end if
rs.close
set rs=nothing
select case cstr(classid)
case"2"'文章
l3=l11l(l2,"artid")
if instr(l1,"prepage")>0 then
insql=" and artid>"&l3&" order by artid asc"'上一页
else
insql=" and artid<"&l3&" order by artid desc"
end if
set rs=conn.execute("select top 1 arttitle,artpath,sysdate,artgrade,artid from kingart where menuid="&menuid&insql&";")
if not rs.bof and not rs.eof then
if ll11("0",rs(3)) then'文章没有访问权限
if cstr(named)="0" then
I1=inst&menupath&"/"&rs(1)&ext'""&rs(0)&""
else
I1=inst&menupath&"/"&III11(rs(2))&"/"&rs(1)&ext'""&htmlencode(rs(0))&""
end if
if lllll(I1)=false then I1=inst&path&"/article.asp?/"&rs(4)&ext
else
I1=inst&path&"/article.asp?/"&rs(4)&ext
end if
I2=htmlencode(rs(0))
else
I1="javascript:alert('"&lang("paper/none")&"');"
I2=lang("paper/none")'"没有了"
end if
rs.close()
set rs=nothing
case"10"'论坛
l3=l11l(l2,"topicid")
if instr(l1,"prepage")>0 then
insql=" and topicid>"&l3&" order by topicid asc"'上一页
else
insql=" and topicid<"&l3&" order by topicid desc"
end if
set rs=conn.execute("select top 1 bbstitle,sysdate,topicid from kingtopic where menuid="&menuid&insql&";")
if not rs.eof and not rs.bof then
if ll11("0,1",bbstype) then
I1=inst&menupath&"/"&III11(rs(1))&"/"&rs(2)&ext
if lllll(I1)=false then I1=inst&path&"/topic.asp?/"&rs(2)&ext'king_sub10_page rs(2),0
else
I1=inst&path&"/topic.asp?/"&rs(2)&ext
end if
I2=htmlencode(rs(0))
else
I1="javascript:alert('"&lang("paper/none")&"');"
I2=lang("paper/none")'"没有了"
end if
rs.close
set rs=nothing
end select
select case cstr(l1)
case"prepage","nextpage" I3=""&I2&""
case"prepagetitle","nextpagetitle" I3=I1
case"prepagepath","nextpagepath" I3=I2
end select
lllIll=I3
end function
'lIIll *** *** www.KingCMS.com *** ***
private function lIIll(l1,l2,l3)'tag in:value submenu|currentmenu
dim menuid,rs,jsclass,jsunion,insql,jshtm,data,i,menupath,sql,menuid1,invalue
dim I1
menuid=l11l(l2,"menuid")
jsclass=getlabel(l1,"class")
jsunion=getlabel(l1,"union")'submenu的时候有效
jshtm=getlabel(l1,0)
select case lcase(jsclass)
case"article","news"
insql=" and classid=2"
case"bbs"
insql=" and classid=10"
end select
if ll11("submenu",l3) then'submenu
if II11(jsunion,6) then
insql=" menuid1 in ("&jsunion&")"&insql
else
insql=" menuid1="&menuid&insql
end if
sql="select menuname,menupath,menudescription,classid,bbstype from kingmenu where "&insql&" order by menuorder;"
else'currentmenu
menuid1=conn.execute("select menuid1 from kingmenu where menuid="&menuid&";")(0)
sql=" select menuname,menupath,menudescription,classid,bbstype from kingmenu where menuid1="&menuid1&insql&" order by menuorder;"
end if
set rs=conn.execute(sql)'4
if not rs.eof and not rs.bof then
data=rs.getrows()
for i=0 to ubound(data,2)
select case cstr(data(3,i))
case"0" menupath=data(1,i)
case"1" menupath=inst&data(1,i)
case"10"
if ll11("0,1",cstr(data(4,i))) then
menupath=inst&data(1,i)&"/index"&ext
else
menupath=inst&path&"/topiclist.asp?/"&menuid&ext
end if
case else menupath=inst&data(1,i)&"/index"&ext
end select
invalue="menuname:"&I11II(htmlencode(data(0,i)))
invalue=invalue&"|title:"&I11II(htmlencode(data(0,i)))
invalue=invalue&"|path:"&I11II(htmlencode(menupath))
invalue=invalue&"|menupath:"&I11II(htmlencode(menupath))
invalue=invalue&"|description:"&I11II(htmlencode(data(2,i)))
I1=I1&king.createhtm(jshtm,invalue)
next
end if
rs.close
set rs=nothing
lIIll=I1
end function
'lIIIll *** *** www.KingCMS.com *** ***
private function lIIIll(l1)
dim rs,sql,i,jshtm,jsnumber,insql,data,invalue,I1,zebra,jsorder,inorder
jshtm=getlabel(l1,0)
jsnumber=getlabel(l1,"number")
jsorder=getlabel(l1,"order")
zebra=getlabel(l1,"zebra")
if II11(jsnumber,2) then insql=" top "&jsnumber' else insql=" top 10 "
if ll11("asc,desc",jsorder) then
inorder=" linkid "&jsorder
else
inorder=" linkhit desc"
end if
sql=" linkname,linkdesc,linkurl,linkimg,sysdate "'4
set rs=conn.execute("select "&insql&sql&" from kinglink where linkshow=1 order by "&inorder&",linkdate desc;")
if not rs.eof and not rs.bof then
data=rs.getrows()
for i=0 to ubound(data,2)
invalue="title:"&I11II(htmlencode(data(0,i)))
invalue=invalue&"|description:"&I11II(htmlencode(data(1,i)))
invalue=invalue&"|path:"&I11II(htmlencode(data(2,i)))
if len(data(3,i)) then
if II11(data(3,i),8) then
invalue=invalue&"|image:"&I11II(III11(data(4,i))&"/"&data(3,i))
else
invalue=invalue&"|image:"&I11II(data(3,i))
end if
else
invalue=invalue&"|image:"&I11II("not/nolink.gif")
end if
I1=I1&king.createhtm(jshtm,invalue)
next
lIIIll=I1
end if
rs.close
set rs=nothing
end function
'lIIlll *** *** www.KingCMS.com *** ***
private function lIIlll(l1)
dim rs,l2,l3,l4
set rs=conn.execute("select menuid from kingmenu where menuid1="&l1&";")
if not rs.eof and not rs.bof then
while (not rs.eof)
l3=conn.execute("select count(*) from kingmenu where menuid1="&rs(0)&";")(0)
if l3>0 then
l4=lIIlll(rs(0))
if len(l4)>0 then
if len(l2)>0 then
l2=l4&","&l2
else
l2=l4
end if
end if
else
if len(l2)>0 then
l2=rs(0)&","&l2
else
l2=rs(0)
end if
end if
rs.movenext
wend
end if
set rs=nothing
lIIlll=l2
end function
'I11I1 *** *** www.KingCMS.com *** ***
private function I11I1(l1,l2)'标签, 库内容
'作用,返回动态标签被解析后的结果
'l1: 被输入的动态标签,
dim sqlnumber,insql,sqlorder,keysql
dim jsname,jstype,jsunion,jsintersection,jsnumber,jsshow,jshtm,jssubtract,jskeywords,jsauthor,jsfrom
dim artid,i,menuid,menuids,menuid1
dim I1,I2,jspath,sql,outsql
jsnumber=l11(l1,"number=""","""")'sql0
if II11(jsnumber,2) then sqlnumber=" top "&jsnumber else sqlnumber=" top 10"
jsname=replace(l1,"}","/")
jsname=replace(jsname," ","/")
jsname=lcase(l11(jsname,"king:","/"))
jstype=king.getlabel(l1,"type"):if jstype="" then jstype="new"
jsunion=king.getlabel(l1,"union")
jsintersection=king.getlabel(l1,"intersection")
jskeywords=king.getlabel(l1,"keywords")
jssubtract=king.getlabel(l1,"subtract")
jshtm=king.getlabel(l1,0)
jsauthor=king.getlabel(l1,"author")
jsfrom=king.getlabel(l1,"from")
'insql
if ll11("article,prod,down",jsname) then
if II11(jsunion,6) or ll11("sub,current,own",jsunion) then'联合,有union就不会有交集; sub子栏目 current当前同一级别的栏目 own=自己
if II11(jsunion,6) then
menuids=split(jsunion,",")
for i=0 to ubound(menuids)
if len(menuids(i))>0 then
insql=insql&" or menuids like '%,"&menuids(i)&",%' "'
end if '|
next '|
if len(insql)>0 then'如果insql有项目 |
insql=" and (menuid in ("&jsunion&") "&insql&")"'←----
end if
else
menuid=l11l(l2,"menuid")
if II11(menuid,2) then
select case jsunion
case"current"
menuid1=conn.execute("select menuid1 from kingmenu where menuid="&menuid&";")(0)
insql=" and menuid1="&menuid1&" "
case"sub"
insql=lIIlll(menuid)
if len(insql)>0 then insql=" and menuid in ("&insql&") "
case"own"
insql=" and menuid="&menuid&" "
end select
end if
end if
elseif II11(jsintersection,6) then'交集
'(menuid in (2,3) and ((menuids like '%,3,%' and menuid<>3) or (menuids like '%,2,%' and menuid<>2)))
menuids=split(jsintersection,",")
for i=0 to ubound(menuids)
if len(menuids(i))>0 then
if len(insql)>0 then insql=" or "
insql=insql&" (menuids like '%,"&menuids(i)&",%' and menuid<>"&menuids(i)&") "
end if
next
if len(insql)>0 then
insql=" and (menuid in ("&jsintersection&") and ("&insql&"))"
end if
end if
'去掉部分
if II11(jssubtract,6) then'要去掉的栏目id
insql=insql&" and menuid not in ("&jssubtract&") "
end if
else
if len(jsunion)>0 then
insql=" and menuid in ("&jsunion&") "
end if
end if
select case jsname
case "article","news"'新闻文章系统
'若有图片标签
if len(match(l1,"\(king:image.{0,}?\/\)"))>0 then
insql=insql&" and (artimg like '%.gif' or artimg like '%.jpeg' or artimg like '%.jpg' or artimg like '%.png' or artimg like '%.bmp') "
end if
'关键字来取值
if len(jskeywords)>0 then
I2=split(jskeywords,",")
for i=0 to ubound(I2)
if len(trim(I2(i)))>0 then
insql=insql&" and arttitle like '%"&lll1(I2(i))&"%' "
end if
next
end if
'作者调用
if len(jsauthor)>0 then
insql=insql&" and artauthor='"&III1(jsauthor)&"' "
end if
'来源调用
if len(jsfrom)>0 then
insql=insql&" and artfrom='"&III1(jsfrom)&"' "
end if
'insql值
' 推荐(elite)/最新(new)/热门(hot)/冷门(chill)/相关(realte:只有在文章系统中显示)
artid=l11l(l2,"artid")
if II11(artid,2)=false then artid=0
select case jstype
case"list" I11I1="":exit function
case"new"
if cstr(artid)="0" then
sqlorder=" order by artorder desc,artid desc"
else
sqlorder=" and artid<"&artid&" order by artorder desc,artid desc"
end if
case"elite" sqlorder=" and artcommend=1 order by artorder desc,artid desc"
case"hot" sqlorder=" order by arthit desc,artid asc"'只记录冷门和热门文章?
case"chill" sqlorder=" order by arthit,artid asc"
case"head" sqlorder=" and arthead=1 order by artorder desc,artid desc"
case"realte"
'相关文章,需要先获取key的值
keysql=IIII1("arttitle,artkeyword",l11l(l2,"keyword"),0)'获得like值,关键字只取标题和artkeyword字段
if II11(artid,2) then
if len(keysql)>0 then
insql=insql&" and "&keysql&" and artid<"&artid&" "
else
exit function
end if
else
exit function
end if
sqlorder=" order by artorder desc,artid desc"
case else exit function
end select
sql=" artid,menuid,arttitle,artauthor,artfrom,artdescription,artpath,artimg,artdate,sysdate,artgrade"
outsql="select "&sqlnumber&sql&" from kingart where menuid<>0 and artshow=1 "&insql&sqlorder&";"
jsname="article"
case"job"'人才
select case jstype
case"list" I11I1="":exit function
case"new" sqlorder=" order by joborder desc,jobid desc"
case else exit function
end select
sql=" jobid,menuid,jobname,jobnumber,jobaddress,jobpath,jobdate,sysdate"
outsql="select "&sqlnumber&sql&" from kingjob where jobshow=1 "&insql&";"
case"down"'下载系统,
case"prod"'产品系统
case"bbs"'论坛
if len(match(l1,"\(king:image.{0,}?\/\)"))>0 then'若有图片标签
insql=insql&" and (bbsimg like '%.gif' or bbsimg like '%.jpeg' or bbsimg like '%.jpg' or bbsimg like '%.png' or bbsimg like '%.bmp') "
end if
select case jstype
case"list","realte" I11I1="":exit function
case"new" sqlorder=" order by sysdate desc,topicid desc"
case"elite" sqlorder=" and topicbest=1 order by sysdate desc,topicid desc"
case"hot" sqlorder=" order by topichit desc,topicid desc"'只记录冷门和热门文章?
case"chill" sqlorder=" order by topichit,topicid desc"
end select
sql=" topicid,menuid,topictype,bbscontent,topiclock,topichit,topicreply,topicup,topicbest,bbsimg,"'9
sql=sql&"sysdate,lastdate,lastpostuser,lastpostdate,isvote,userid,username,topicicon,bbstitle,bbsdate "'19
outsql="select "&sqlnumber&sql&" from kingtopic where topicdel=0 "&insql&sqlorder&";"
end select
I11I1=tag(outsql,jsname,jshtm)
end function
'cls *** *** www.KingCMS.com *** ***
public function cls(l1)
if len(l1)>0 then
dim l2
l2=replace(l1,chr(10),"")
l2=replace(l2,chr(9),"")
l2=replace(l2,chr(13),"")
while (instr(l2," ")>0)
l2=replace(l2," "," ")
wend
cls=replace(l2,chr(39),"")
end if
end function
'tag *** *** www.KingCMS.com *** ***
public function tag(l1,l2,l3)'返回内部标签中的内容
'l1:sql
'l2:type(文章,下载)
'l3:jshtm
'on error resume next
dim rs,menuid,menupath,bbstype,menuname,i,j,artpath
dim topicattrib,themetype,hotreply,topicpath
dim data,I1,invalue
' out l1
set rs=conn.execute(l1)
if not rs.eof and not rs.bof then
data=rs.getrows()
else
redim data(0,-1)
end if
set rs=nothing
' if err.number<>0 then out l1
set rs=conn.execute("select hotreply from kingsystem where systemname='KingCMS';")
hotreply=rs(0)
set rs=nothing
for i=0 to ubound(data,2)
'获得栏目, ※ ※ ※ 需要注意的是menuid值要写在第1位 ※ ※ ※
'下面判断的作用:
' 如果menuid值和原先没有变化,就不用重新从menu字段中读取,以减少数据库负荷,也没必要缓存,那样内存消耗过大
if cstr(menuid)<>cstr(data(1,i)) then
menuid=data(1,i)
set rs=conn.execute("select menuname,menupath,bbstype from kingmenu where menuid="&menuid&";")
if not rs.eof and not rs.bof then
menuname=rs(0)
menupath=rs(1)
bbstype=rs(2)
end if
rs.close
set rs=nothing
end if
select case l2
case "article"'文章系统
' sql="artid,menuid,arttitle,artauthor,artfrom,artdescription,artpath,artimg,artdate,sysdate,artgrade" '10
invalue="title:"&I11II(htmlencode(data(2,i)))
invalue=invalue&"|author:"&I11II(htmlencode(data(3,i)))
invalue=invalue&"|from:"&I11II(htmlencode(data(4,i)))
invalue=invalue&"|description:"&I11II(htmlencode(data(5,i)))
invalue=invalue&"|date:"&I11II(data(8,i))
invalue=invalue&"|image:"&I11II(III11(data(9,i))&"/"&data(7,i))
if cstr(data(10,i))="0" then
if cstr(named)="0" then
artpath=menupath&"/"&data(6,i)&ext
else
artpath=menupath&"/"&III11(data(9,i))&"/"&data(6,i)&ext
end if
if lllll("../"&artpath) then'如果文件存在,就输出htm路径.
invalue=invalue&"|path:"&I11II(inst&artpath)
else
invalue=invalue&"|path:"&I11II(inst&path&"/article.asp?/"&data(0,i)&ext)
end if
else
invalue=invalue&"|path:"&I11II(inst&path&"/article.asp?/"&data(0,i)&ext)
end if
invalue=invalue&"|menuname:"&I11II(htmlencode(menuname))
invalue=invalue&"|menupath:"&I11II(king.inst&menupath)&"/index"&king.ext
case"job"
invalue="title:"&I11II(htmlencode(data(2,i)))
invalue=invalue&"|number:"&I11II(htmlencode(data(3,i)))
invalue=invalue&"|address:"&I11II(htmlencode(data(3,i)))
invalue=invalue&"|path:"&I11II(king.inst&menupath&"/"&III11(data(7,i))&"/"&data(5,i)&king.ext)
invalue=invalue&"|date:"&I11II(data(6,i))
case"download"
case"product"
case"bbs"
' "topicid,bbstitle,topictype,bbscontent,topiclock,topichit,topicreply,topicup,topicbest,bbsimg,"'9
' "sysdate,lastdate,lastpostuser,lastpostdate,isvote,userid,username,topicicon,menuid,bbsdate "'19
invalue="topictitle:"&I11II(htmlencode(data(18,i)))
invalue=invalue&"|title:"&I11II(htmlencode(data(18,i)))
invalue=invalue&"|topicid:"&data(0,i)
if datediff("h",data(10,i),tnow)<=8 then
invalue=invalue&"|topicnew:"&I11II("")
end if
if cstr(data(4,i))="1" then'锁定
themetype="lock"
else
if datediff("h",data(13,i),tnow)<=8 then themetype="new" else themetype="old"'8小时内是否有回复贴
if data(6,i)>=hotreply then themetype=themetype&"hot" else themetype=themetype'多余10个帖子,就是热门
end if
invalue=invalue&"|type:"'图标
if cstr(data(17,i))<>"0" then
invalue=invalue&"|icon:"'帖子类型?
end if
invalue=invalue&"|reply:"&data(6,i)'回复数
invalue=invalue&"|hit:"&data(5,i)'查看次数
invalue=invalue&"|topicuser:"&I11II(htmlencode(data(16,i)))'作者
invalue=invalue&"|topicprofile:"&I11II(king.inst&king.path&"/user.asp?userid="&data(15,i))'作者信息
invalue=invalue&"|topicdate:"&I11II(data(10,i))'创贴时间
invalue=invalue&"|date:"&I11II(data(10,i))'创贴时间
' menupath=conn.execute("select menupath from kingmenu where menuid="&data(1,i)&";")(0)
if ll11("0,1",bbstype) then
topicpath=king.inst&menupath&"/"&III11(data(10,i))&"/"&data(0,i)&king.ext
else
topicpath=king.inst&king.path&"/topic.asp?/"&data(0,i)&king.ext
end if
invalue=invalue&"|topicpath:"&I11II(topicpath)
invalue=invalue&"|path:"&I11II(topicpath)
invalue=invalue&"|description:"&I11II(htmlencode(king.cls(data(3,i))))
invalue=invalue&"|menuname:"&I11II(htmlencode(menuname))
invalue=invalue&"|menupath:"&I11II(king.inst&menupath)
invalue=invalue&"|image:"&I11II(III11(data(10,i))&"/"&data(9,i))
'属性
if cstr(data(7,i))="2" then topicattrib=" " else topicattrib=""
if cstr(data(7,i))="1" then topicattrib=topicattrib&" "
if cstr(data(14,i))="1" then topicattrib=topicattrib&" "
if cstr(data(8,i))="1" then topicattrib=topicattrib&" "
if len(data(9,i))>0 then
if ll11("jpeg,jpg,gif,png,bmp",lIl(data(9,i))) then
topicattrib=topicattrib&""
else
topicattrib=topicattrib&""
end if
end if
'topiclist=lllllI(king.inst&menupath&"/"&III11(data(10,i))&"/"&data(0,i),data(6,i),pagenumber)'路径,总回贴数,每页显示数(这个需要单独获取:( )
if data(2,i)<>"" then
invalue=invalue&"|topictype:["&I11II(htmlencode(data(2,i)))&"]"
end if
'invalue=invalue&"|topiclist:"&I11II(topiclist)
invalue=invalue&"|topicattrib:"&I11II(topicattrib)
invalue=invalue&"|lastuser:"&I11II(htmlencode(data(12,i)))'回复作者
invalue=invalue&"|lastprofile:"&I11II(king.inst&king.path&"/user.asp?username="&server.urlencode(data(12,i)))'回复者信息
invalue=invalue&"|lastdate:"&I11II(data(13,i))'最后回复
end select
invalue=invalue&"|number:"&cstr(i+1)
I1=I1&createhtm(l3,invalue)
next
tag=I1
end function
'tnimg *** *** www.KingCMS.com *** ***
public function tnimg(l1,l2,l3)'路径,长度,宽度
if len(l1)>0 and cdbl(l2)>0 and cdbl(l3)>0 then
if lIIl("Persits.Jpeg") then
dim imgfilename:imgfilename=I11II(imgname)
dim imgweight:imgweight=instr(imgfilename,".")
dim imgfname,imgext
imgfname=left(imgfilename,imgweight-1)
imgext=right(imgfilename,len(imgfilename)-imgweight)
Ill "../"&imgpath&"/TN"'先创建tn文件夹
'aspjpeg 图片裁剪程序
if jpeg("../"&imgpath&"/"&imgfilename,"../"&imgpath&"/TN/"&imgfname&"_"&l5&"_"&l6&"."&imgext,l5,l6) then
invalue=invalue&"|image:"&I11II("")
else'图片裁剪输出失败的时候是下面的缩放连接
invalue=invalue&"|image:"&I11II("")
end if
else
'这里需要扩展自动缩放程序
invalue=invalue&"|image:"&I11II("")
end if
end if
end function
'match *** *** www.KingCMS.com *** ***
public function match(l1,l2)
dim I1:I1=l1
dim I2,I3
set I2=new regexp
I2.pattern=l2
I2.ignorecase=true
I2.global=false
set I3=I2.execute(I1)
if I3.count>0 then
match=trim(I3.item(0).value)
end if
set I3=nothing
set I2=nothing
end function
'upfile *** *** www.KingCMS.com *** ***
public function upfile(l1,l2,l3,l4,l5)
dim l6,l7'l6:上传后的文件名 l7:根据文件类型判断文件存储路径
dim upimgname,uppath
dim imgname_k,leftimgname:imgname_k=0
if llll(l1l(left(ll11l("111"),16)))=l1l(ll11l("111")) then'submit
upload.FileType=l4'设置可上传文件类型
upload.MaxSize=l5*1024'上传大小
if cstr(upload.form(l1&"_size"))<>"" then'如果有文件提交
if II11(l2,8)=false then l2=""
upimgname=l2'原始的文件名
if ll11("jpeg,jpg,png,gif,bmp",upload.form(l1&"_ext")) then'如果是图像文件
uppath="../"&king_upath&"/image/"&III11(l3)
else
uppath="../"&king_upath&"/"&king_dpath&"/"&III11(l3)
end if
if upimgname="" then'第一次上传
upimgname=right(replace(replace(server.urlencode(lllI(upload.form(l1&"_name"))),"%","")&"."&upload.form(l1&"_ext"),"+",""),20)'文件名urlencode后去掉%号
leftimgname=lllI(upimgname)'文件名,去掉扩展名的部分
while(lllll(uppath&"/"&upimgname))
upimgname=leftimgname&"_"&imgname_k&"."&upload.form(l1&"_ext")
imgname_k=imgname_k+1
wend
' end if
'曾有文件,并扩展名有变化,需要删除原来的文件
elseif lIl(upimgname)<>lcase(upload.form(l1&"_ext")) and cstr(l2)<>"" then
if ll11("jpeg,jpg,png,gif,bmp",lIl(l2)) then
II1 "../"&king_upath&"/image/"&III11(l3)&"/"&l2
else
II1 "../"&king_upath&"/"&king_dpath&"/"&III11(l3)&"/"&l2
end if
upimgname=right(replace(server.urlencode(lllI(upload.form(l1&"_name"))),"%","")&"."&upload.form(l1&"_ext"),20)'文件名urlencode后去掉%号
leftimgname=lllI(upimgname)'文件名,去掉扩展名的部分
while(lllll(l3&"/"&upimgname))
upimgname=leftimgname&"_"&imgname_k&"."&upload.form(l1&"_ext")
imgname_k=imgname_k+1
wend
end if
call Ill(uppath)'创建文件夹
if upload.save(l1,uppath&"/"&upimgname)=false then
king.error("system/uperr/err"&upload.error)
else
if king.ispath=false then'前台才
conn.execute "update kinguser set usermark=usermark+"&mark_upfile&",userprestige=userprestige+"&prestige_upfile&" where userid="&king.id&";"
end if
end if
l6=upimgname
end if
end if
if cstr(l6)="" then l6=l2
upfile=l6
end function
'jpeg *** *** www.KingCMS.com *** ***
public function jpeg(l1,l2,l3,l4)'原始路径,输出路径,输出宽度,高度
on error resume next'如果不出现错误..就true
dim img,pimg,pwidth,pheight,nwidth,nheight
dim x1,y1,x2,y2,ojpeg
set ojpeg=server.createobject("persits.jpeg")'调用组件
ojpeg.open server.mappath(l1)'打开图片
pwidth=ojpeg.originalwidth
pheight=ojpeg.originalheight
if (pwidth/pheight)>=(l3/l4) then'宽度相对宽,以l4为基准缩放
nwidth=cint((pwidth/pheight)*l4)
nheight=l4
ojpeg.width=nwidth
ojpeg.height=nheight
'显示坐标值
x1=int((nwidth-l3)/2):y1=0
x2=x1+l3:y2=l4
else
nwidth=l3
nheight=cint((pheight/pwidth)*l3)
ojpeg.width=nwidth
ojpeg.height=nheight
x1=0:y1=int((nheight-l4)/2)
x2=l3:y2=y1+l4
end if
ojpeg.crop x1,y1,x2,y2 '切割
ojpeg.sharpen 1,130
ojpeg.save server.mappath(l2)
if err.number=0 then jpeg=true else jpeg=false
if err.number<>0 then err.clear
end function
'III1I *** *** www.KingCMS.com *** ***
private function III1I(l1,l2)'1:类型, 2:js&htm
dim I1
select case cstr(l2)
case"0"
select case l1
'生成相关的js文件的时候,先判断kingmenu,有多少语言,就生成几个.
case"top" I1=""
case"center" I1=""
case"bottom" I1=""
end select
case"1"
select case l1
case"top" I1=ll1l("top",language)
case"center" I1=ll1l("center",language)
case"bottom" I1=ll1l("bot",language)
end select
end select
III1I=I1
end function
'll1l *** *** www.KingCMS.com *** ***
public function ll1l(l1,l2)
dim data,idata,menutarget,rs,i,j,irs
redim data(0,-1)
dim l3,sql0,sql:sql0="select menuname,menupath,classid,menutarget,menuid,bbstype from kingmenu "
select case l1
case "top","bot"
if l1="top" then l3="
" else l3="
"
sql=sql0&"where menu"&l1&"=1 and menulanguage='"&l2&"' order by menuorder asc,menuid"
set rs=conn.execute(sql)
if not rs.eof and not rs.bof then
data=rs.getrows()
end if
set rs=nothing
for i=0 to ubound(data,2)
if cstr(data(3,i))="1" then menutarget=" target=""_blank""" else menutarget=""
select case cstr(data(2,i))
case"0" l3=l3&""&htmlencode(data(0,i))&""
case"1" l3=l3&""&htmlencode(data(0,i))&""
case"4" l3=l3&""&htmlencode(data(0,i))&""
else
l3=l3&""&htmlencode(data(0,i))&""
end if
case else l3=l3&""&htmlencode(data(0,i))&""
end select
if cstr(ubound(data,2))<>cstr(i) then
if l1="top" then l3=l3&"-"
if l1="bot" then l3=l3&"|"
end if
next
l3=l3&"
"
case "center"
'一级菜单
sql=sql0&"where menuct=1 and menulanguage='"&l2&"' and menuid1=0 order by menuorder asc,menuid"
set rs=conn.execute(sql)
if not rs.eof and not rs.bof then
data=rs.getrows()
l3="
"
for i=0 to ubound(data,2)
if cstr(data(3,i))="1" then menutarget=" target=""_blank""" else menutarget=""
select case cstr(data(2,i))
case"0" l3=l3&"
"&htmlencode(data(0,i))&""
end select
'二级菜单
sql=sql0&"where menuct=1 and menulanguage='"&l2&"' and menuid1="&data(4,i)&" order by menuorder asc,menuid"
set irs=conn.execute(sql)
if not irs.eof and not irs.bof then
l3=l3&"
"
idata=irs.getrows()
for j=0 to ubound(idata,2)
select case cstr(idata(2,j))
case"0" l3=l3&"
"&vbcr
end if
set rs=nothing
end select
ll1l=l3
end function
'double *** *** www.KingCMS.com *** ***
public function doublee(l1)
if len(l1)=1 then
doublee="0"&l1
else
doublee=l1
end if
end function
'I1I1I *** *** www.KingCMS.com *** ***
private function I1I1I(l1,l2,l3)'l1, l2总参数, l3对应的参数
dim l6,I1
l6=l11l(l2,l3)
if cstr(l6)="" then exit function
I1=l6
dim l7:l7=l11(l1,"size=""","""") 'size
if II11(l7,2) then
if king.lene(l6)>int(l7) then
I1=king.lefte(l6,l7)
else
I1=l6
end if
end if
if isdate(l6) then
dim l8:l8=l11(l1,"mode=""","""")'date mode
if cstr(l8)<>"" then
I1=replace(l8,"yyyy",year(l6))
I1=replace(I1,"yy",right(year(l6),2))
I1=replace(I1,"MM",king.doublee(month(l6)))
I1=replace(I1,"dd",king.doublee(day(l6)))
I1=replace(I1,"hh",king.doublee(hour(l6)))
I1=replace(I1,"mm",king.doublee(minute(l6)))
I1=replace(I1,"ss",king.doublee(second(l6)))
end if
end if
if lcase(l3)="image" then
'如果是在前台的话,不生成,但判断一下图片地址,如果存在就直接输出路径,如果不存在就判断是否支持aspjpeg,如果支持就生成输出
dim imgwidth,imgheight,imgvalue,imgpath,imgname,imgext,imgweight,imgarray
imgwidth=l11(l1,"width=""","""")
imgheight=l11(l1,"height=""","""")
imgvalue=l11l(l2,"image")
imgarray=split(imgvalue,"/")
imgpath=king_upath&"/image/"
if ubound(imgarray)>0 then
if II11(imgarray(1),8) then
imgweight=instr(imgarray(1),".")
imgname=left(imgarray(1),imgweight-1)
imgext=right(imgarray(1),len(imgarray(1))-imgweight)
if II11(imgheight,2) or II11(imgwidth,2) then
if II11(imgwidth,2)=false then imgwidth=120
if II11(imgheight,2)=false then imgheight=90
if lIIl("Persits.Jpeg") then
Ill "../"&imgpath&imgarray(0)&"/TN"'创建缩略图文件夹
if jpeg("../"&imgpath&imgvalue,"../"&imgpath&imgarray(0)&"/TN/"&imgname&"_"&imgwidth&"_"&imgheight&"."&imgext,imgwidth,imgheight) then
I1=inst&imgpath&imgarray(0)&"/TN/"&imgname&"_"&imgwidth&"_"&imgheight&"."&imgext
else'图片裁剪输出失败的时候是下面的缩放连接
I1=inst&imgpath&imgvalue
end if
else
I1=inst&imgpath&imgvalue
end if
else
I1=inst&imgpath&imgvalue
end if
else
I1=imgvalue
end if
else
I1=imgvalue
end if
end if
I1I1I=I1
end function
'lang *** *** www.KingCMS.com *** ***
public function lang(l1)
lang=getlang("language/"&l1)
end function
'confirm *** *** www.KingCMS.com *** ***
public function confirm(l1)
dim l2:l2=getlang("confirm/"&l1)
confirm=" onClick=""javascript:return confirm('"&l2&"')"" "
end function
'alert *** *** www.KingCMS.com *** ***
public function alert(l1)
dim l2,l3:l2=getlang("alert/"&l1)
l3=""
end function
'keywordlight *** *** www.KingCMS.com *** ***
public function keywordlight(l1,l2)
dim bads,I1,I2,I3,i
if len(l1)>0 and len(l2)>0 then
I1=l1
I2=split(l2,",")
set I3=new regexp
I3.global=true
I3.ignorecase=true
for i=0 to ubound(I2)
if len(trim(I2(i)))>0 then
I3.pattern="("&I2(i)&")"
I1=I3.replace(I1,"$1")
end if
next
keywordlight=I1
set I3=nothing
end if
end function
'l1lll *** *** www.KingCMS.com *** ***
private sub l1lll()
on error resume next
dim I1(5)
I1(0)=ll11l(332312222210)
I1(1)=ll11l(331232122233)
I1(2)=ll11l(333323133)
' out l1l(I1(2))
'second