<%
'================================================
'函数名：CreatedTextFiles
'作 用：写入文件的函数
'参 数：FileName -文件路径, body_内容
'================================================
Function CreatedTextFiles(FileName,body)
On Error Resume Next
If InStr(FileName, ":") = 0 Then FileName = Server.MapPath(FileName)
Dim oStream
Set oStream = CreateObject("ADODB.Stream")
oStream.Type = 2 '设置为可读可写
oStream.Mode = 3 '设置内容为文本
oStream.Charset = "utf-8"
oStream.Open
oStream.Position = oStream.Size
oStream.WriteText body
oStream.SaveToFile FileName, 2
oStream.Close
Set oStream = Nothing
If Err.Number <> 0 Then Err.Clear
End Function
'================================================
'最新贴子
function newsell(num,relid)
dim g,rs10
if relid<>0 then
gettest="where yc=0 and bbsid="&relid
else
gettest="where yc=0"
end if
set rs10 = server.createobject("adodb.recordset")
rs10.open"select id,bbsid,name from sell "&gettest&" order by id desc",conn,1,1
If rs10.eof Then
response.write("还没有帖子！
")
else
rs10.Move(0)
g=1
do while ((not rs10.EOF) and g <=num)
response.write""&UBB(rs10("name"))&"
"
rs10.MoveNext
g=g+1
loop
end if
rs10.close
set rs10=nothing
end function
'回复动态
function relsell(num,relid)
dim h,rs11
if relid<>0 then
gettest="where yc=0 and bbsid="&relid
else
gettest="where yc=0"
end if
set rs11 = server.createobject("adodb.recordset")
rs11.open"select id,bbsid,name from sell "&gettest&" order by retime desc",conn,1,1
If rs11.eof Then
response.write("还没有帖子！
")
else
rs11.Move(0)
h=1
do while ((not rs11.EOF) and h <=num)
response.write""&UBB(rs11("name"))&"
"
rs11.MoveNext
h=h+1
loop
end if
rs11.close
set rs11=nothing
end function
'最新精华
function jjsell(num,relid)
dim q,rs12
if relid<>0 then
gettest="where yc=0 and jj=1 and bbsid="&relid
else
gettest="where yc=0 and jj=1"
end if
set rs12 = server.createobject("adodb.recordset")
rs12.open"select id,bbsid,name from sell "&gettest&" order by ID desc",conn,1,1
If rs12.eof Then
response.write("还没有精华帖子！
")
else
rs12.Move(0)
q=1
do while ((not rs12.EOF) and q <=num)
response.write""&UBB(rs12("name"))&"
"
rs12.MoveNext
q=q+1
loop
end if
rs12.close
set rs12=nothing
end function
'最新相片
function photosell(num,relid)
dim p,rs13
set rs13 = server.createobject("adodb.recordset")
rs13.open"select * from upfile where smallstr=1 and photoview=0 order by ID desc",conn,1,1
If rs13.eof Then
response.write("还没有相片！
")
else
rs13.Move(0)
p=1
do while ((not rs13.EOF) and p <=num)
response.write("![图](/bbs/" & rs13("smallfiles") & ")
")
rs13.MoveNext
p=p+1
loop
end if
rs13.close
set rs13=nothing
end function
'标题和编辑UBB
function ubb(str)
str=trim(str)
if IsNull(str) then exit function
str = Replace(str, CHR(34), """)
str = replace(str, ">", "＞")
str = replace(str, "<", "＜")
str = replace(str, "＆", "&")
str = replace(str, "＂", """)
str = Replace(str, CHR(13), "")
str = Replace(str, CHR(10), "\\")
str = replace(str, "$", "＄")
str = replace(str, "??", "？")
str = replace(str, chr(01), "")
str = replace(str, chr(02), "")
str = replace(str, chr(03), "")
str = replace(str, chr(04), "")
str = replace(str, chr(05), "")
str = replace(str, chr(06), "")
str = replace(str, chr(07), "")
str = replace(str, chr(08), "")
str = replace(str, chr(09), "")
str = replace(str, chr(11), "")
str = replace(str, chr(12), "")
str = replace(str, chr(14), "")
str = replace(str, chr(15), "")
str = replace(str, chr(16), "")
str = replace(str, chr(17), "")
str = replace(str, chr(18), "")
str = replace(str, chr(19), "")
str = replace(str, chr(20), "")
str = replace(str, chr(21), "")
str = replace(str, chr(22), "")
str = replace(str, chr(23), "")
str = replace(str, chr(24), "")
str = replace(str, chr(25), "")
str = replace(str, chr(26), "")
str = replace(str, chr(27), "")
str = replace(str, chr(28), "")
str = replace(str, chr(29), "")
str = replace(str, chr(30), "")
str = replace(str, chr(31), "")
str=replace(str,"""","＂")
str = replace(str, "", "")
str = replace(str, "'", "”")
str = replace(str, "`", "")
str = replace(str, "€", "")
str = replace(str, "―", "-")
str=replace(str,"&","←↑→")
str=replace(str,"&","&")
str=replace(str,"←↑→","&")
str=replace(str,"'","'")
str=replace(str,"%1A","")
str=replace(str,"$","$$")
str=replace(str,"￥","*")
str=replace(str," ","")
str=replace(str,"","")
str = replace(str, " ", "")
str = replace(str, "", "")
str=replace(str," ","")
str=replace(str," ","")
str=replace(str,"","")
str=replace(str,"","")
str=replace(str,Chr(13),"
")
ubb=str
end function
function ubb1(str)
if IsNull(str) then exit function
str=trim(str)
str=replace(str,"&","&")
str = replace(str, ">", ">")
str = replace(str, "<", "<")
str=replace(str,"'","'")
str=replace(str,"""",""")
str=replace(str,"$","$$")
str=replace(str," ","")
str = replace(str, " ", "")
str = replace(str, "", "")
str=replace(str," ","")
str=replace(str," ","")
str=replace(str,"","")
str=replace(str,"","")
str=replace(str,Chr(13),"
")
str=replace(str,"(time)",""&time()&"")
str=replace(str,"(date)",""&date()&"")
str=replace(str,"(now)",""&now()&"")
str=replace(str,"(week)",""&WeekDayName(DatePart("w",Now))&"")
Set re=new RegExp
re.IgnoreCase =true
re.Global=True
re.pattern="(\(img)\)(.{5,}?)\(/img\)"
str= re.Replace(str,"![]()
")
re.Pattern="(\[IMG\])(.[^\[]*)(\[\/IMG\])"
str= re.Replace(str,"![]()
")
re.pattern="(\(URL\))(.[^\(]*)(\(\/URL\))"
str= re.Replace(str,"$2")
re.pattern="(\(URL=(.[^\(]*)\))(.[^\(]*)(\(\/URL\))"
str= re.Replace(str,"$3")
re.pattern="(\[url\])(.[^\[]*)(\[\/url\])"
str= re.Replace(str,"$2")
re.pattern="(\[url=(.[^\]]*)\])(.[^\[]*)(\[\/url\])"
str= re.Replace(str,"$3")
re.pattern="(\(c\))(.[^\[]*)(\(\/c\))"
str= re.Replace(str,"$2")
re.pattern="(\(c=(.[^\]]*)\))(.[^\[]*)(\(\/c\))"
str= re.Replace(str,"$3")
re.pattern="(\(u\))(.[^\[]*)(\(\/u\))"
str= re.Replace(str,"$2")
re.pattern="(\(b\))(.[^\[]*)(\(\/b\))"
str= re.Replace(str,"$2")
re.pattern="(\(i\))(.[^\[]*)(\(\/i\))"
str= re.Replace(str,"$2")
re.Pattern="(\\\\)"
str= re.Replace(str,"
")
set re=Nothing
ubb1=str
end function
%>