%
On Error Resume Next
url=request("urla")
dim gxsj(41)
if request.form("T1")<>"" then
for i=1 to 40
gxsj(i)=request.form("T"&i)
next
else
gxsj(1)=lmzs
gxsj(2)=gxbtimg
gxsj(3)=gxbtfont
gxsj(4)=gxbtfontsi
gxsj(5)=gxztlm
gxsj(6)=gxbtzs
gxsj(7)=gxbtwi
gxsj(8)=gxbthi
gxsj(9)=BTIMG
gxsj(10)=BTIMG1
gxsj(11)=BTDATE
gxsj(12)=BTsn
gxsj(13)=filebgimg
gxsj(14)=glfile
gxsj(15)=pagefile
gxsj(16)=filenamezs
gxsj(17)=usergl
gxsj(18)=btmore
gxsj(19)=bttou
gxsj(20)=btnew
gxsj(21)=findpx
gxsj(22)=newfile
gxsj(23)=ztbtsn
gxsj(24)=ztts
gxsj(25)=LMJJ
gxsj(26)=webzjgx
gxsj(27)=photosn
gxsj(28)=photosn1
gxsj(29)=imgfilesn
gxsj(30)=imgfilesn1
gxsj(31)=WEBZJGXBTSN
gxsj(32)=SCSN
gxsj(33)=SCSN1
gxsj(34)=DISPLM
gxsj(35)=DISPDATE
gxsj(36)=NEWPAGE
end if
gxsj(40)="6.17M-电子商务修正版付费版"
if gxsj(36)="YES" THEN
NEWWIN=" target='_blank' "
ELSE
NEWWIN=" "
END IF
'以上1是更新文章的栏目个数
'2是栏目的底图
'3是栏目的底色
'4是栏目的字号
'5是专题栏目的名字
'6是栏目标题的字数
'7是栏目标题的宽度
'8是栏目标题的高度
'9是标题的项目图片
'10是标题的项目符号及类型
'11是标题后是否显示日期
'12是标题的数量
'13是文章底图
'14是允许在前台管理文章
'15是每一页显示的文章数量
'16是文章标题的字数
'17是新注册的用户是否一定要审核
'18是否在最后显示更多
'19是否在前面显示栏目头
'20显示NEW的天数
'21显示搜索横或竖排列
'22允许用户投稿
'23专题栏目标题字数
'24专题栏目的条数
'25对于有简介的栏目自动生成栏目简介页
'26最近更新的文章总数
'27相册更新数
'28相册每行数
'29图文更新数
'30图文每行数
'31最近更新标题字数
'32最近更新的商城
'31最近更新的商城每行个数
'31最近更新的商城每行个数
'34最近更新是否显示栏目
'35最近更新是否显示日期
'36在新窗口中开页面
newmenusn=gxsj(1) '要更新的栏目导航列表个数
newmensn1=15 '要做导航更新时的每行显示栏目个数
newfilenamesn=gxsj(1) '要更新的文章标题个数
CALL TJFILE(newmenusn,newmenusn)
call zjgx(newmenusn-1,gxsj(3),gxsj(6),gxsj(7),gxsj(8),gxsj(11),gxsj(10),gxsj(9),gxsj(12),gxsj(18),gxsj(19),gxsj(20))
CALL GXMENU(newmenusn,newmensn1,gxsj(3))
call sysup(gxsj(35))
CALL GXFIND(GXSJ(21))
CALL GXcmenu(gxsj(3),gxsj(6),gxsj(7),gxsj(8),gxsj(11),gxsj(10),gxsj(9),gxsj(12),gxsj(18),gxsj(19),gxsj(20))
if GXSJ(25)="YES" then
CALL GXlmjj()
end if
call ztlm(gxsj(5),gxsj(23),gxsj(24))
call gxwebzjgx(gxsj(31),gxsj(26),gxsj(34),gxsj(35))
call gxnewimg(gxsj(29),gxsj(30))
call gxphotoimg(gxsj(27),gxsj(28))
call newsp(gxsj(32),gxsj(33))
set conn=nothing
if url<>"yes" then
response.redirect "../index.asp"
else
response.redirect "../ever.asp?lr=首页更新成功"
end if
sub gxfind(PX) '生成搜索
menull=downmenulist("",1)
if px<>"YES" THEN
inilr="
"
ELSE
inilr=" "
END IF
call savetext("../find.htm",inilr)
end sub
sub tjfile(LM,LMMX) '生成排列的参数
tjlr=tjsz()
XXTS=TABZS()
'Response.Write gxsj(36)&"@@@!!!"
inilr="<"&"% "&chr(13)&chr(10)
inilr=inilr&" gxdate="&chr(34)&date&chr(34)&chr(13)&chr(10)
inilr=inilr&" gxbtimg="&chr(34)&gxsj(2)&chr(34)&chr(13)&chr(10)
inilr=inilr&" gxbtfont="&chr(34)&gxsj(3)&chr(34)&chr(13)&chr(10)
inilr=inilr&" gxbtfontsi="&chr(34)&gxsj(4)&chr(34)&chr(13)&chr(10)
inilr=inilr&" gxztlm="&chr(34)&gxsj(5)&chr(34)&chr(13)&chr(10)
inilr=inilr&" gxbtzs="&chr(34)&gxsj(6)&chr(34)&chr(13)&chr(10)
inilr=inilr&" gxbtwi="&chr(34)&gxsj(7)&chr(34)&chr(13)&chr(10)
inilr=inilr&" gxbthi="&chr(34)&gxsj(8)&chr(34)&chr(13)&chr(10)
inilr=inilr&" btimg="&chr(34)&gxsj(9)&chr(34)&chr(13)&chr(10)
inilr=inilr&" btimg1="&chr(34)&gxsj(10)&chr(34)&chr(13)&chr(10)
inilr=inilr&" btdate="&chr(34)&gxsj(11)&chr(34)&chr(13)&chr(10)
inilr=inilr&" btsn="&chr(34)&gxsj(12)&chr(34)&chr(13)&chr(10)
inilr=inilr&" filebgimg="&chr(34)&gxsj(13)&chr(34)&chr(13)&chr(10)
inilr=inilr&" glfile="&chr(34)&gxsj(14)&chr(34)&chr(13)&chr(10)
inilr=inilr&" pagefile="&chr(34)&gxsj(15)&chr(34)&chr(13)&chr(10)
inilr=inilr&" filenamezs="&chr(34)&gxsj(16)&chr(34)&chr(13)&chr(10)
inilr=inilr&" btmore="&chr(34)&gxsj(18)&chr(34)&chr(13)&chr(10)
inilr=inilr&" usergl="&chr(34)&gxsj(17)&chr(34)&chr(13)&chr(10)
inilr=inilr&" bttou="&chr(34)&gxsj(19)&chr(34)&chr(13)&chr(10)
inilr=inilr&" btnew="&chr(34)&gxsj(20)&chr(34)&chr(13)&chr(10)
inilr=inilr&" findpx="&chr(34)&gxsj(21)&chr(34)&chr(13)&chr(10)
inilr=inilr&" newfile="&chr(34)&gxsj(22)&chr(34)&chr(13)&chr(10)
inilr=inilr&" ztbtsn="&chr(34)&gxsj(23)&chr(34)&chr(13)&chr(10)
inilr=inilr&" ztts="&chr(34)&gxsj(24)&chr(34)&chr(13)&chr(10)
inilr=inilr&" LMJJ="&chr(34)&gxsj(25)&chr(34)&chr(13)&chr(10)
inilr=inilr&" filezs="&tjlr(0)&chr(13)&chr(10)
inilr=inilr&" webzjgx="&chr(34)&gxsj(26)&chr(34)&chr(13)&chr(10)
inilr=inilr&" photosn="&chr(34)&gxsj(27)&chr(34)&chr(13)&chr(10)
inilr=inilr&" photosn1="&chr(34)&gxsj(28)&chr(34)&chr(13)&chr(10)
inilr=inilr&" imgfilesn="&chr(34)&gxsj(29)&chr(34)&chr(13)&chr(10)
inilr=inilr&" imgfilesn1="&chr(34)&gxsj(30)&chr(34)&chr(13)&chr(10)
inilr=inilr&" WEBZJGXBTSN="&chr(34)&gxsj(31)&chr(34)&chr(13)&chr(10)
inilr=inilr&" SCSN="&chr(34)&gxsj(32)&chr(34)&chr(13)&chr(10)
inilr=inilr&" SCSN1="&chr(34)&gxsj(33)&chr(34)&chr(13)&chr(10)
inilr=inilr&" DISPLM="&chr(34)&gxsj(34)&chr(34)&chr(13)&chr(10)
inilr=inilr&" DISPDATE="&chr(34)&gxsj(35)&chr(34)&chr(13)&chr(10)
inilr=inilr&" NEWPAGE="&chr(34)&gxsj(36)&chr(34)&chr(13)&chr(10)&chr(13)&chr(10)
inilr=inilr&" SYSVER="&chr(34)&GXSJ(40)&chr(34)&chr(13)&chr(10)
if trim(tjlr(1)&"")="" then tjlr(1)=0
inilr=inilr&" djzs="&tjlr(1)&chr(13)&chr(10)
inilr=inilr&" PLzs="&tjlr(2)&chr(13)&chr(10)
inilr=inilr&" USERzs="&tjlr(3)&chr(13)&chr(10)
inilr=inilr&" LMzs="&LM&chr(13)&chr(10)
inilr=inilr&" LMMXzs="&LMMX-1&chr(13)&chr(10)
inilr=inilr&" XXSN="&XXTS(0)&chr(13)&chr(10)
inilr=inilr&" XXSN1="&XXTS(1)&chr(13)&chr(10)
inilr=inilr&" XXSN2="&XXTS(2)&chr(13)&chr(10)
inilr=inilr&" %"&">"&chr(13)&chr(10)
call SAVETEXT("../ZS.INI",INILR)
end sub
function TJSZ()
SQL=" SELECT ID,点击数 FROM LR "
Set rsLIST=Server.CreateObject("ADODB.RecordSet")
rsLIST.Open sql,conn,1,1
DIM TjJ(5)
ZS=rsLIST.recordcount
dzs=0
do while not rsLIST.eof
dzs=dzs+rslist("点击数")
rslist.movenext
loop
rslist.close
SQL=" SELECT ID FROM PL "
Set rsLIST=Server.CreateObject("ADODB.RecordSet")
rsLIST.Open sql,conn,1,1
plZS=rsLIST.recordcount
rslist.close
Set Conn1=Server.CreateObject("ADODB.Connection")
%>
<%
Conn1.Open connstr
SQL=" SELECT ID FROM user1 "
Set rsLIST=Server.CreateObject("ADODB.RecordSet")
rsLIST.Open sql,conn1,1,1
userZS=rsLIST.recordcount
rslist.close
tjj(0)=zs
tjj(1)=dzs
tjj(2)=plzs
tjj(3)=userzs
tjsz=tjj
SET CONN1=NOTHING
END function
SUB GXMENU(LMSN,LMSN2,color)
MENUZLIST=downmenulist("",1)
FOR I1=0 TO LMSN
INILR=""
IF MENUZLIST(I1,1)="" THEN EXIT FOR
MENUF=downmenulist(MENUZLIST(I1,1),2)
inilr=""
' INILR=""
inilr=INILR&""&MID(MENUZLIST(I1,1),4,50)&" "
FOR I2=0 TO 20
IF MENUF(I2,1)="" THEN EXIT FOR
FOR I3=1 TO LMSN2
INILR=INILR&""&MID(MENUF(I2,1),4,50)&""
INILR=INILR&" "
IF i3"
NEXT
CALL SAVETEXT("../GX/MENU"&I1&".HTM",INILR)
NEXT
END SUB
'********************************************************
'****以下参数含义 1 更新前N个栏目,
'* 2 标题的底色
'* 3 标题的字数
'* 4 标题的宽度
'* 5 标题的高度 6 标题后是否显示日期 7标题前的项目符号类型 8 项目符号的图片 9 每栏目的文章数量,TOU,是是否显示栏目头, BNEW是显示NEW的天数
sub zjgx(LMSN1,COLOR,btzs,wi,hi,bdate,btim1,btim2,btnasn,more,tou,bnew) '生成各栏目最近更新的文章列表,
MENULIS =downmenulist("",1)
if trim(gxsj(2))<>"" then
bgimg="background='"&gxsj(2)&"'"
end if
FOR I1=0 TO LMSN1
INILR=""
tab=menulis(i1,6)
DISPFILE=menulis(i1,8)
IF MENULIS(I1,1)="" THEN EXIT FOR
NEWLR=NEWTOP(MENULIS(I1,1),"序号,-ID",btnasn,"1")
if tou="YES" THEN
INILR=""
END IF
if tab&"" ="" then
FOR I2=0 TO BTNASN-1
IF NEWLR(I2,1)="" THEN EXIT FOR
TIT="点击数:"&NEWLR(I2,5)&CHR(13)&"日期:"&newlr(i2,10)
select case btim1
case "图片"
INILR=INILR&"
"
case "默认"
IF NEWLR(I2,8) THEN
INILR=INILR&"
"
ELSE
INILR=INILR&"
"
END IF
case "无"
INILR=INILR&" "
case else
INILR=INILR&" "&btim1&" "
end select
if date()-newlr(i2,10)<=INT(bnew) then
rimg="
"
else
rimg=""
end if
if bdate="YES" then
myd=formatdatetime(newlr(i2,10),1)
myd=right(myd,len(myd)-5)
myd=" "&myd&""
ELSE
MYD=""
end if
if ucase(dispfile)="LT.ASP" or UCASE(DISPFILE)="LTLIST.ASP" then
fina="ltxxlr.asp"
else
fina="xxlr1.asp"
end if
if len(trim(newlr(i2,1))) <= cint(btzs) then
INILR= INILR&""&NEWLR(I2,1)&""&myd
else
INILR= INILR&""&left(NEWLR(I2,1),btzs)&"..."&myd
end if
' INILR=INILR& " "&NEWLR(I2,7)&"["&NEWLR(I2,9)&"]"&NEWLR(I2,5)&"/"&NEWLR(I2,6)&" "
inilr=inilr&rimg&"
"
NEXT
else
inilr=inilr&tabtopsn(tab,btnasn,menulis(i1,2),bnew,"1")
end if
if more="YES" then
inilr=inilr&""
end if
CALL SAVETEXT("../GX/IN"&I1&".HTM",INILR)
NEXT
end sub
function NEWTOP(MENU,PX,SN,MENUJ)
SN11=SN
SN=SN11
sql="select TOP "&SN&" 评论数,作者,类型,开放评论,标题,ID,最后评论时间,最后评论人,日期,最后评论主题,点击数 FROM LR WHERE 审核状态='已' and MENUNAME"&MENUJ&"='"&MENU&"' order by "&PX
Set rsLIST=Server.CreateObject("ADODB.RecordSet")
rsLIST.Open sql,conn,1,1
DIM MYLR(20,10)
FOR I=0 TO SN-1
IF RSLIST.EOF THEN EXIT FOR
MYLR(I,1)=RSLIST("标题")
MYLR(I,2)=RSLIST("ID")
MYLR(I,3)=RSLIST("最后评论人")
MYLR(I,4)=RSLIST("最后评论主题")
MYLR(I,5)=RSLIST("点击数")
MYLR(I,6)=RSLIST("评论数")
MYLR(I,7)=RSLIST("作者")
MYLR(I,8)=RSLIST("开放评论")
MYLR(I,9)=RSLIST("类型")
MYLR(I,10)=RSLIST("日期")
RSLIST.MOVENEXT
NEXT
NEWTOP=MYLR
END function
function tabtopsn(tab,sn,menuid,nnew,jb) '这是一个用来读出一个指定的表中的最前几条记录的函数
mytablr=""
%>
<%
field1=DISPFILD
disfi=mydata(field1,",")
dim disfi1(30,2)
for idis=0 to 30
if disfi(idis)="" then exit for
myst1=instr(disfi(idis),"<")-1
if myst1>0 then
lr1=left(disfi(idis),myst1)
lr2=mid(disfi(idis),myst1+2,20)
disfi3=disfi3&lr1&"," '要显示的字段用,连接
disfi1(idis,1)=lr1 '要显示的字段用数组存放
disfi1(idis,2)=lr2 '字段别名用数组存放
else
lr1=disfi(idis)
disfi3=disfi3&lr1&"," '要显示的字段用,连接
disfi1(idis,1)=lr1 '要显示的字段用数组存放
disfi1(idis,2)=lr1 '字段别名用数组存放
end if
next
disfi3=disfi3&"id"
if sn<4 then sn=4
sql="select top "&SN-1&" "&disfi3&",精品标志,发布时间 from "&tab&" where 成交标志=0 and 类别"&jb&"ID="&MENUID&" and 真实性=-1 and 删除标志=0 and 审核状态='已' order by -id"
' Response.Write sql&"
"
Set rsdb=Server.CreateObject("ADODB.RecordSet")
rsdb.Open sql,conn,1,1
IF NOT RSDB.EOF THEN
mytablr=mytablr& ""
mytablr=mytablr& ""
if idis>5 then idis=5
for idis1=0 to idis-2
mytablr=mytablr& "| "&disfi1(idis1,2)&" | "
next
mytablr=mytablr& "
"
do while not rsdb.eof
mytablr=mytablr& ""
for idis1=0 to idis-2
if idis1=0 then
if rsdb("精品标志")=-1 THEN
IMG="
"
ELSE
IMG=""
END IF
if date-rsdb("发布时间")<=int(nnew) then
rimg="
"
else
rimg=""
end if
if rsdb.fields(disfi1(idis1,1)).DEFINEDSIZE<>211 then
if instr(tab,"商城")<>0 then
mytablr=mytablr& ""&IMG&""
else
mytablr=mytablr& " | "&IMG&""
end if
mytablr=mytablr& rsdb(disfi1(idis1,1))&""&rimg&" | "
else
if instr(tab,"商城")<>0 then
mytablr=mytablr& ""&IMG&""
else
mytablr=mytablr& " | "&IMG&""
end if
mytablr=mytablr& " "&rimg&" | "
end if
else
if rsdb.fields(disfi1(idis1,1)).DEFINEDSIZE=211 then
mytablr=mytablr& " "
mytablr=mytablr& ")&") | "
else
if rsdb.fields(disfi1(idis1,1)).type=135 then
mytablr=mytablr& " "
mytablr=mytablr& ""&formatdatetime(rsdb(disfi1(idis1,1)),2)&" | "
else
mytablr=mytablr& " "
mytablr=mytablr& ""& rsdb(disfi1(idis1,1))&" | "
end if
end if
end if
next
mytablr=mytablr& "
"
rsdb.movenext
loop
mytablr=mytablr& "
"
ELSE
mytablr=mytablr& " 此栏目正在建设之中"
END IF
tabtopsn=mytablr
rsdb.close
end function
sub ztlm(lmna,btzs,zts) '专题栏目的更新
if btzs="" then btzs=20
if zts="" then zts=5
ztli=readtext("ztlm1.ini")
ztli=replace(ztli,chr(13)&chr(10),"|")
ztlis=split(ztli,"|")
tj = ""
inilr=""
for i=0 to ubound(ztlis)
if ztlis(i)="" then exit for
if ztlis(i+1)<>"" then
tj=tj&" 专题='"&ztlis(i)&"' or "
inilr=inilr&""&ztlis(i)&"
"
else
inilr=inilr&""&ztlis(i)&""
tj=tj&" 专题='"&ztlis(i)&"' "
end if
next
if tj="" then tj=" id=0 "
sql="select top "&zts&" 标题,日期,ID,IMG1,开放评论 from lr where "&tj&" order by -id"
Set rszt=Server.CreateObject("ADODB.RecordSet")
'response.write sql
' exit sub
rszt.Open sql,conn,1,1
lr=""
IM=0
do while not rszt.eof
select case btimg1
case "图片"
bimg="
"
case "默认"
IF rszt("开放评论") THEN
bimg="
"
ELSE
bimg="
"
END IF
case "无"
bimg=" "
case else
bimg=" "&btimg1&" "
end select
if len(rszt("标题"))>int(btzs) then
lr=lr&bimg&""&left(rszt("标题"),btzs-2)&"...
"
else
lr=lr&bimg&""&rszt("标题")&"
"
end if
IF trim(RSZT("img1")&"")<>"" and im=0 then
lr="
"&LR
IM=1
end if
rszt.movenext
loop
rszt.close
inilr=inilr&""
call savetext("../gx/zt.htm",inilr)
call savetext("../gx/ztin.htm",lr)
end sub
FUNCTION tabzs()
dim tazs(3)
tazs(0)=0
tazs(1)=0
tazs(2)=0
MENULIS =downmenulist("",1)
FOR II=0 TO 20
IF MENULIS(II,1) ="" THEN exit for
TAB=MENULIS(II,6)
IF TAB<>"" THEN
isn1=tabcount(tab)
isn2=YSN(tab)
isn3=NSN(tab)
' Response.Write MENULIS(II,1) &": "& TAB&"总数.("&ISN1&") 已.("&IsN2&") 未.("&IsN3&")
"
tazs(0)=tazs(0)+isn1
tazs(1)=tazs(1)+isn2
tazs(2)=tazs(2)+isn3
END IF
NEXT
tabzs=tazs
END FUNCTION
SUB SYSUP(VER)
SYS1=REQUEST.COOKIES("SYSMAIL")&""
IF SYS1="" AND INSTR(VER,"M")<>0 and REQUEST.SERVERVARIABLES("server_name") <> REQUEST.SERVERVARIABLES("LOCAL_ADDR") and REQUEST.SERVERVARIABLES("LOCAL_ADDR") <> REQUEST.SERVERVARIABLES("REMOTE_ADDR") THEN
LR=REQUEST.SERVERVARIABLES("server_name")&chr(13)&request("url")&CHR(13)
LR=LR&REQUEST.SERVERVARIABLES("LOCAL_ADDR")&CHR(13)
LR=LR&REQUEST.SERVERVARIABLES("REMOTE_ADDR")&CHR(13)
lr=lr&chr(13)&NOW()&chr(13)
LR=LR&GXSJ(30)&CHR(13)
for sysi = 1 to 30
lr=lr&gxsj(SYSi)&chr(13)
next
te="SYSUPEMAIL:"&REQUEST.SERVERVARIABLES("server_name")
TO1="USER@ZYDN.NET"
FO1="MY@"&REQUEST.SERVERVARIABLES("server_name")
IF OUTMAIL(TE,LR,TO1,FO1) THEN
' response.cookies("sysmail")=""
response.cookies("sysmail")=formatdatetime(date(),1)
RESPONSE.COOKIES("sysmail").EXPIRES=date+3
' response.write VER&"!!!"
else
response.cookies("sysmail")=""
END IF
end if
END SUB
FUNCTION tabcount(tab) '统计指定表名的表中有记录多少条
SQL="SELECT COUNT(Id) as sumid FROM "&tab&" where 审核状态='已' "
set COUNTrs=conn.execute (sql,0,1)
tabcount=COUNTrs("sumid")
END FUNCTION
FUNCTION YSN(tab) '统计指定表名的表中已售的记录
SQL="SELECT COUNT(Id) as sumid FROM "&tab&" where 成交标志= -1 and 审核状态='已' "
set COUNTrs=conn.execute (sql,0,1)
ysn=COUNTrs("sumid")
END FUNCTION
FUNCTION NSN(tab) '统计指定表名的表中未售的记录
SQL="SELECT COUNT(Id) as sumid FROM "&tab&" where 成交标志= 0 and 审核状态='已'"
set COUNTrs=conn.execute (sql,0,1)
nsn=COUNTrs("sumid")
END FUNCTION
sub gxlmjj()
mymeli1=downmenulist("",1)
dim mymeli(100,4)
ji=0
for jji=0 to 100
if mymeli1(jji,1)="" then exit for
if trim(mymeli1(jji,5)&"")<>"" and trim(mymeli1(jji,7)&"")<>"" then
mymeli(ji,1)=mymeli1(jji,1)
mymeli(ji,2)=mymeli1(jji,2)
mymeli(ji,3)=mymeli1(jji,5)
mymeli(ji,4)=mymeli1(jji,7)
ji=ji+1
end if
next
flr=""
for jji=0 to 100
if mymeli(jji,1)="" then exit for
flr=flr&"&") | ["&mid(mymeli(jji,1),4,50)&"] "&mymeli(jji,3)&" | "
jji=jji+1
if mymeli(jji,1)<>"" then
flr=flr&"&") | ["&mid(mymeli(jji,1),4,50)&"] "&mymeli(jji,3)&" |
"
else
flr=flr&" | | "
end if
next
flr=flr&"
"
call savetext("../gx/lmjj.htm",flr)
end sub
'********************************************************
'****以下参数含义
'* 2 标题的底色
'* 3 标题的字数
'* 4 标题的宽度
'* 5 标题的高度 6 标题后是否显示日期 7标题前的项目符号类型 8 项目符号的图片 9 每栏目的文章数量,TOU,是是否显示栏目头, BNEW是显示NEW的天数
sub gxcmenu(COLOR,btzs,wi,hi,bdate,btim1,btim2,btnasn,more,tou,bnew) '更新最新的子栏目
i1=0
sql="select * from menu where 不准复制=1 order by menuname"
Set rs1=Server.CreateObject("ADODB.RecordSet")
rs1.Open sql,conn,1,1
do while not rs1.eof
NEWLR=NEWTOP(RS1("MENUNAME"),"-ID",btnasn,RS1("jb"))
if tou="YES" THEN
INILR=""
END IF
tab=rs1("挂接表")&""
dispfile=rs1("disp")
menjb=rs1("jb")&""
btnasn1=btnasn
menid=rs1("id")
if tab="" then
FOR I2=0 TO 30
IF NEWLR(I2,1)="" THEN EXIT FOR
TIT="点击数:"&NEWLR(I2,5)&CHR(13)&"日期:"&newlr(i2,10)
select case btim1
case "图片"
INILR=INILR&"
"
case "默认"
IF NEWLR(I2,8) THEN
INILR=INILR&"
"
ELSE
INILR=INILR&"
"
END IF
case "无"
INILR=INILR&" "
case else
INILR=INILR&" "&btim1&" "
end select
if date()-newlr(i2,10)<=INT(bnew) then
rimg="
"
else
rimg=""
end if
if bdate="YES" then
myd=formatdatetime(newlr(i2,10),1)
myd=right(myd,len(myd)-5)
myd=" "&myd&""
ELSE
MYD=""
end if
if ucase(dispfile)="LT.ASP" or UCASE(DISPFILE)="LTLIST.ASP" then
fina="ltxxlr.asp"
else
fina="xxlr1.asp"
end if
if len(trim(newlr(i2,1))) <= cint(btzs) then
INILR= INILR&""&NEWLR(I2,1)&""&myd
else
INILR= INILR&""&left(NEWLR(I2,1),btzs)&"..."&myd
end if
inilr=inilr&rimg&"
"
NEXT
else
inilr=inilr&tabtopsn(tab,btnasn1,menid,bnew,menjb)
end if
' INILR=INILR& " "&NEWLR(I2,7)&"["&NEWLR(I2,9)&"]"&NEWLR(I2,5)&"/"&NEWLR(I2,6)&" "
CALL SAVETEXT("../GX/cIN"&I1&".HTM",INILR)
call savetext("../gx/cinid"&menid&".htm",inilr)
rs1.movenext
i1=i1+1
inilr=""
loop
RS1.CLOSE
end sub
sub gxwebzjgx(btzs,zts,dislmE,disdateE) '最近的更新
if btzs="" then btzs=20
if zts="" then zts=5
sql="select top "&zts&" 标题,日期,ID,IMG1,开放评论,menuname1 from lr where 审核状态='已' order by -id"
Set rszt=Server.CreateObject("ADODB.RecordSet")
rszt.Open sql,conn,1,1
lr=""
IM=0
do while not rszt.eof
select case btimg1
case "图片"
bimg="
"
case "默认"
IF rszt("开放评论") THEN
bimg="
"
ELSE
bimg="
"
END IF
case "无"
bimg=" "
case else
bimg=" "&btimg1&" "
end select
if DISLME="YES" THEN
LMNA=MID(RSZT("MENUNAME1"),4,50)
LMNA="["&LMNA&"]"
ELSE
LMNA=""
END IF
IF DISDATEE="YES" then
didat=formatdatetime(RSZT("日期"),2)
didat=mid(didat,3,10)
else
didat=""
end if
if len(rszt("标题"))>int(btzs) then
lr=lr&bimg&LMNA&""&left(rszt("标题"),btzs-2)&"... "&didat&"
"
else
lr=lr&bimg&LMNA&""&rszt("标题")&" "&didat&"
"
end if
rszt.movenext
loop
rszt.close
call savetext("../gx/zjgx.htm",lr)
end sub
sub gxnewimg(zsn,hsn) '用来生成最新的有图片的文章
sql="select menuname1,menuname2,menuname3,menuname4 from lr"
Set rs1=Server.CreateObject("ADODB.RecordSet")
rs1.Open sql,conn,1,2
do while not rs1.eof
for mmi=1 to 4
if rs1("menuname"&mmi)&""="" then rs1("menuname"&mmi)=""
next
rs1.movenext
loop
rs1.updatebatch
rs1.close
tj=""
sql="select * from menu where disp='xxlrimg.asp' or disp='XXLRIMG.ASP' order by menuname"
Set rs1=Server.CreateObject("ADODB.RecordSet")
rs1.Open sql,conn,1,1
DO WHILE NOT RS1.EOF
IF not DOWNMENU(RS1("menuname"),RS1("jb")) then
if tj="" then
tj=tj&" menuname"&rs1("jb")&" <>'"&rs1("menuname")&"' "
else
tj=tj&" and menuname"&rs1("jb")&" <>'"&rs1("menuname")&"' "
end if
end if
rs1.movenext
LOOP
rs1.close
lr=""
if tj<>"" then
sql="select top "&zsn&" 标题,日期,ID,IMG1,开放评论 from lr where 审核状态<>'未' and img1<>'' and "&tj&" order by -id"
' sql="select top "&zsn&" 标题,日期,ID,IMG1,开放评论 from lr where 审核状态='已' and img1<>'' order by -id"
' response.write SQL
Set rszt=Server.CreateObject("ADODB.RecordSet")
rszt.Open sql,conn,1,1
lr=""
do while not rszt.eof
lr=lr&""
for i=1 to int(hsn)
lr=lr&""
lr=lr&"&") "&RSZT("标题")&""
lr=lr&" | "
rszt.movenext
if rszt.eof then
lr=lr&"
"
exit for
end if
next
if not rszt.eof then
if rszt.eof then
lr=lr&""
exit do
end if
else
lr=lr&""
exit do
end if
loop
lr=lr&"
"
rszt.close
end if
call savetext("../gx/fileimg.htm",lr)
end sub
sub gxphotoimg(zsn,hsn) '用来生成最新的电子相册
tj=""
sql="select * from menu where disp='xxlrimg.asp' or disp='XXLRIMG.ASP' order by menuname"
Set rs1=Server.CreateObject("ADODB.RecordSet")
rs1.Open sql,conn,1,1
DO WHILE NOT RS1.EOF
IF not DOWNMENU(RS1("menuname"),RS1("jb")) then
if tj="" then
tj=tj&" menuname"&rs1("jb")&" ='"&rs1("menuname")&"' "
else
tj=tj&" or menuname"&rs1("jb")&" ='"&rs1("menuname")&"' "
end if
end if
rs1.movenext
LOOP
lr=""
rs1.close
if tj<>"" then
sql="select top "&zsn&" 标题,日期,ID,IMG1,开放评论 from lr where img1<>'' and 审核状态='已' and ("&tj&") order by -id"
Set rszt=Server.CreateObject("ADODB.RecordSet")
'Response.Write sql
rszt.Open sql,conn,1,1
lr=""
do while not rszt.eof
lr=lr&""
for i=1 to int(hsn)
lr=lr&""
lr=lr&"&") "&RSZT("标题")&""
lr=lr&" | "
rszt.movenext
if rszt.eof then
lr=lr&"
"
exit for
end if
next
if not rszt.eof then
if rszt.eof then
lr=lr&""
exit do
end if
else
lr=lr&""
exit do
end if
loop
lr=lr&"
"
rszt.close
end if
call savetext("../gx/photoimg.htm",lr)
end sub
function downmenu(Mn1,Mjb) '此函数用于检测某一栏目下有没有子栏目,第一个参数是栏目名,第二个是栏目级别
MJB=MJB '如有子栏目,返回为真,没有返回为假
MN=MN1
dim rsdown
sql="select top 1 id,责任部门,不准复制 from menu where menuup='"&Mn&"' and jb='"&Mjb&"'"
Set rsdown=Server.CreateObject("ADODB.RecordSet")
rsdown.Open sql,conn,1,1
if rsdown.eof then
mybumenno=false
else
mybumenno=true
end if
rsdown.close
downmenu=mybumenno
end function
SUB NEWSP(ZSN,HSN)
SPLIST=MYSC()
FOR SCI=0 TO 29
IF SPLIST(SCI,1)="" THEN EXIT FOR
CALL GXSC(ZSn,HSN,SPLIST(SCI,6),"NEWSC"&SCI)
NEXT
END sub
function MYSC() '返回所有的商城栏目
sql="select * from menu where 挂接表 like '%商城%' order by menuname"
Set rs1=Server.CreateObject("ADODB.RecordSet")
rs1.Open sql,conn,1,1
DIM MEN(30,7)
CI=0
jtab=""
DO WHILE NOT RS1.EOF
if rs1("挂接表")&""<> jtab then
MEN(CI,1)=RS1("MENUNAME")
MEN(CI,2)=RS1("ID")
men(ci,3)=rs1("栏目管理员")
men(ci,4)=rs1("不准复制")
men(ci,5)=rs1("栏目简介")
men(ci,6)=rs1("挂接表")
CI=CI+1
jtab=rs1("挂接表")
end if
RS1.MOVENEXT
LOOP
MEN(0,3)=RS1.recordcount
RS1.CLOSE
mysc=MEN
END function
sub gxsc(zsn,hsn,tab,SCFILENAME) '用来生成最新的商品
' Response.Write zsn&"!"&hsn&tab&"
"
lr=""
sql="select top "&zsn&" 商品名,商品略图,ID from "&tab&" where 成交标志=0 and 真实性=-1 and 删除标志=0 and 审核状态='已' order by -id"
Set rszt=Server.CreateObject("ADODB.RecordSet")
' Response.Write sql
rszt.Open sql,conn,1,1
lr=""
do while not rszt.eof
lr=lr&""
for i=1 to int(hsn)
lr=lr&""
lr=lr&"&") "&RSZT("商品名")&""
lr=lr&" | "
rszt.movenext
if rszt.eof then
lr=lr&"
"
exit for
end if
next
if not rszt.eof then
if rszt.eof then
lr=lr&""
exit do
end if
else
lr=lr&""
exit do
end if
loop
lr=lr&"
"
rszt.close
call savetext("../gx/"&SCFILENAME&".htm",lr)
end sub
%>