"
End Sub
Sub EditMenu
Dim ID,Rs,S
ID=request.querystring("ID")
Set Rs=MNBoard.Execute("Select name,Url,Show,Flag,ParenID,Target From [i_Menu] where ID="&ID&"")
If Rs.Eof Then Goback"","记录不存在"
Response.Write GoForm("SaveMenu")
If Rs(3)>0 Then S="系统" Else S="普通"
Response.Write"
修改论坛"&S&"菜单
"
DIVTR"名称：",""," *",25,1
If Rs(3)>0 Then
S=Rs(1)
Else
S="(请填写相对路径,留空则不连接。)"
End If
DIVTR"连接文件：","",S,25,1
If Rs(3)<>8 Then
DIVTR"所属菜单：","",MenuSelect(Rs(4)),25,1
DIVTR"打开窗口：","",GetRadio("Target","原窗口",Rs(5),0)&GetRadio("Target","新窗口",Rs(5),1),25,1
End If
DIVTR"显示可见：","",GetRadio("Show","全部可见",Rs(2),0)&GetRadio("Show","只有会员可见",Rs(2),1)&GetRadio("Show","只有游客可见",Rs(2),2)&GetRadio("Show","不可见(隐藏)",Rs(2),3),25,1
Response.Write"
"
Rs.Close
End Sub
Sub Menu
Dim Showmood,Sql,Rs1,Subs,I,S
With Response
Showmood=Request("Showmood")
.Write GoForm("MenuOrder")&"
"
Sql="Select ID,Name,Url,show,orders,flag From [i_Menu] where "
If Showmood="" Then
S="ParenID=0 order by orders"
Else
S="ParenID=0 and (Show="&Showmood&" or Show=0) order by orders"
End If
Set Rs=MNBoard.Execute(Sql&S)
Do while Not Rs.eof
.Write"
"
.Write"
"&Rs(1)&"
"
.Write"
"
If Rs(2)<>"" Then .Write""&Rs(2)&"" Else .Write " "
.Write"
"&MenuShow(Rs(3))&"
"
If Rs(5)=8 Then
.Write"风格"
ElseIf Rs(5)>0 Then
.Write"系统"
Else
.Write"普通"
End If
.Write"
"
'风格菜单-只读
If Rs(5)=8 Then
Set Rs1=MNBoard.Execute("Select SkinID,SkinName,IsDefault,Ismode,Pass,remark From [i_Skins] Order By SkinID Asc")
Do while not Rs1.eof
.Write"
"
Rs1.movenext
Loop
Rs1.Close
End If
'下拉菜单
If Subs>0 Then
If ShowMood="" Then
S="parenID="&Rs(0)&" order by orders"
Else
S="parenID="&Rs(0)&" and (Show="&showmood&" or Show=0) order by orders"
End If
Set Rs1=MNBoard.Execute(Sql&S)
Do while Not Rs1.eof
.Write"
├
"
.Write"
"&Rs1(1)&"
"
If Rs1(2)<>"" Then .Write""&Rs1(2)&"" Else .Write " "
.Write"
"&MenuShow(Rs1(3))&"
"
If Rs1(5)>0 Then
.Write"系统"
Else
.Write"普通"
End If
.Write"
"
End If
Rs1.movenext
Loop
Rs1.Close
End If
Rs.Movenext
Loop
Rs.Close
Set Rs1=nothing
.Write"
"
End With
End Sub
Function MenuShow(Show)
Select case Show
case "1"
MenuShow="只有会员"
Case "2"
MenuShow="只有游客"
Case "3"
MenuShow="不显示"
Case else
MenuShow="全显示"
End Select
End Function
Function MenuSelect(parenID)
Dim mRs,Temp
Temp=""
MenuSelect=Temp
End Function
Sub ConfigData
Dim Temp
With MNBoard
If .Cache.valid("Hits") Then Temp=.Cache.Value("Hits")
Temp=Int(Temp)
Response.Write GoForm("UpdateConfigData")&"
"
End With
End Sub
Sub A_E_LockIP
Dim ID,StartIP,EndIp,Readme,Title
ID=request.querystring("ID")
StartIP=request.querystring("IP")
Readme=request.querystring("Readme")
Title="IP封锁"
If ID<>0 Then
Set Rs=MNBoard.execute("Select StartIp,EndIp,Readme,ID From[i_LockIp] where ID="&ID&"")
IF Rs.eof Then
GoBack"","记录不存在"
Exit Sub
Else
Title="修改封锁IP"
StartIP=MNBoard.Fun.IpDeCode(Rs(0))
EndIp=MNBoard.Fun.IpDeCode(Rs(1))
Readme=Rs(2)
End If
End If
Response.Write GoForm("LockIp")&"
"
End With
End Sub
Function GetSqlTableList()
Dim AllTable,I
AllTable=Split(MNBoard.BBStable(0),",")
For i=0 To uBound(AllTable)
GetSqlTableList=GetSqlTableList&""
Next
End Function
Sub SpaceSize
dim fso
On Error Resume Next
Set fso=server.CreateObject("Scr"&"ipting"&".Fil"&"eSy"&"stemOb"&"ject")
If Err Then
Goback"","空间不支持FOS文件读写！。"
err.Clear
Exit Sub
End If
Set fso=nothing
Response.Write"
"
End Sub
'2005-12-25重写 by suibing
Function GetSpaceInfo(drvpath)
dim fso,d,size,showsize
Set fso=server.CreateObject("Scr"&"ipting"&".Fil"&"eSy"&"stemOb"&"ject")
If Drvpath="i@BBS" Then
drvpath=server.mappath("Images")
drvpath=left(drvpath,(instrrev(drvpath,"\")-1))
set d=fso.getfolder(drvpath)
size=d.size
ElseIf DrvPath="i@BBS@" Then
dim fc,f1
drvpath=server.mappath("Images")
drvpath=left(drvpath,(instrrev(drvpath,"\")-1))
set d=fso.getfolder(drvpath)
set fc=d.Files
for each f1 in fc
size=size+f1.size
next
Set fc=nothing
Else
drvpath=server.mappath(drvpath)
set d=fso.getfolder(drvpath)
size=d.size
End If
set d=nothing
set fso=nothing
showsize=size & " Byte"
if size>1024 then
size=(size\1024)
showsize=size & " KB"
end if
if size>1024 then
size=(size/1024)
showsize=formatnumber(size,2) & " MB"
end if
if size>1024 then
size=(size/1024)
showsize=formatnumber(size,2) & " GB"
end if
GetSpaceInfo=showsize
End function
Function Drawbar(drvpath)
dim fso,drvpathroot,d,size,totalsize,barsize
set fso=server.CreateObject("Scr"&"ipting"&".Fil"&"eSy"&"stemOb"&"ject")
drvpathroot=server.mappath("Images")
drvpathroot=left(drvpathroot,(instrrev(drvpathroot,"\")-1))
set d=fso.getfolder(drvpathroot)
totalsize=d.size
If DrvPath="i@BBS@" then
Dim fc,f1
set fc=d.files
for each f1 in fc
size=size+f1.size
next
Set fc=Nothing
Else
drvpath=server.mappath(drvpath)
On Error Resume Next
set d=fso.getfolder(drvpath)
size=d.size
End If
set d=nothing
set fso=nothing
barsize=cint((size/totalsize)*300)
Drawbar=barsize
End Function
Sub UpdateBbs
Response.Write"
"
End Sub
Sub A_E_Link
Dim Title,ID,Orders,Ispic,Pic,BbsName,Admin,Url,Readme,Pass
pass=1
Ispic=0
Title="添加"
ID=Request("ID")
If ID<>"" Then
Set Rs=MNBoard.Execute("Select ID,Orders,IsPic,Pic,BbsName,Admin,Url,Readme,pass From [i_Link] where ID="&ID&"")
IF Rs.eof Then
GoBack"","这条论坛联盟不存在！"
Exit Sub
Else
Title="修改"
Orders=Rs(1)
Ispic=Rs(2)
Pic=Rs(3)
BbsName=Rs(4)
Admin=Rs(5)
Url=Rs(6)
Readme=Rs(7)
Pass=Rs(8)
End If
Rs.close
End If
Response.Write GoForm("SaveLink")
Response.Write"
"
End Sub
Sub Grade()
Dim Arr_Rs,i,S
Response.Write GoForm("AllUpdateGrade")&"
用户等级设置
等级名称
所需帖数
等级图片
标志图片
管理操作
"
Set Rs=MNBoard.execute("Select Grouping,ID,GradeName,EssayNum,PIC,Spic,Flag FROM [i_Grade] where Grouping=0 order by EssayNum")
do while Not Rs.Eof
Response.Write"
"
Set Rs=MNBoard.execute("Select Grouping,ID,GradeName,EssayNum,PIC,Spic,Flag FROM [i_Grade] where Grouping=1 order by ID")
do while Not Rs.Eof
Response.Write"
"
Set Rs=MNBoard.execute("Select Grouping,ID,GradeName,EssayNum,PIC,Spic,Flag FROM [i_Grade] where Grouping=2 order by Flag")
do while Not Rs.Eof
Response.Write"
"&_
"
"&_
"
"&_
"
"
If len(Rs(5))>3 Then Response.Write""
If Rs(6)=9 Then Response.Write"
"
End Sub
Sub A_E_Grade()
Dim Title,S,Grouping,ID,GradeName,EssayNum,PIC,Spic,Flag,Strings
ID=request.querystring("ID")
Grouping=request.querystring("Grouping")
If ID<>"" Then
Set Rs=MNBoard.execute("Select Grouping,ID,GradeName,EssayNum,PIC,Spic,Flag,Strings FROM [i_Grade] where ID="&ID)
If Rs.Eof Then
Goback"","记录不存":Exit Sub
Else
Title="编辑等级组"
Grouping=Rs(0)
GradeName=Rs(2)
EssayNum=Rs(3)
PIC=Rs(4)
Spic=Rs(5)
Flag=Rs(6)
Strings=Split(Rs(7),"|")
End IF
Rs.Close
Else
PIC="10.Gif"
EssayNum=0
Title="添加等级组"
Strings=Split("#F00|1|0|32100|0|1|0|0|1|1|100|1|50|16000|1|1|0|0|0|0|0|0|0|0|0|0|0|0|0|0|0|0|0|0|0|0|0|0|0|0|0","|")
End If
If Grouping=1 Then
Title=Title&"(特别定制)"
ElseIf Grouping=2 Then
Title=Title&"(系统固定)"
Else
Title=Title&"(按发帖数升级)"
End If
Response.Write GoForm("SaveGrade")&"
"&Title&"
"
DIVTR"等级名称：","","",25,1
If Grouping=0 Then DIVTR"必需达到帖数：","","",25,1
If Pic<>"" Then S=" " Else S=""
DIVTR"等级图片：","图片目录\PIC\Grade\",""&S,42,1
If sPic<>"" Then S="" Else S=""
DIVTR"身份标志图片：","图片目录\PIC\Grade\",""&S,42,1
Response.Write"
"
Set Rs=MNBoard.Execute("Select Name From [i_Admin] where boardID=-1")
Do while Not Rs.eof
Po=Po&""&Rs(0)&" "
Rs.movenext
loop
Rs.close
Response.Write po&"
"
Response.Write"
现有"&MNBoard.GetGradeName(0,7)&"
"
If Not IsArray(MNBoard.Board_Rs) Then MNBoard.GetBoardCache()'读取版块缓存
If IsArray(MNBoard.Board_Rs) Then
For i=0 To Ubound(MNBoard.Board_Rs,2)
po=""
For II=1 To MNBoard.Board_Rs(0,i)
Po=Po&" ∣ "
Next
If MNBoard.Board_Rs(0,i)=0 Then
DIVTR Po&MNBoard.Board_Rs(3,i),"","",22,2
Else
DIVTR Po&MNBoard.Board_Rs(3,i),"","
"
Set Rs=MNBoard.Execute("Select ID,Name,User,BuildDate From [i_Faction] order by ID desc")
Do while Not Rs.eof
UserNum=MNBoard.Execute("select count(ID) from [i_User] where Faction='"&Rs(1)&"'")(0)
Response.Write"
"
End Sub
Sub A_E_Faction
Dim ID,Name,FullName,Note,User,BuildDate,Title
Id=Request("ID")
BuildDate=MNBoard.NowBbsTime
Title="添加帮派"
If ID<>"" Then
Set Rs=MNBoard.Execute("Select Name,FullName,Note,User,BuildDate From [i_Faction] where ID="&ID)
IF Rs.eof Then Goback"","记录不存在":Exit Sub
Name=Rs(0)
FullName=Rs(1)
Note=Rs(2)
User=Rs(3)
BuildDate=Rs(4)
Title="编辑帮派"
Rs.Close
End If
Response.Write GoForm("SaveFaction")
Response.Write"
"
Footer()
Response.End
End If
Response.Write ""
Response.Write "
"&MNBoard.GetGradeName(0,9)&"列表
"
i=0
Set Rs=MNBoard.execute("Select Name,BoardID From[i_Admin] where BoardID=0")
Do while not Rs.eof
S="【降职】"
IF Rs(0)=MNBoard.GetMemor("Admin","AdminName") Then S="【降职】"
S=S&"【设置后台权限】"
DIVTR ""&Rs(0)&"","","
"&S&"
",22,2
Rs.movenext
Loop
Rs.Close
Response.Write"
"
End Sub
Sub Clean
Response.Write GoForm("Clean")
Response.Write "
"
Dim S,I,FSO,OpenFile,TmpStr,ad_num,ad_Tmp,BgColor
Set FSO = server.CreateObject("Scr"&"ipting"&".Fil"&"eSy"&"stemOb"&"ject")
Set OpenFile=FSO.OpenTextFile(Server.MapPath("inc/ads.js"))
tmpstr=OpenFile.Readall
S=split(tmpstr,chr(13)&chr(10))
ad_num=replace(S(1),";if(a==0){a=1}","")
ad_num=Int(replace(ad_num,"a=",""))
i=0
for i=1 to ad_num
ad_Tmp=replace(S(i+8),"b["&i&"].under=","")
ad_Tmp=replace(replace(ad_Tmp,"'","")," ","")
DIVTR I&"、显示效果：","","
"&ad_tmp&"
",25,2
DIVTR " 相应代码：","","",50,1
Next
DIVTR"增加广告：","","",50,2
Response.Write"
解除
"&GetSpaceinfo("data"),25,1
DIVTR"备份数据占用空间：","","
"&GetSpaceinfo("i@BBS@"),25,1
DIVTR"Inc 目录占用空间：","","
"&GetSpaceinfo("pic"),25,1
DIVTR"皮肤目录占用空间：","","
"&GetSpaceinfo("skins"),25,2
DIVTR"上传头像占用空间：","","
"&GetSpaceinfo("UploadFile/Head"),25,1
DIVTR"上传文件占用空间：","","
"&GetSpaceinfo("i@BBS")&"
","")
DIVTR I&"、显示效果：","","