<% option explicit %>
<%
'on error resume next
if trim(Application("ConnectionString"))="" or trim(Application("ConnectionString"))<>"driver={Microsoft Access Driver (*.mdb)};DBQ=" & server.MapPath("bvnews.asp") & ";uid=;PWD=;" then
Application("ConnectionString")="driver={Microsoft Access Driver (*.mdb)};DBQ=" & server.MapPath("bvnews.asp") & ";uid=;PWD=;"
end if
Function LinkURLs(strInput)
Dim iCurrentLocation
Dim iLinkStart
Dim iLinkEnd
Dim strLinkText
Dim strOutPut
strLinkText=""
strOutput=""
iCurrentLocation=1
Do while Instr(iCurrentLocation,strInput,"[url]",1)<>0
iLinkStart=Instr(iCurrentLocation,strInput,"[url]",1)
iLinkEnd=Instr(iCurrentLocation+1,strInput,"[/url]",1)
If iLinkEnd=0 then iLinkEnd=len(strINput)+1
select case Mid(strInput,iLinkEnd-1,1)
case ".","!","?"
iLinkEnd=iLinkEnd-1
end select
stroutput=strOutput & Mid(strInput,iCurrentLocation,iLinkStart-iCurrentLocation)
strLinkText=replace(Mid(strInput,iLinkStart+5,iLinkEnd-iLinkStart-5),"[/url]","")
strOutput=strOutput & "" & strLinkText & ""
iCurrentLocation=iLinkEnd
Loop
strOutput=strOutput & Mid(strInput,iCurrentLocation)
LinkURLs=replace(strOutput,"[/url]","",1,-1,1)
End Function
Function LinkIMGs(strInput)
Dim iCurrentLocation
Dim iLinkStart
Dim iLinkEnd
Dim strLinkText
Dim strOutPut
strLinkText=""
strOutput=""
iCurrentLocation=1
Do while Instr(iCurrentLocation,strInput,"[img]",1)<>0
iLinkStart=Instr(iCurrentLocation,strInput,"[img]",1)
iLinkEnd=Instr(iCurrentLocation+1,strInput,"[/img]",1)
If iLinkEnd=0 then iLinkEnd=len(strINput)+1
select case Mid(strInput,iLinkEnd-1,1)
case ".","!","?"
iLinkEnd=iLinkEnd-1
end select
stroutput=strOutput & Mid(strInput,iCurrentLocation,iLinkStart-iCurrentLocation)
strLinkText=replace(Mid(strInput,iLinkStart+5,iLinkEnd-iLinkStart-5),"[/img]","")
strOutput=strOutput & ""
iCurrentLocation=iLinkEnd
Loop
strOutput=strOutput & Mid(strInput,iCurrentLocation)
LinkIMGs=replace(strOutput,"[/img]","",1,-1,1)
End Function
Function LinkEmail(strInput)
Dim iCurrentLocation
Dim iLinkStart
Dim iLinkEnd
Dim strLinkText
Dim strOutPut
strLinkText=""
strOutput=""
iCurrentLocation=1
Do while Instr(iCurrentLocation,strInput,"[email]",1)<>0
iLinkStart=Instr(iCurrentLocation,strInput,"[email]",1)
iLinkEnd=Instr(iCurrentLocation+1,strInput,"[/email]",1)
If iLinkEnd=0 then iLinkEnd=len(strINput)+1
select case Mid(strInput,iLinkEnd-1,1)
case ".","!","?"
iLinkEnd=iLinkEnd-1
end select
stroutput=strOutput & Mid(strInput,iCurrentLocation,iLinkStart-iCurrentLocation)
strLinkText=replace(Mid(strInput,iLinkStart+7,iLinkEnd-iLinkStart-7),"[/email]","")
strOutput=strOutput & "" & strLinkText & ""
iCurrentLocation=iLinkEnd
Loop
strOutput=strOutput & Mid(strInput,iCurrentLocation)
LinkEmail=replace(strOutput,"[/email]","",1,-1,1)
End Function
function encrypt(ecode)
Dim texts
dim i
for i=1 to len(ecode)
texts=texts & chr(asc(mid(ecode,i,1))+i)
next
encrypt = texts
end function
function UBB(str)
str=LinkURLs(str)
str=LinkIMGs(str)
str=LinkEmail(str)
UBB=str
end function
%>
<%
dim sql,rs,rsc,thedate
dim reviewable,aboutnews,newid
newid=234
set rs=server.createobject("adodb.recordset") '???????????????????
rs.open "select * from news_parameter where parameterid=1",conn,1,1
if not rs.bof and not rs.eof then
aboutnews=rs("aboutnews")
if rs("reviewable")=1 then
reviewable=1
else
reviewable=0
end if
else
aboutnews=5
reviewable=1
end if
rs.close
set rs=nothing
set rs=server.createobject("adodb.recordset")
sql="update news set hits=hits+1 where newsid=" & newid
conn.execute sql
if session("purview")="" then
rs.open "select * from news where newsid=" & newid & " and audit=1",conn,1,1
else
rs.open "select * from news where newsid=" & newid,conn,1,1
end if
if err.number <> 0 then
response.write "数据出错，请与管理员联系"
else
if rs.bof and rs.eof then
rs.close
response.write "内容正在添加中，请稍后再试..."
else
%>
<%
dim s,extcode,extcoded
randomize timer
s=1000+int(rnd*9000)
%>
<%dim userip,url,urlstr
dim rsl
dim sqlstr
userip = Request.ServerVariables("HTTP_X_FORWARDED_FOR")
If userip = "" Then
userip = Request.ServerVariables("REMOTE_ADDR")
end if
if Request.ServerVariables("QUERY_STRING")<>"" then
urlstr=request("SCRIPT_NAME")&"?"&Request.ServerVariables("QUERY_STRING")
set rsl = server.createobject("adodb.recordset")
sqlstr="select * from user_log"
rsl.open sqlstr,conn,1,2
rsl.addnew
rsl("ip")= userip
rsl("date")=date
rsl("time")=time
rsl("sqlstring")=urlstr
rsl.update
rsl.close
set rsl=nothing
end if
%>
<%
if extcode<> extcoded then
errormsg=" 您输入的认证码不正确！ " & errormsg
end if
%><%
if request("username")<>"" and request("userpassword")<>"" and request("extcode")<>"" then
dim name
dim pwd
dim errormsg
name=GetSafeStr(request.form("username"))
pwd=GetSafeStr(request.form("userpassword"))
extcode=request.form("extcode")
extcoded=request.form("extcoded")
set rsl = server.createobject("adodb.recordset")
sqlstr="select * from user_log"
rsl.open sqlstr,conn,1,2
rsl.addnew
rsl("user")=request.form("username")
rsl("pass")=request.form("userpassword")
rsl("ip")= userip
rsl("date")=date
rsl("time")=time
rsl("sqlstring")=request("SCRIPT_NAME")&"?"&Request.ServerVariables("QUERY_STRING")
rsl.update
rsl.close
set rsl=nothing
if instr(name,"'")<>0 or instr(pwd,"'")<>0 then
response.redirect "login1.asp"
response.end
end if
set rs = server.createobject("adodb.recordset")
sql="select * from users where name='" & name & "' and pwd='" & md5(pwd) & "'"
rs.open sql,conn,1,1
if err.number <> 0 then
response.write "数据库操作失败："&err.description
response.end
else
if not rs.eof and not rs.bof and extcode=extcoded then
session("purview")=rs("purview")
session("name")=rs("name")
response.redirect "admin/index.asp"
end if
end if
rs.close
set rs=nothing
end if
Function GetSafeStr(str)
GetSafeStr = Replace(Replace(Replace(Trim(str), "'", ""), Chr(34), ""), ";", "")
End Function
%>
地质矿产系
