fileshow.asp

品泡女人香XI8.NET文章管理系统的源码

<!--#include FILE="conn.asp"-->
<!--#include file="inc/const.asp" -->
<!--#include file="inc/dv_ubbcode.asp"-->
<!--#include file="inc/dv_clsother.asp" -->
<!--#include file="inc/ubblist.asp"-->
<%
'2003-12-9 Edit by Yangzheng
Dvbbs.Loadtemplates("show")
Dim username
Dim abgcolor
Dim bbsurl,Sql
Dim MyIsBoard,MyDepth
bbsurl=""
Dvbbs.stats=Template.Strings(22)
Dvbbs.Nav()
If Dvbbs.BoardID=0 then
	MyIsBoard=2
	MyDepth=0
Else
	MyIsBoard=1
	MyDepth=Dvbbs.Board_Data(4,0)
End If
Dim dv_ubb
Dim EmotPath
EmotPath=Split(Dvbbs.Forum_emot,"|||")(0)		'em心情路径
Set dv_ubb=new Dvbbs_UbbCode
If Cint(Dvbbs.GroupSetting(49))=0 then Dvbbs.AddErrCode(54)
Dvbbs.ShowErr()

If request("action")="send" Then
	card()
ElseIf request("action")="save" Then
	cardsave()
ElseIf request("action")="cards" Then
	showcard()
Else
	main()
End If
Dvbbs.ActiveOnline
Dvbbs.NewPassword()
Set dv_ubb=Nothing 
Dvbbs.Footer()

'=====================贺卡演示====================
Sub showcard()
	Dvbbs.stats=Template.Strings(49)
	Dvbbs.Head_var 0,0,template.Strings(0),"show.asp"
	Dim cid,msnid,Rs
	Dim sender,incept,body,title,sendtime
	Dim F_Filename,ftype,flag
	Dim showfile
	Dim Tempwrite
	Dim redcolor,blackcolor
	redcolor=Dvbbs.Mainsetting(1)
	blackcolor=Dvbbs.Mainsetting(3)
	If request("id")="" or Not IsNumeric(request("id")) Then 
		Response.redirect "showerr.asp?ErrCodes=<li>"&template.Strings(23)&"&action=OtherErr"
	Else
		cid=clng(request("id"))
	End If

	If request("msmid")="" or Not IsNumeric(request("msmid")) Then
		Response.redirect "showerr.asp?ErrCodes=<li>"&template.Strings(23)&"&action=OtherErr"
	Else
		msnid=clng(request("msmid"))
	End If

	'取出短信内容
	Set Rs=Dvbbs.Execute("select sender,incept,title,content,sendtime from Dv_message where id="&msnid&" order by id desc")
	If not (rs.eof and rs.bof) Then
		sender=Dvbbs.htmlencode(trim(rs(0)))
		incept=Dvbbs.htmlencode(trim(rs(1)))
		title=Dvbbs.htmlencode(rs(2))
		body=rs(3)
		sendtime=rs(4)
	Else
		Response.redirect "showerr.asp?ErrCodes=<li>"&template.Strings(50)&"&action=OtherErr"
	End If
	Rs.close

	'取出文件内容
	Set Rs=Dvbbs.Execute("select F_Filename,F_Type,F_Flag from [DV_Upfile] where F_ID="&cid&" order by F_ID desc")
	If  Not (Rs.EOF And Rs.BOF) Then
		F_Filename=rs(0)
		ftype=cint(rs(1))
		flag=Cint(rs(2))
		If flag<>3 Then Response.redirect "showerr.asp?ErrCodes=<li>"&template.Strings(51)&"&action=OtherErr"
	Else
		Response.redirect "showerr.asp?ErrCodes=<li>"&template.Strings(50)&"&action=OtherErr"
	End If
	Rs.close:Set Rs=Nothing

	'判断文件是否本论坛，若不是则采用表中的记录．
	If InStr(F_Filename,":")=0 or InStr(F_Filename,"//")=0 Then
		If Dvbbs.Forum_Setting(75)="0" Then
			F_Filename=bbsurl&"UploadFile/"&F_Filename
		Else
			F_Filename="showimg.asp?Boardid="&Dvbbs.BoardID&"&filename="&F_Filename
		End If
	End If 
	Select Case ftype
	Case 1
		showfile="[img]"&F_Filename&"[/img]"
		ubblists=ubblist(showfile)
		showfile=dv_ubb.Dv_UbbCode(showfile,Dvbbs.UserGroupID,2,1)
	Case 2
		showfile="[flash=500,350]"&F_Filename&"[/flash]"
		ubblists=ubblist(showfile)
		showfile=dv_ubb.Dv_UbbCode(showfile,Dvbbs.UserGroupID,2,1)
	Case Else
		showfile="[upload="&F_FileType&"]viewfile.asp?ID="&F_ID&"[/upload]"
		ubblists=ubblist(showfile)
		showfile=dv_ubb.Dv_UbbCode(showfile,Dvbbs.UserGroupID,2,1)
	End Select
	Tempwrite=Template.html(15)
	Tempwrite=Replace(Tempwrite,"{$sendtime}",sendtime)
	Tempwrite=Replace(Tempwrite,"{$sender}",sender)
	Tempwrite=Replace(Tempwrite,"{$incept}",incept)
	Tempwrite=Replace(Tempwrite,"{$redcolor}",redcolor)
	Tempwrite=Replace(Tempwrite,"{$title}",title)
	Tempwrite=Replace(Tempwrite,"{$showfile}",showfile)
	Tempwrite=Replace(Tempwrite,"{$blackcolor}",blackcolor)
	Ubblists=Ubblist(body)
	Tempwrite=Replace(Tempwrite,"{$dvbody}",dv_ubb.Dv_UbbCode(body,Dvbbs.UserGroupID,2,1))
	Response.Write Tempwrite
End Sub

'贮存发送贺卡
Sub cardsave()
	Dvbbs.stats=Template.Strings(36)
	Dvbbs.Head_var 0,0,template.Strings(0),"show.asp"
	If Dvbbs.UserID=0 Then
		Dvbbs.AddErrCode(6)
		Dvbbs.ShowErr()
	End if
	Dim cid,sname,rname,ctitle,body
	Dim msmid,cardurl,msmbody,Rs,SQl
	cid = Dvbbs.checkStr(trim(request.form("saveid")))
	sname = Dvbbs.checkStr(trim(request.form("sname")))
	rname = Dvbbs.checkStr(trim(request.form("subject")))	'收信人名
	ctitle = Dvbbs.checkStr(trim(request.form("title")))
	body = Html2Ubb(request.form("Body"))
	body = Dvbbs.checkStr(body)
	If cid="" or Not IsNumeric(cid) Then Response.redirect "showerr.asp?ErrCodes=<li>"&template.Strings(23)&"&action=OtherErr"
	If Not (IsEmpty(session("lastpost")) or Dvbbs.boardmaster or Dvbbs.master or Dvbbs.superboardmaster) Then
		If DateDiff("s",session("lastpost"),Now())<10 Then Response.redirect "showerr.asp?ErrCodes=<li>"&template.Strings(37)&"&action=OtherErr"
	End If
	If Dvbbs.chkpost=False Then Dvbbs.AddErrCode(16)
	Dvbbs.ShowErr()
	If Replace(rname,",","")="" Then
		Response.redirect "showerr.asp?ErrCodes=<li>"&template.Strings(38)&"&action=OtherErr"
	Else
		rname=split(rname,",")
	End If
	If ctitle="" Then
		Response.redirect "showerr.asp?ErrCodes=<li>"&template.Strings(39)&"&action=OtherErr"
	ElseIf Dvbbs.strLength(ctitle)>50 Then
		Response.redirect "showerr.asp?ErrCodes=<li>"&template.Strings(40)&"&action=OtherErr"
	End If
	If Dvbbs.strLength(body)>15360 Then Response.redirect "showerr.asp?ErrCodes=<li>"&template.Strings(41)&"&action=OtherErr"
	if body="" Then Response.redirect "showerr.asp?ErrCodes=<li>"&template.Strings(42)&"&action=OtherErr"

	Dim msg,ISOK,i,SendNum
	ISOK=False
	Dim k:K=0
	Dim OKlist
	SendNum=UBound(rname)+1
	If Dvbbs.UserToday(1)<SendNum Then
		SendNum=Dvbbs.UserToday(1)
	End if
	For i=0 to SendNum-1
		If Not IsFind(rname(i)) Then
			msg = msg &Template.Strings(43)
			msg = Replace(msg,"{$rname}",rname(i))
		Else
			If K>Cint(Dvbbs.GroupSetting(33))-1 Then
				msg = msg & Template.Strings(44)
				msg=Replace(msg,"{$rennum}",Dvbbs.GroupSetting(33))
				msg=Replace(msg,"{$rname}",rname(i))
			Else
				'插入短信并获得ID
				sql="insert into dv_message (incept,sender,title,content,sendtime,flag,issend) values ('"&rname(i)&"','"&Dvbbs.membername&"','"&ctitle&"','"&body&"',"&SqlNowString&",0,1)"
				Dvbbs.Execute(sql)
				update_user_msg(rname(i))
				set Rs=Dvbbs.Execute("select top 1 id from dv_message order by id desc")
				msmid=rs(0)
				rs.close
				cardurl=bbsurl&"fileshow.asp?action=cards&id="&cid&"&msmid="&msmid
				cardurl="[URL="&cardurl&"]"&Template.Strings(28)&"[/URL]"
				msmbody=body+chr(13)+chr(13)+chr(10)+chr(10)+chr(10)+cardurl
				Dvbbs.Execute("update [dv_message] set content='"&Dvbbs.checkStr(msmbody)&"' where id="&msmid)
				Dvbbs.Execute("update [DV_Upfile] set F_Flag=3 where F_ID="&cid)
				K=K+1
				ISOK=True
				OKlist=OKlist&Template.Strings(45)
				OKlist=Replace(OKlist,"{$rname}",rname(i))
			End If
		End If 
		cardurl=""
	Next
	Set Rs=Nothing
	'更新用户今日短信数据
	If SendNum > 0 Then
	Dim iUserInfo
		iUserInfo = Session(Dvbbs.CacheName & "UserID")
		iUserInfo(36) = Dvbbs.UserToday(0) & "|" & Dvbbs.UserToday(1) + SendNum & "|" & Dvbbs.UserToday(2)
		Session(Dvbbs.CacheName & "UserID") = iUserInfo
		Dvbbs.Execute("Update [Dv_User] Set UserToday='" & iUserInfo(36) & "' Where UserID = " & Dvbbs.UserID)
	End If
	If ISOK Then 
		Dim sucmsg
		sucmsg=sucmsg+"<br>"+Template.Strings(46)&OKlist
		session("lastpost")=Now()
		If Msg<>"" Then sucmsg=sucmsg&Template.Strings(47)&msg
	Else
		Response.redirect "showerr.asp?ErrCodes="&msg&Template.Strings(48)&"&action=OtherErr"
	End If
	Dvbbs.Dvbbs_suc(sucmsg)
End Sub

 '编写贺卡内容
Sub card()
	Dvbbs.stats=Template.Strings(33)
	dvbbs.Head_var 0,0,template.Strings(0),"show.asp"
	Dim sid,showfile
	Dim F_Filename,F_Type
	Dim frs,Rs,SQl
	Dim Postubb
	Dim Tempwrite
	If Dvbbs.UserID=0 Then Response.redirect "showerr.asp?ErrCodes=<li>"&template.Strings(34)&"&action=OtherErr"
	If request("id")="" or not isnumeric(request("id")) Then
		Response.redirect "showerr.asp?ErrCodes=<li>"&template.Strings(23)&"&action=OtherErr"
	Else
		sid=CLng(request("id"))
	End If
	'F_ID,F_Username,F_Filename,F_FileType,F_Type,F_Readme,F_ViewNum,F_Flag,F_boardid
	Set Rs=Dvbbs.Execute("select * from [DV_Upfile] where F_ID="&sid)
	If Not (Rs.EOF And Rs.BOF) Then
		F_Filename=Dvbbs.htmlencode(rs("F_Filename"))
		'判断文件是否本论坛，若不是则采用表中的记录．
		If InStr(F_Filename,":")=0 or InStr(F_Filename,"//")=0 Then
			If Dvbbs.Forum_Setting(75)="0" Then
				F_Filename=bbsurl&"UploadFile/"&F_Filename
			Else
				F_Filename="showimg.asp?Boardid="&Dvbbs.BoardID&"&filename="&F_Filename
			End If
		End If 
		F_Type=cint(rs("F_Type"))
		Select Case F_Type
		Case 1
			If Renzhen(Rs("F_boardid"),Dvbbs.Membername) then
				showfile="[img]"&F_Filename&"[/img]"
				ubblists=ubblist(showfile)
				showfile=dv_ubb.Dv_UbbCode(showfile,Dvbbs.UserGroupID,2,1)
			Else
				Response.redirect "showerr.asp?ErrCodes=<li>"&template.Strings(35)&"&action=OtherErr"
			End if
		Case 2
			If Renzhen(Rs("F_boardid"),Dvbbs.Membername) then
				showfile="[flash=500,350]"&F_Filename&"[/flash]"
				ubblists=ubblist(showfile)&"39,"
				showfile=dv_ubb.Dv_UbbCode(showfile,Dvbbs.UserGroupID,2,1)
			Else
				Response.redirect "showerr.asp?ErrCodes=<li>"&template.Strings(35)&"&action=OtherErr"
			End if
		Case Else
 			Response.redirect "showerr.asp?ErrCodes=<li>"&template.Strings(35)&"&action=OtherErr"
		End Select
	Else
		Dvbbs.AddErrCode(35)
		Dvbbs.ShowErr()
	End If
	Rs.close:Set Rs=Nothing
	Tempwrite=Template.html(14)
	Tempwrite=Replace(Tempwrite,"{$showfile}",showfile)
	Tempwrite=Replace(Tempwrite,"{$friend}",OPTION_Friend)
	Tempwrite=Replace(Tempwrite,"{$sname}",Dvbbs.Membername)
	Tempwrite=Replace(Tempwrite,"{$sid}",Sid)
	Tempwrite=Replace(Tempwrite,"{$postubb}",Temp_UBB)
	Response.Write Tempwrite
End Sub 

Sub main()
	Dim Tempwrite
	Dim sid
	Dim F_ID, F_AnnounceID, F_BoardID, F_UserID ,F_Username, F_Filename, F_FileType, F_Type, F_FileSize, F_Readme, F_DownNum, F_ViewNum, F_DownUser, F_Flag, F_AddTime
	Dim F_typename,Selfiletype
	Dim golist,showfile,csend
	Selfiletype=Split(Dvbbs.lanstr(5),"||")
	If request("id")="" or not IsNumeric(request("id")) Then
		Response.redirect "showerr.asp?ErrCodes=<li>"&template.Strings(23)&"&action=OtherErr"
	Else
		sid=clng(request("id"))
	End If
	If Dvbbs.boardid=0 Then
		dvbbs.Head_var 0,0,template.Strings(0),"show.asp"