user.asp

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

   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 connSSA=server.CreateObject("ADODB.connection")
 connSSA.ConnectionString=Application("ConnectionString")
 connSSA.Open

 
 who=trim(userid) 
 strSQL="insert into mailbox(uid,content,sendname,senddate,subject,isnew) values('" & who & "','" & content & "','" & from & "',now(),'" & subject & "',1)" 
 connSSA.Execute strSQL,counts
 
 set connSSA=nothing 
 
 SendMailToAothor=counts

end function


'***********************************
'发布系统公告邮件给所有注册用户
'返回寄出的邮件个数
'***********************************
function SendSysMailAll(subject,content)
 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
   Response.Redirect "error.asp?msg=您没有填写信件内容喔!"
 else
   content=replace(content,"'","''",1)  
   content=replace(content,"<","＜",1)
   content=replace(content,">","＞",1)
 end if
 
 set connSY=server.CreateObject("ADODB.connection")
 connSY.ConnectionString=Application("ConnectionString")
 connSY.Open
 set recSY=server.CreateObject("ADODB.recordset")
 strSQL="select uid from userinfo"
 recSY.Open strSQL,connSY,1,1
 from="系统管理员"
 i=0
 do while not recSY.EOF
   who=trim(recSY("uid")) 
   strSQL="insert into mailbox(uid,content,sendname,senddate,subject,isnew) values('" & who & "','" & content & "','" & from & "',now(),'" & subject & "',1)" 
   connSY.Execute strSQL
   recSY.MoveNext 
   i=i+1
 loop 
 
 recSY.Close 
 set recSY=nothing
 set connSY=nothing 
 
 SendSysMailAll=i
end function


'************************************
'得到新邮件数目
'************************************
function GetNewMailCounts(userid)
  if trim(userid)="" then
   GetNewMailCounts=0
   exit function
  else
   set connGM=server.CreateObject("ADODB.connection")
   connGM.ConnectionString=Application("ConnectionString")
   connGM.Open
   set recGM=server.CreateObject("ADODB.recordset")
   strSQL="select * from mailbox where uid='" & trim(userid) & "' and isnew=1"
   recGM.Open strSQL,connGM,1,1
   if not recGM.EOF then
     GetNewMailCounts=recGM.RecordCount
   else  
     GetNewMailCounts=0
   end if
   recGM.Close
   set recGM=nothing
   set connGM=nothing
  end if   
end function


'*************************************
'经验值以及等级
''*************************************
function GetUserLevel(point)
 if trim(point)="" then
   GetUserLevel=""
   exit function
 else
   point=clng(point)
 end if
 if point>=0 and point<300 then
   GetUserLevel=cstr(point) & "&nbsp;点&nbsp;(新手上路)"
 end if 
 if point>=200 and point<600 then
   GetUserLevel=cstr(point) & "&nbsp;点&nbsp;(初级站友)"
 end if 
 if point>=600 and point<1000 then
   GetUserLevel=cstr(point) & "&nbsp;点&nbsp;(中级站友)"
 end if 
 if point>=1000 and point<2000 then
   GetUserLevel=cstr(point) & "&nbsp;点&nbsp;(高级站友)"
 end if 
 if point>=2000 and point<4000 then
   GetUserLevel=cstr(point) & "&nbsp;点&nbsp;(本站支柱)"
 end if 
 if point>=4000 and point<10000 then
   GetUserLevel=cstr(point) & "&nbsp;点&nbsp;(本站长老)"
 end if 
 if point>=10000 then
   GetUserLevel=cstr(point) & "&nbsp;点&nbsp;(开国元老)"
 end if 
end function
'**************************
'设定用户目前状态
'
'**************************
sub SetUserStatus(userid,status)
 
 if trim(userid)="" then
   exit sub
 end if
 
 set connST=server.CreateObject("ADODB.connection")
 connST.ConnectionString="driver={Microsoft Access Driver (*.mdb)};DBQ=" & server.MapPath("data/bbs.asp") & ";uid=;PWD=;"
 connST.Open
 
 strSQL="update userinfo set alivetime=now(),nowstatus='" & trim(status) & "' where uid='" & trim(userid) & "'"
 connST.Execute strSQL
 set connST=nothing
end sub

function GetUserStatus(userid)
 set connGT=server.CreateObject("ADODB.connection")
 connGT.ConnectionString=Application("ConnectionString")
 connGT.Open
 strSQL="select nowstatus from userinfo where uid='" & trim(userid) & "'"
 set recGT=server.CreateObject("ADODB.recordset")
 recGT.Open strSQL,connGT
 if not recGT.EOF then
    GetUserStatus=trim(recGT("nowstatus"))
 end if
 recGT.Close 
 set recGT=nothing
 set connGT=nothing
end function

'**********************
'加密密码
'**********************
Function password(pwd)
	temp=""
	for i=1 to len(pwd)
	 temp=temp & chr(asc(mid(pwd,i,1))+20)
	next
	password=temp
end function
'*****************************
'查询是否为在冻结期间的冻结用户
'
'*****************************
Function QueryFUser(uid,bid)
   if trim(uid)="" then
     QueryFUser=0
     exit function
   end if
 
 bname=trim(GetBN(bid))
   
 set connFZ=server.CreateObject("ADODB.connection")
 connFZ.ConnectionString=Application("ConnectionString")
 connFZ.Open 
 
 strSQL="select * from userfreezen where datediff('n',outtime,now())<=freezentime and uid='" & uid & "' and bname='" & bname & "'"
 set recFZ=server.CreateObject("ADODB.recordset")
 recFZ.Open strSQL,connFZ,1,1
 
 if not recFZ.EOF then
  QueryFUser=1
 else
  strSQL="delete from userfreezen where uid='" & uid & "' and bname='" & bname & "'"
  connFZ.Execute strSQL
  QueryFUser=0
 end if
 
 recFZ.Close 
 set recFZ=nothing
 set connFZ=nothing
end function

'****************************
'得到讨论区名称
'****************************
function GetAN(aid)
 aid=trim(aid)
 
 if aid="" then
   Response.Redirect "error.asp?msg=不存在这个版面"
   Response.End 
 else
   aid=clng(aid)  
 end if
 set connAN=server.CreateObject("ADODB.connection")
 connAN.ConnectionString=Application("ConnectionString")
 connAN.Open 

 set recAN=server.CreateObject("ADODB.recordset")
 strSQL="select aname from area where aid=" & aid
 recAN.Open  strSQL,connAN,1,1
 
 if not recAN.EOF then
   GetAN=recAN("aname")
 else
   GetAN=""  
 end if
 recAN.Close 
 set recAN=nothing
 set connAN=nothing
end function

'****************************
'得到版面名称
'****************************
function GetBN(bid)
 bid=trim(bid)
 
 if bid="" then
   Response.Redirect "error.asp?msg=不存在这个版面"
   Response.End 
 else
   bid=clng(bid)  
 end if
 set connBN=server.CreateObject("ADODB.connection")
 connBN.ConnectionString=Application("ConnectionString")
 connBN.Open 

 set recBN=server.CreateObject("ADODB.recordset")
 strSQL="select bname from board where bid=" & bid
 recBN.Open  strSQL,connBN,1,1
 
 if not recBN.EOF then
   GetBN=recBN("bname")
 else
   GetBN=""  
 end if
 recBN.Close 
 set recBN=nothing
 set connBN=nothing
end function


'****************************
'
'得到版主名称
'****************************
function GetBM(bid)
 bid=trim(bid)
 
 if bid="" then
   Response.Redirect "error.asp?msg=不存在这个版面"
   Response.End 
 else
   bid=clng(bid)  
 end if
 set connBM=server.CreateObject("ADODB.connection")
 connBM.ConnectionString=Application("ConnectionString")
 connBM.Open 

 set recBM=server.CreateObject("ADODB.recordset")
 strSQL="select bmaster from board where bid=" & bid
 recBM.Open  strSQL,connBM,1,1
 
 if not recBM.EOF then
   GetBM=recBM("bmaster")
 else
   GetBM=""  
 end if
 recBM.Close 
 set recBM=nothing
 set connBM=nothing
end function


'*****************************
'得到用户的签名档
'
'*****************************
Function GetUserSign(userid)
	set connUS=server.CreateObject("ADODB.connection")
	connUS.ConnectionString=Application("ConnectionString")
	connUS.Open 

	set recUS=server.CreateObject("ADODB.recordset")
	strSQL="select sign from userinfo where uid='" & userid & "'"
	recUS.Open  strSQL,connUS,1,1
    if not recUS.EOF then
     GetUserSign=BeautySign(recUS("sign"))
    else
     GetUserSign="" 
    end if
    recUS.Close
    set recUS=nothing
    set connUS=nothing
end function


'***************
'
'转化用户签名档,用於显示在Table
'***************
Function BeautySign(sign)

	sign=replace(sign,"'","''",1)
	sign=replace(sign,"<","＜",1)
	sign=replace(sign,">","＞",1)
    sign=replace(sign,chr(32),"&nbsp;",1)
    sign=replace(sign,chr(13),"<br>",1)
    sign=ChgToImg(sign)
    sign=ChgToTag(sign)
    BeautySign=sign
End function

'*************************
'检测这个用户是否已经注册了
'成功:返回 1
'失败:返回 0
'*************************
function CheckUser(name)
	dim conn
	dim recCheckUser
	dim strSQL
	dim uid,upwd
    
    if trim(name)="" then
      CheckUser=-1
      exit function
    end if
    
	set conn=server.CreateObject("ADODB.connection")
	conn.ConnectionString=Application("ConnectionString")
	conn.Open 

	set recCheckUser=server.CreateObject("ADODB.recordset")
	uid=trim(name)
	strSQL="select * from userinfo where uid='" & uid & "'"
	recCheckUser.Open  strSQL,conn

	if not recCheckUser.EOF and ucase(trim(name))<>"SYSOP" and ucase(trim(name))<>"SYSOPS" and ucase(trim(name))<>"SA" and ucase(trim(name))<>"GUEST" then
		CheckUser=1
	else
		CheckUser=0  
	end if

	recCheckUser.Close 
	set recCheckUser=nothing
	set conn=nothing
end function

'***********************
'检测用户密码是否正确
'正确: 返回 1
'错误: 返回 0
'**********************
function CheckUserPwd(name,pwd)
	dim connPwd
	dim recCheckUserPwd
	dim strSQL
	dim uid,upwd
    
    if trim(name)="" then
      CheckUserPwd=-1
      exit function
    end if
    
	set connPwd=server.CreateObject("ADODB.connection")
	connPwd.ConnectionString=Application("ConnectionString")
	connPwd.Open 
        pwd=encrypt(pwd)
	set recCheckUserPwd=server.CreateObject("ADODB.recordset")
	uid=trim(name)
	strSQL="select * from userinfo where uid='" & uid & "' and upwd='" & trim(pwd) & "'"
	recCheckUserPwd.Open  strSQL,connPwd

	if not recCheckUserPwd.EOF then
		CheckUserPwd=1
	else
		CheckUserPwd=0  
	end if

	recCheckUserPwd.Close 
	set recCheckUserPwd=nothing
	set connPwd=nothing
end function

'*******************************
'保存文章内容
'
'*******************************
Function SaveDoc(Ftitle,Bid,Fcontent,Reid,face)
dim connSV
dim strSQL

set connSV=server.CreateObject("ADODB.connection")
connSV.ConnectionString=Application("ConnectionString")
connSV.Open 

fcontent=chr(13) & chr(10) & fcontent
fcontent=replace(fcontent,"'","''",1)
fcontent=replace(fcontent,"<","＜",1)
fcontent=replace(fcontent,">","＞",1)



if trim(Reid)="" then'发表新文章
  Bid=clng(Bid)
  Ftitle=trim(Ftitle)
  Ftitle=replace(Ftitle,"'","''")
  Ftitle=replace(Ftitle,"""","“")
  uid=trim(session("UserID"))
  connSV.BeginTrans 
  strSQL="insert into filebook(uid,ftitle,ftime,bid,fcontent,ip,face) values('" & uid & "','" & ftitle & "',now()," & bid & ",'" & fcontent & "','" & Request.ServerVariables("REMOTE_ADDR") & "','" & face & "')"    
  connSV.Execute strSQL,counts
  strSQL="update userinfo set ibook=ibook+1,iperience=iperience+3 where uid='" & uid & "'"
  connSV.Execute strSQL
  strSQL="update board set bfiles=bfiles+1 where bid=" & bid
  connSV.Execute strSQL
  connSV.CommitTrans
else     '回覆文章
  Reid=clng(Reid)
  Bid=clng(Bid)
  Ftitle=trim(Ftitle)
  Ftitle=replace(Ftitle,"'","''")
  Ftitle=replace(Ftitle,"""","“")
  uid=trim(session("UserID"))
  connSV.BeginTrans 
  strSQL="insert into filebook(uid,ftitle,ftime,bid,fcontent,reid,ip) values('" & uid & "','" & ftitle & "',now()," & bid & ",'" & fcontent & "'," & Reid & ",'" & Request.ServerVariables("REMOTE_ADDR") & "')"    
  connSV.Execute strSQL
  strSQL="update filebook set fanswer=fanswer+1 where fid=" & Reid
  connSV.Execute strSQL,counts
  strSQL="update userinfo set ibook=ibook+1,iperience=iperience+2 where uid='" & uid & "'"
  connSV.Execute strSQL
  strSQL="update board set bfiles=bfiles+1 where bid=" & bid