<%''session.codepage=936
''response.charset="gb2312"
session.timeout=240
''Server.ScriptTimeOut=300
bwlj = "http://" + request.servervariables("server_name") + request.servervariables("url")
ybwlj = bwlj & "?" & Request.QueryString
cs = replace(bwlj,"http://","")
if instr(cs,"/")>0 then bwlj = left(bwlj,instrrev(bwlj,"/")-1)
function clwjm(wjm)
if len(wjm)>20 then xszt = left(wjm,20)
xszt = replace(xszt," ","-")
xszt = replace(xszt,"!","")
xszt = replace(xszt,",","")
xszt = replace(xszt,"，","")
xszt = replace(xszt,".","")
xszt = replace(xszt,"。","")
xszt = replace(xszt,"！","")
xszt = replace(xszt,"?","")
xszt = replace(xszt,"<","")
xszt = replace(xszt,">","")
xszt = replace(xszt,":","")
xszt = replace(xszt,"""","")
xszt = replace(xszt,"/","")
xszt = replace(xszt,"\\","")
clwjm = ""
end function
Function CheckDir(byval FolderPath)
dim fso
Set fso = Server.CreateObject("Scripting.FileSystemObject")
If fso.FolderExists(Server.MapPath(folderpath)) then
''存在
CheckDir = True
Else
''不存在
CheckDir = False
End if
Set fso = nothing
End Function
Function CopyMyFolder(FolderName,FolderPath)
sFolder=server.mappath(FolderName)
oFolder=server.mappath(FolderPath)
set fso=server.createobject("scripting.filesystemobject")
if fso.folderexists(server.mappath(FolderName)) Then'检查原文件夹是否存在
if fso.folderexists(server.mappath(FolderPath)) Then'检查目标文件夹是否存在
fso.copyfolder sFolder,oFolder
Else
CreateNewFolder = Server.Mappath(FolderPath)
fso.CreateFolder(CreateNewFolder)
fso.copyfolder sFolder,oFolder
End if
end if
End Function
Function Copyfile(FolderName,FolderPath)
sFolder=server.mappath(FolderName)
oFolder=server.mappath(FolderPath)
Set fs = CreateObject("Scripting.FileSystemObject")
If fs.FileExists(sFolder) Then
fs.copyfile sFolder,oFolder
end if
set fs=nothing
End Function
Function MakeNewsDir(byval foldername)
on error resume next
dim fso
MakeNewsDir = false
Set fso = Server.CreateObject("Scripting.FileSystemObject")
fso.CreateFolder(Server.MapPath(foldername))
If fso.FolderExists(Server.MapPath(foldername)) Then
MakeNewsDir = True
Else
MakeNewsDir = False
End If
Set fso = nothing
End Function
set conn=server.createobject("adodb.connection")
conn.open "Provider=Microsoft.Jet.OLEDB.4.0;User Id=admin;jet OleDB:Database Password=;Data Source="&Server.MapPath("db/#gbbsdb.mdb")
function close_conn()
conn.close
set conn=nothing
end function
Function dirSize(ml)
Set MyFileSize = Server.CreateObject ("Scripting.FileSystemObject")
MyPath = Server.MapPath("pro")
Set MyFolder = MyFileSize.GetFolder(MyPath)
aaa = cstr(MyFolder.Size/1024/1024)
if left(aaa,1)="." then
dirSize = "0" + left(aaa,4)
else
dirSize = left(aaa,4)
end if
End Function
function user(cc)%>
<%set rs = server.createobject("adodb.recordset")
exec="SELECT top "&cstr(cc)&" yhm,count(yhm) as gs FROM yrwl_tb_dlxx GROUP BY yhm ORDER BY count(yhm) DESC"
rs.open exec,CONN,3,1
while not rs.eof
yhm = rs("yhm")
cs = rs("gs")%>
<%rs.movenext
wend%>
<%rs.close
set rs=nothing
end function
function userlist(gs,cc)%>
<%set rs = server.createobject("adodb.recordset")
exec="SELECT top "&cstr(cc)&" yhm,count(yhm) as gs FROM yrwl_tb_dlxx GROUP BY yhm ORDER BY count(yhm) DESC"
rs.open exec,CONN,3,1
i = 1
while not rs.eof
yhm = rs("yhm")
cs = rs("gs")%>
<%=yhm%> 登陆<%=cs%>次
<%if i = gs then
response.write " "
i = 1
end if
i = i+1
rs.movenext
wend%>
<%rs.close
set rs=nothing
end function
sub sybbs(gs,tj,ys,issj)%>
<%set rs = server.createobject("adodb.recordset")
if instr(tj,"id")>0 then
stj = "order by id desc"
else
stj = "order by dj desc"
end if
exec="select top "&cstr(tjgs)&" dj,zhhf,lt.id,zt,furl from yrwl_tb_lt lt where lt.id >=(SELECT Min(id) FROM (SELECT TOP "&cstr(tjgs)&" id,dj FROM yrwl_tb_lt where zid='s'"&tj&") A) and zid='s'"&tj
response.write ""
rs.open exec,CONN,3,1
while not rs.eof
furl = rs("furl")
zt = rs("zt")
if instr(zt,"font")>0 then
hzt = left(zt,len(zt)-7)
if len(hzt)>20 then zt = right(hzt,len(hzt)-20)
zt = replace(zt,"<","<")
zt = replace(zt,"<",">")
else
if len(zt) >= gs then zt = left(zt,gs)&"."
end if
if issj<>"" then
zhhf = rs("zhhf")
sj = left(zhhf,8)
end if
id = rs("id")
dj = rs("dj")%>
<%
rs.movenext
wend
rs.close
set rs=nothing
end sub
function newuser(cc,style_css,ys)
if style_css<>"" then
style_css = "class="""+style_css+""""
end if%>
>
<%set rs = server.createobject("adodb.recordset")
exec="SELECT top "+cstr(cc)+" yhm,sj FROM yrwl_tb_admin order by id DESC"
rs.open exec,CONN,3,1
while not rs.eof
yhm = rs("yhm")
sj = left(rs("sj"),8)%>
<%rs.close
set rs=nothing
end function
function voteuser(cc)%>
<%set rs = server.createobject("adodb.recordset")
exec="SELECT top "+cstr(cc)+" yhm,sj,ck FROM yrwl_tb_dlxx where ck like '%参与%调查%' order by id DESC"
rs.open exec,CONN,3,1
while not rs.eof
yhm = rs("yhm")
ck = rs("ck")
sj = left(rs("sj"),8)%>
<%rs.movenext
wend%>
<%rs.close
set rs=nothing
end function
function linksh(gs,lx,zt)%>
<%set rs = server.createobject("adodb.recordset")
if lx <>"" then tj = "and lx='"+lx+"'"
exec="select top "&cstr(gs)&" * from yrwl_tb_link where 1=1 "&tj&" order by str(px)"
rs.open exec,CONN,3,1
gs = rs.recordcount
while not rs.eof
link1 = rs("uri")
logo1 = rs("logo")
sm = rs("name")%>
<%rs.movenext
wend
rs.close
set rs=nothing
end function
Function GetURL(url)
Set Retrieval = CreateObject("Microsoft.XMLHTTP")
With Retrieval
.Open "GET", url, False
.Send
if len(.responsebody) > 5 then
GetURL = bytes2bstr(.responsebody)
else
GetURL = ""
end if
End With
Set Retrieval = Nothing
End Function
function bytes2bstr(vin)
strreturn = ""
for i = 1 to lenb(vin)
thischarcode = ascb(midb(vin,i,1))
if thischarcode < &h80 then
strreturn = strreturn & chr(thischarcode)
else
nextcharcode = ascb(midb(vin,i+1,1))
strreturn = strreturn & chr(clng(thischarcode) * &h100 + cint(nextcharcode))
i = i + 1
end if
next
bytes2bstr = strreturn
end function
function kill_keyword(txt)
kill = keyword_kill
kill = split(kill,",")
for i = 0 to ubound(kill)
headk = ""
killx = ""
if instr(txt,kill(i))>0 then
headk = left(kill(i),1)
for jc=1 to len(kill(i))-1
killx = killx + "*"
next
txt = replace(txt,kill(i),headk + killx)
end if
next
kill_keyword = txt
end function
function plid(id)
if right( id , 1) = "," then
plid = left(id , len(id) - 1)
end if
end function
function wj_del(filename)
Dim fso
Set fso = CreateObject("Scripting.FileSystemObject")
ywjm = filename
filename=Server.mappath(filename)
if fso.fileExists(filename) then fso.DeleteFile filename
call back("xxfh","删除" & ywjm & "成功！")
end function
function chrzh(zh)
if zh<>"" then
zh = trim(zh)
ch = split(zh,",")
for i = 0 to ubound(ch)
strz = strz + chr(ch(i))
next
end if
chrzh = strz
end function
Function bzrq()
sxsj = "0" + right(cstr(year(date())),1)
sx_y = cstr(month(date()))
if len(trim(sx_y)) = 1 then sx_y = "0" + sx_y
sx_r = cstr(day(date()))
if len(trim(sx_r)) = 1 then sx_r = "0" + sx_r
bzrq= sxsj + "-" + sx_y + "-" + sx_R
end function
function asczh(zh)
if zh<>"" then
zh = trim(zh)
for i =1 to len(zh)
zz = cstr(mid (zh,i,1))
stt = stt + "," + cstr(asc(zz))
next
end if
asczh = right(stt,len(stt)-1)
end function
sub pagefy(page,zys,url) ''page 当前页 zys 总页数 URL 当前页URL
if instr(url,"?") > 0 then
tj = url + "&"
else
tj = url + "?"
end if
if page > zys then page = zys
if page = 1 then
sypage = 1
xypage = 1 + 1
else
sypage = page - 1
xypage = page + 1
end if
response.write "
<%=yhm%> 登陆<%=cs%>次
<%if i = gs then
response.write "