user.asp

一个最新最时尚的采用ASP开发的基于数据库的网络办公系统

<%
'on error resume next
if trim(Application("ConnectionString"))="" or trim(Application("ConnectionString"))<>"driver={Microsoft Access Driver (*.mdb)};DBQ=" & server.MapPath("data/bbs.asp") & ";uid=;PWD=;" then
  Application("ConnectionString")="driver={Microsoft Access Driver (*.mdb)};DBQ=" & server.MapPath("data/bbs.asp") & ";uid=;PWD=;"
end if
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 ReplaceTest(patrn,str,replStr)
  'Dim regEx, str1				' 建立变量。
  'str1=trim(str)
  'Set regEx = New RegExp			' 建立正则表达式。
  'regEx.Pattern = patrn				' 设置模式。
  'regEx.IgnoreCase = true			' 设置是否区分大小写。
  'ReplaceTest = regEx.Replace(str1, replStr)
  'set regEx=nothing                     	' 作替换。
End Function
function UBB(str)
 dim i,temp
 i=1
 temp=""
 do while instr(i,str,"[/")>=1
  if trim(temp)="" then
   temp=ReplaceTest("(\[i])(\S+)(\[/i])",str,"<i>$2</i>")
  else
   temp=ReplaceTest("(\[i])(\S+)(\[/i])",temp,"<i>$2</i>")
  end if
  temp=ReplaceTest("(\[b])(\S+)(\[/b])",temp,"<b>$2</b>")
  temp=ReplaceTest("(\[big])(\S+)(\[/big])",temp,"<big>$2</big>")
  temp=ReplaceTest("(\[strike])(\S+)(\[/strike])",temp,"<strike>$2</strike>")
  temp=ReplaceTest("(\[strike])(\S+)(\[/strike])",temp,"<del>$2</del>")
  temp=ReplaceTest("(\[sub])(\S+)(\[/sub])",temp,"<sub>$2</sub>")
  temp=ReplaceTest("(\[sup])(\S+)(\[/sup])",temp,"<sup>$2</sup>")
  temp=ReplaceTest("(\[pre])(\S+)(\[/pre])",temp,"<pre>$2</pre>")
  temp=ReplaceTest("(\[u])(\S+)(\[/u])",temp,"<u>$2</u>")
  temp=ReplaceTest("(\[small])(\S+)(\[/small])",temp,"<small>$2</small>")
  temp=ReplaceTest("(\[h1])(\S+)(\[/h1])",temp,"<h1>$2</h1>")
  temp=ReplaceTest("(\[h2])(\S+)(\[/h2])",temp,"<h2>$2</h2>")
  temp=ReplaceTest("(\[h3])(\S+)(\[/h3])",temp,"<h3>$2</h3>")
  temp=ReplaceTest("(\[h4])(\S+)(\[/h4])",temp,"<h4>$2</h4>")
  temp=ReplaceTest("(\[h5])(\S+)(\[/h5])",temp,"<h5>$2</h5>")
  temp=ReplaceTest("(\[h6])(\S+)(\[/h6])",temp,"<h6>$2</h6>")
  temp=ReplaceTest("(\[red])(\S+)(\[/red])",temp,"<font color=red>$2</font>")
  '
  '这里可以增加新的UBB代码的实现模版
  '
  temp=ReplaceTest("(\[email])(\S+)(\[/email])",temp,"<a href=""mailto:$2"" target=_top>$2</a>")
  temp=ReplaceTest("(\[img])(\S+)(\[/img])",temp,"<img src=""$2"">")
  temp=ReplaceTest("(\[url])(\S+)(\[/url])",temp,"<a href=""$2"" target=_top style=""color:blue"">$2</a>")
  temp=ReplaceTest("(\[#(\S+)])(\S+)(\[/#])",temp,"<font color=$1>$3</font>")
  i=i+1
 loop
 if trim(temp)<>"" then
  UBB=temp
 else
  UBB=str
 end if
end function

Function SetOperateLog(act,content,uid,ip,udate)
 dim connOP,strsql
 strSQL=""
 set connOP=server.CreateObject("ADODB.connection")
 connOP.ConnectionString=Application("ConnectionString")
 connOP.Open
 strSQL="insert into syslog(act,content,uid,ip,udate) values('" & trim(act) & "','" & trim(content) & "','" & trim(uid) & "','" & trim(ip) & "',now())"
 connOP.execute strSQL
 set connOP=nothing
End function

Function SetLogonLog(uid,pwd,ip,date,succ)
 dim connlog,strsql
 set connlog=server.CreateObject("ADODB.connection")
 connlog.ConnectionString=Application("ConnectionString")
 connlog.Open
 if trim(succ)="1" then
  strSQL="insert into logonlog(logonid,logonpwd,logonIP,logondate,succ) values('" & trim(uid) & "','" & trim("******") & "','" & trim(ip) & "',now(),'" & trim(succ) & "')"
 else
  strSQL="insert into logonlog(logonid,logonpwd,logonIP,logondate,succ) values('" & trim(uid) & "','" & trim(pwd) & "','" & trim(ip) & "',now(),'" & trim(succ) & "')"
 end if
 'response.write strsql
 connlog.execute strSQL
 
 set connlog=nothing
End function

Function IsADI(userid)
dim user,i
i=0
    user=split(application("sa"),",") '获得ADI
    for i=0 to ubound(user) '获得非空的在线用户列表
       if trim(user(i))<>"" and trim(user(i))=trim(userid) then
          IsADI=1
          exit function
       end if
    next
    IsADI=0
end function

Function IsExist(userid)
dim user,i
i=0
    user=split(application("onlineuser"),",") '获得ADI
    for i=0 to ubound(user) '获得非空的在线用户列表
       if trim(user(i))<>"" and trim(user(i))=trim(userid) then
          IsExist=1
          exit function
       end if
    next
    IsExist=0
end function
'***********************************
'得到最热门的版面
'
'***********************************
function GetHotBoard()
 dim temp
 set connGH=server.CreateObject("ADODB.connection")
 connGH.ConnectionString=Application("ConnectionString")
 connGH.Open
 
 set recGH=server.CreateObject("ADODB.recordset")
 strSQL="select top 3 * from board order by bfiles desc,bname desc"
 recGH.Open strSQL,connGH,1,1
 redim temp(3)
 i=0
 do while not recGH.EOF 
   temp(i)="<a href='bbsshowtopic.asp?bid=" & trim(recGH("bid")) & "&aid=" & trim(recGH("aid")) & "'>" & trim(recGH("bname")) & "</a>"
   recGH.MoveNext 
   i=i+1
 loop
 recGh.Close 
 set recGH=nothing
 set connGH=nothing
 GetHotBoard=temp(0) & "," & temp(1) & "," & temp(2)
end function
'***********************************
'生成超级连接http
'要在ShowDocToRead()之後调用!!
'***********************************
function ChgToHttp(str)
'dim i,start,endof,temp,all

'i=0
'start=0
'endof=0
'all=len(str)
'redim temp(50)
'start=instr(1,ucase(str),"HTTP://")
'do while start<=all and i<49
'   if start<=1 then
'    exit do
'   else
'    endof=instr(start,str,"&nbsp;")
'    if endof<=all and endof>start then
'     length=clng(endof-start)
'     temp(i)=mid(str,start,length)
'     i=i+1
'     start=instr(endof,ucase(str),"HTTP://")
'    else
'     exit do 
'    end if 
'   end if
'loop
'for i=0 to ubound(temp)
'  str=replace(str,temp(i),"<a href='" & temp(i) & "' target='_blank' style='A:link{color:blue;}'><font color=blue>" & temp(i) & "</font></a>")
'next
ChgToHttp=str
end function

'***********************************
'生成超级连接<IMG>
'要在ShowDocToRead()之後调用!!
'***********************************
function ChgToImg(str)
dim i,start,endof,temp,all

str=ChgToTag(str)

i=0
start=0
endof=0
all=len(str)
redim temp(50)
start=instr(1,ucase(str),"[IMG")
do while start<=all and i<49
   if start<=1 then
    exit do
   else
    endof=instr(start,str,"]")
    if endof<=all and endof>=start then
     length=clng(endof-start)
     temp(i)=mid(str,start,length)
     i=i+1
     start=instr(endof,ucase(str),"[IMG")
    else
     exit do 
    end if 
   end if
loop
for i=0 to ubound(temp)
  ok=replace(temp(i),"[","<")
  ok=replace(ok,"]",">")
  ok=replace(ok,"&nbsp;"," ")
  str=replace(str,temp(i),ok)
  
next
ChgToImg=str
end function

'***********************************
'生成各种标签
'要在ShowDocToRead()之後调用!!
'***********************************
function ChgToTag(str)

  str=replace(str,":)","<IMG border=0 height=15 src=""images/face/smile.gif"" width=15>")
  str=replace(str,":(","<IMG border=0 height=15 src=""images/face/frown.gif"" width=15>")
  str=replace(str,":o","<IMG border=0 height=15 src=""images/face/redface.gif"" width=15>")
  str=replace(str,":D","<IMG border=0 height=15 src=""images/face/biggrin.gif"" width=15>")
  str=replace(str,";)","<IMG border=0 height=15 src=""images/face/wink.gif"" width=15>")
  str=replace(str,":a","<IMG border=0 height=15 src=""images/face/blue.gif"" width=15>")
  str=replace(str,":b","<IMG border=0 height=15 src=""images/face/shy.gif"" width=15>")
  str=replace(str,":c","<IMG border=0 height=15 src=""images/face/sleepy.gif"" width=15>")
  str=replace(str,":d","<IMG border=0 height=15 src=""images/face/sunglasses.gif"" width=15>")
  str=replace(str,":e","<IMG border=0 height=15 src=""images/face/supergrin.gif"" width=15>")
  str=replace(str,":f","<IMG border=0 height=15 src=""images/face/embarass.gif"" width=15>")
  str=replace(str,":g","<IMG border=0 height=15 src=""images/face/dead.gif"" width=15>")
  str=replace(str,":h","<IMG border=0 height=15 src=""images/face/cool.gif"" width=15>")
  str=replace(str,":i","<IMG border=0 height=15 src=""images/face/pukey.gif"" width=15>")
  str=replace(str,":j","<IMG border=0 height=15 src=""images/face/surprised.gif"" width=15>")
  str=replace(str,":k","<IMG border=0 height=15 src=""images/face/clown.gif"" width=15>")
  str=replace(str,":l","<IMG border=0 height=15 src=""images/face/wink2.gif"" width=15>")
  
  
  str=replace(str,"[hr]","<hr>")
  str=replace(str,"[Hr]","<hr>")
  str=replace(str,"[hR]","<hr>")
  str=replace(str,"[HR]","<hr>")

'生成粗体标签
  str=replace(str,"[b]","<b>")
  str=replace(str,"[/b]","</b>")
  str=replace(str,"[B]","<B>")
  str=replace(str,"[/B]","</B>")

'生成黑色标签
  str=replace(str,"[black]","<font color=black>")
  str=replace(str,"[/black]","</font>")
  str=replace(str,"[BLACK]","<font color=black>")
  str=replace(str,"[/BLACK]","</font>")

'生成红色标签
  str=replace(str,"[red]","<font color=red>")
  str=replace(str,"[/red]","</font>")
  str=replace(str,"[RED]","<font color=red>")
  str=replace(str,"[/RED]","</font>")

'生成蓝色标签
  str=replace(str,"[blue]","<font color=blue>")
  str=replace(str,"[/blue]","</font>")
  str=replace(str,"[BLUE]","<font color=blue>")
  str=replace(str,"[/BLUE]","</font>")

'生成白色标签
  str=replace(str,"[white]","<font color=white>")
  str=replace(str,"[/white]","</font>")
  str=replace(str,"[WHITE]","<font color=white>")
  str=replace(str,"[/WHITE]","</font>")

'生成绿色标签
  str=replace(str,"[green]","<font color=green>")
  str=replace(str,"[/green]","</font>")
  str=replace(str,"[GREEN]","<font color=green>")
  str=replace(str,"[/GREEN]","</font>")

'
  str=replace(str,"[gray]","<font color=gray>")
  str=replace(str,"[/gray]","</font>")
  str=replace(str,"[GRAY]","<font color=gray>")
  str=replace(str,"[/GRAY]","</font>")

'生成黄色标签
  str=replace(str,"[yellow]","<font color=yellow>")
  str=replace(str,"[/yellow]","</font>")
  str=replace(str,"[YELLOW]","<font color=yellow>")
  str=replace(str,"[/YELLOW]","</font>")

'生成紫色标签
  str=replace(str,"[purple]","<font color=purple>")
  str=replace(str,"[/purple]","</font>")
  str=replace(str,"[PURPLE]","<font color=purple>")
  str=replace(str,"[/PURPLE]","</font>")

'生成色标签
  str=replace(str,"[olive]","<font color=olive>")
  str=replace(str,"[/olive]","</font>")
  str=replace(str,"[OLIVE]","<font color=olive>")
  str=replace(str,"[/OLIVE]","</font>")

'生成色标签
  str=replace(str,"[navy]","<font color=navy>")
  str=replace(str,"[/navy]","</font>")
  str=replace(str,"[NAVY]","<font color=navy>")
  str=replace(str,"[/NAVY]","</font>")

'生成色标签
  str=replace(str,"[aqua]","<font color=aqua>")
  str=replace(str,"[/aqua]","</font>")
  str=replace(str,"[AQUA]","<font color=aqua>")
  str=replace(str,"[/AQUA]","</font>")

'生成色标签
  str=replace(str,"[lime]","<font color=lime>")
  str=replace(str,"[/lime]","</font>")
  str=replace(str,"[LIME]","<font color=lime>")
  str=replace(str,"[/LIME]","</font>")

'生成色标签
  str=replace(str,"[maroon]","<font color=maroon>")
  str=replace(str,"[/maroon]","</font>")
  str=replace(str,"[MAROON]","<font color=maroon>")
  str=replace(str,"[/MAROON]","</font>")

'生成色标签
  str=replace(str,"[teal]","<font color=teal>")
  str=replace(str,"[/teal]","</font>")
  str=replace(str,"[TEAL]","<font color=teal>")
  str=replace(str,"[/TEAL]","</font>")

'生成色标签
  str=replace(str,"[fuchsia]","<font color=fuchsia>")
  str=replace(str,"[/fuchsia]","</font>")
  str=replace(str,"[FUCHSIA]","<font color=fuchsia>")
  str=replace(str,"[/FUCHSIA]","</font>")

ChgToTag=str
end function


'***********************************
'过滤字符串中的非法字符
'
'***********************************
function detect(str)
end function

'***********************************
'显示随机问候语
'
'***********************************
function Greeting()
   if time()>=#6:00:00# and time()<#7:00:00# then
     Greeting="这麽早啊,吃过饭了吗?*_^"
   end if
   if time()>=#7:00:00# and time()<#8:00:00# then
     Greeting="就要上班了,还在上网?"
   end if
   if time()>=#8:00:00# and time()<#12:00:00# then
     Greeting="小心,老板在向你靠近喔...@_@"
   end if
   if time()>=#12:00:00# and time()<#13:00:00# then
     Greeting="锄禾日党午,肚子在敲鼓..."
   end if
   if time()>=#13:00:00# and time()<#14:00:00# then
     Greeting="不睡午觉不累麽?@_@"
   end if
   if time()>=#14:00:00# and time()<#16:00:00# then
     Greeting="下午好啊!"
   end if
   if time()>=#16:00:00# and time()<#17:00:00# then
     Greeting="快下班喽,呵呵"
   end if
   if time()>=#17:00:00# and time()<#19:00:00# then
     Greeting="下班了,还在公司加班啊?"
   end if
   if time()>=#19:00:00# and time()<#21:00:00# then
     Greeting="上网的感觉真好!"
   end if
   if time()>=#21:00:00# and time()<#22:00:00# then
     Greeting="晚上好喔!"
   end if
   if time()>=#22:00:00# and time()<#23:59:00# then
     Greeting="长夜漫漫,寂莫无眠......"
   end if
   if time()>=#00:00:00# and time()<#3:00:00# then
     Greeting="黎明前的黑暗.....好困啊!"
   end if
   if time()>=#3:00:00# and time()<#6:00:00# then
     Greeting="早上好!"
   end if
end function

'************************************
'发送邮件给某个用户
'************************************
function SendMailToUser(userid,subject,content,author)
 if trim(subject)="" or trim(content)="" then
   exit function
 end if
 if subject="" then
   subject="无主题"
 else
   subject=replace(subject,"'","''",1)  
   subject=replace(subject,"<","＜",1)
   subject=replace(subject,">","＞",1)
 end if
 if content="" then
   content="无内容"
 else
   content=replace(content,"'","''",1)  
   content=replace(content,"<","＜",1)
   content=replace(content,">","＞",1)
 end if
 if author="" then
   author="匿名"
 else
   author=replace(author,"'","''",1)  
   author=replace(author,"<","＜",1)
   author=replace(author,">","＞",1)
 end if
 
 set connSU=server.CreateObject("ADODB.connection")
 connSU.ConnectionString=Application("ConnectionString")
 connSU.Open

 from="系统管理员"
 who=trim(userid) 
 strSQL="insert into mailbox(uid,content,sendname,senddate,subject,isnew) values('" & who & "','" & content & "','" & from & "',now(),'" & subject & "',1)" 
 connSU.Execute strSQL,counts
 
 set connSU=nothing 
 
 SendMailToUser=counts

end function


'**************************************
function SendMailToAuthor(userid,subject,content,author,from)
 if trim(subject)="" or trim(content)="" then
   exit function
 end if
 if subject="" then
   subject="无主题"
 else
   subject=replace(subject,"'","''",1)  
   subject=replace(subject,"<","＜",1)
   subject=replace(subject,">","＞",1)
 end if
 if content="" then
   content="无内容"
 else
   content=replace(content,"'","''",1)  
   content=replace(content,"<","＜",1)