user.asp

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

  connSV.Execute strSQL
  connSV.CommitTrans 
end if

set connSV=nothing

SaveDoc=counts
End function

'*******************************
'修改文章内容
'
'*******************************
Function UpdateDoc(Ftitle,Bid,Fcontent,fid)
dim connCH
dim strSQL

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

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



if trim(fid)<>"" then'修改文章
  Bid=clng(Bid)
  fid=clng(fid)
  Ftitle=trim(Ftitle)
  strSQL="update filebook set ftitle='" & ftitle & "',fcontent='" & fcontent & "' where fid=" & fid    
  connCH.Execute strSQL,counts
end if

set connCH=nothing
UpdateDoc=counts
End function

'*******************************
'
'删除文章
'*******************************
Function DelDoc(uid,fid,reid)
dim connDel
dim strSQL

if trim(fid)="" then
 exit function
else
 fid=clng(fid)
 reid=clng(reid)
 uid=trim(uid)
end if
set connDel=server.CreateObject("ADODB.connection")
connDel.ConnectionString=Application("ConnectionString")
connDel.Open 
counts=0
connDel.BeginTrans 
strSQL="update filebook set fanswer=fanswer-1 where fid=" & reid
connDel.Execute strSQL
strSQL="update userinfo set ibook=ibook-3 where uid='" & uid & "'"
connDel.Execute strSQL
strSQL="delete from filebook where fid=" & fid
connDel.Execute strSQL,counts
strSQL="update board set bfiles=bfiles-1 where bid=" & bid
connDel.Execute strSQL
connDel.CommitTrans 

set connDel=nothing
DelDoc=counts
End function
'*****************************
'阅读文章内容,显示在Table中
'
'*****************************
Function ShowDocToRead(content)
dim temp

temp=""
if trim(content)="" then
 ShowDocToRead=""
 exit function
end if

temp=replace(content,chr(13)&chr(10),"<br>",1)
temp=replace(temp,chr(32),"&nbsp;",1)
ShowDocToRead=temp

End function

'**********************************
'阅读文章内容,显示在TextArea中,於用
'回覆.   
'
'***********************************
Function ShowDocToWrite(content,author)
dim temp,strSQL
dim connW,recW

temp=""
if trim(content)=""then
 ShowDocToWrite=""
 exit function
end if
content="【" & author & "在大作中谈到:】" & chr(13)&chr(10) & content	
temp="＞" & replace(content,chr(10),chr(10)&"＞",1)

'set connW=server.CreateObject("ADODB.connection")
'connW.ConnectionString=ConnectionString=Application("ConnectionString")
'connW.Open 
'strSQL="update filebook set fhits=fhits+1 where fid=" & clng(fid)
'connW.Execute strSQL
'connW.Close
'set connW=nothing

ShowDocToWrite=temp
End Function


'******************
'更新用户信息
'
'******************
function UpdateUser(id,nickname,pwd,email,sex,sign)
	dim connUpt
	dim strSQL,counts,sign2
	
	sign2=""

    if trim(id)="" or trim(nickname)="" or trim(pwd)="" or trim(email)="" or trim(sex)="" then
      RegisterUser=-1
      exit function
    end if

	id=replace(id,"'","''",1)
	nickname=replace(nickname,"'","''",1)
	pwd=replace(pwd,"'","''",1)
	email=replace(email,"'","''",1)
	sign=replace(sign,"'","''",1)
    
	id=replace(id,"<","＜",1)
	id=replace(id,">","＞",1)
	nickname=replace(nickname,"<","＜",1)
	nickname=replace(nickname,">","＞",1)
	pwd=replace(pwd,"<","＜",1)
	pwd=replace(pwd,">","＞",1)
	email=replace(email,"<","＜",1)
	email=replace(email,">","＞",1)
	sign=replace(sign,"<","＜",1)
	sign=replace(sign,">","＞",1)
    'sign2=replace(sign,chr(32),"&nbsp;",1)
    'sign2=replace(sign2,chr(13),"<br>",1)


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

    strSQL="update userinfo set unick='" & nickname & "',upwd='" & pwd & "',email='" & email & "',sex='" & sex & "',sign='" & sign & "',sign2='" & sign2 & "' where uid='" & id & "'"
    connUpt.Execute strSQL,counts
    
    UpdateUser=counts
    set connUpt=nothing  
End function



'*************
'注册用户信息
'成功: 1
'失败: <1
'*************
function RegisterUser(id,nickname,pwd,email,sex,sign)
	dim connReg
	dim strSQL,counts,sign2
	
	sign2=""

    if trim(id)="" or trim(nickname)="" or trim(pwd)="" or trim(email)="" or trim(sex)="" then
      RegisterUser=-1
      exit function
    end if

	id=replace(id,"'","''",1)
	nickname=replace(nickname,"'","''",1)
	pwd=replace(pwd,"'","''",1)
	email=replace(email,"'","''",1)
	sign=replace(sign,"'","''",1)
    
	id=replace(id,"<","＜",1)
	id=replace(id,">","＞",1)
	nickname=replace(nickname,"<","＜",1)
	nickname=replace(nickname,">","＞",1)
	pwd=replace(pwd,"<","＜",1)
	pwd=replace(pwd,">","＞",1)
	'pwd=password(pwd)  '加密密码
	email=replace(email,"<","＜",1)
	email=replace(email,">","＞",1)
	sign=replace(sign,"<","＜",1)
	sign=replace(sign,">","＞",1)
    'sign2=replace(sign,chr(13),"<br>",1)
    'sign2=replace(sign,chr(32),"&nbsp;",1)


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

    strSQL="insert into userinfo(uid,unick,upwd,email,sex,sign,sign2,lastlogindate) values('" & id & "','" & nickname & "','" & pwd & "','" & email & "','" & sex & "','" & sign & "','" & sign2 & "',now())"
    connReg.Execute strSQL,counts
    
    content=""
    content=content & "恭喜您成为清茶潭虚拟社区的一员!"
    content=content & "本社区提供有完善的功能,使得您可以自由自在的生活在我们大家共同构建的社区里面!"
    content=content & "社区成员拥有自己的经验值,分为新手上路,初级站友,中级站友,高级站友,本站支柱,本站元老.这几个等级,"
    content=content & "随着您的等级的提高,您享有的权利也会逐渐增强喔!提高经验值得方法是多上站,多发表文章,并且,离开站点的时候一定要通过(真的要走)来退出,这样才可以保持旺盛的生命力喔!"
    content=content & "最後恭祝您在清茶潭社区愉快的度过每一天!"
    call SendMailToUser(id,"恭喜注册成功",content,"系统管理员")    
    RegisterUser=counts
    set connReg=nothing
end function


'****************************
'获取系统管理员名单列表
'****************************
Function GetSAList()
	set connSA=server.CreateObject("ADODB.connection")
	connSA.ConnectionString=Application("ConnectionString")
	connSA.Open 

	set recSA=server.CreateObject("ADODB.recordset")
	uid=trim(name)
	strSQL="select * from sysinfo"
	recSA.Open  strSQL,connSA
	if not recsa.EOF then
	  GetSAList=trim(recSA("sa"))
	else
	  GetSAList=""
	end if
    
    recsa.Close 
    set recsa=nothing
    set connSA=nothing
End function



'********************************************************
'用户登录成功处理
'*******************************************************
Sub UserEnter(userid,flag)
  dim connEnter
  dim strSQL
    
  if trim(userid)="" then
   exit sub
  end if 
  
'会员登录进来啦  
  if flag="1" then
	  session("UserID")=trim(userid)
	  if IsExist(trim(userid))=0 then
	  Application.Lock 
	  if trim(application("OnlineUser"))="" then
	    Application("OnlineUser")=trim(userid)
	  else
	    Application("OnlineUser")=Application("OnlineUser") & "," & trim(userid) 
	  end if
	  Application.UnLock
	  end if
	  set conn=server.CreateObject("adodb.connection")
	  connStr="driver={Microsoft Access Driver (*.mdb)};dbq="+server.MapPath("data/OnlineUser.mdb")+";uid=Admin;pwd=;"
	  conn.Open connStr
	  strSQL="insert into user(name,lastdate) values('" & session("userid") & "',now())"
          conn.execute strsql
          set conn=nothing
	  set connEnter=server.CreateObject("ADODB.connection")

	  connEnter.ConnectionString=Application("ConnectionString")
	  connEnter.Open
	  set rec=server.createobject("adodb.recordset")
	  strsql="select * from userinfo where uid='" & userid & "'"
	  rec.open strsql,connEnter,1,1
	  if not rec.eof then
	    PostTime=cdate(rec("lastlogindate"))
  	    if len(year(PostTime))<=2 then
    		yearT="20" & year(PostTime)
  	    else
    		yearT=year(PostTime)
            end if
  	    if len(month(PostTime))<=1 then
    		monthT="0" & month(PostTime)
  	    else
    		monthT=month(PostTime)  
  	    end if
  	    if len(day(PostTime))<=1 then
    		dayT="0" & day(PostTime)
	    else
  	  	dayT=day(PostTime)  
  	    end if
  	      if len(hour(PostTime))<=1 then
    hourT="0" & hour(PostTime)
  else
    hourT=hour(PostTime)  
  end if
  if len(minute(PostTime))<=1 then
    minuteT="0" & minute(PostTime)
  else
    minuteT=minute(PostTime)  
  end if
  if len(second(PostTime))<=1 then
    secondT="0" & second(PostTime)
  else
    secondT=second(PostTime)  
  end if
  strTemp=yearT & monthT & dayT & hourT & minuteT & secondT
	   session("lastdate")=strtemp
	   rec.close
	   set rec=nothing
	  end if 
       	  strSQL="update userinfo set uip='" & Request.ServerVariables("REMOTE_ADDR") & "',lastlogindate=now() where uid='" & userid & "'"  
          connEnter.execute strsql
          set connEnter=nothing
  end if
  
  
'有人参观啦
  if flag="2" then
	  session("UserID")=trim(userid)
  end if

'更新用户的资料
  if flag="3" then
	  set connEnter=server.CreateObject("ADODB.connection")
	  connEnter.ConnectionString=Application("ConnectionString")
	  connEnter.Open 
  
	  strSQL="update userinfo set nowstatus='登录进站',ilogin=ilogin+1,iperience=iperience+1,uip='" & Request.ServerVariables("REMOTE_ADDR") & "',lastlogindate=now() where uid='" & userid & "'"  
	  connEnter.Execute strSQL
	  set connEnter=nothing

  end if
END Sub


'******************
'用户退出系统处理
'******************
Sub UserExit(uid)
  dim temp
  dim user
  
  temp=""
  if trim(uid)="" then
   exit sub
  end if 
  
    '*****************************
    user=split(application("OnlineUser"),",") '获得在线用户列表
    for i=0 to ubound(user) '获得非空的在线用户列表
       if trim(user(i))<>"" and trim(user(i))<>trim(uid) then
	  if trim(temp)="" then
	 	temp=user(i)
	  else
		temp=temp+","+user(i)
          end if
       end if
    next
      Application.Lock 
      application("OnlineUser")=temp '重新整理在线用户列表
      Application.UnLock 
    '********************      
  
  set connEx=server.CreateObject("ADODB.connection")
  connEx.ConnectionString=Application("ConnectionString")
  connEx.Open 

  strSQL="update userinfo set onlinetime=onlinetime+datediff('n',lastlogindate,now()),nowstatus='不在站上' where uid='" & trim(uid) & "'"
  connEx.Execute strsql
  
  set recEx=server.CreateObject("ADODB.recordset")
  strSQL="select lastlogindate from userinfo where uid='" & trim(uid) & "'"
  recEx.Open strSQL,connEx,1,1
  if not recEx.EOF then
    temp2=0
    temp2=datediff("n",recEx("lastlogindate"),now())
    temp2=clng(temp2\20)
  end if  
  
  if temp2>=1 then
    strSQL="update userinfo set iperience=iperience+" & temp2 & " where uid='" & trim(uid) & "'"
    connEx.Execute strSQL
  end if  
  set connEx=nothing
END Sub

Sub OnlineUser()
 dim temp,i
 
 temp=""
  if trim(application("onlineuser"))<>"" then
   user=split(Application("OnlineUser"),",")
   for i=0 to ubound(user) '获得非空的在线用户列表
	 if trim(user(i))<>"" then
		 if trim(temp)="" then
			temp=user(i)
		 else
			temp=temp+","+user(i)
	     end if
	 end if
   next
  end if
  Application.Lock 
  application("OnlineUser")=temp '重新整理在线用户列表
  Application.UnLock 
End Sub


'****************************
'得到好友名单(e.g:xxx,fff,ddd)
'
'****************************
Function GetFriends(username)
  dim flist
  
  flist=""
  username=trim(username) 
  if username="" then
    GetFriends=""
    exit function
  end if
  set connFD=server.CreateObject("ADODB.connection")
  connFD.ConnectionString=Application("ConnectionString")
  connFD.Open 

  set recFD=server.CreateObject("ADODB.recordset")
  strSQL="select distinct ownid,friendsid from friends where ownid='" & username & "'"
  recFD.Open strSQL,connFD,1,1
  
  do while not recFD.EOF 
    if trim(flist)="" then
      flist=trim(recFD("friendsid"))
    else
      flist=flist & "," & trim(recFD("friendsid"))
    end if
    recFD.MoveNext     
  loop  
  recFD.Close 
  set recFD=nothing
  set connFD=nothing

  GetFriends=trim(flist)

End function
%>