showfile.asp

一个asp写的论坛源代码,论坛所需要的功能都有

<!-- #include file="conn.asp" -->
<!-- #include file="INC/Const.asp" -->
<%
Dim ID,Upid,FileName,RS,FileUrl
ID = CID(Request("ID"))

Set Rs=team.execute("Select FileName,UpCount from [upfile] where Fileid="&ID )
If Rs.BOF and Rs.EOF Then
	team.error "该附件已被删除"
	Response.End
Else
	UpdateUserpostExc()
	team.execute("Update [upfile] Set UpCount=UpCount+1 where Fileid="&ID )
	FileUrl="Images/UpFile/"
	If team.Forum_setting(93) = 0 Then
		Response.Redirect FileUrl&rs(0)
	Else
		FileName=ReplaceStr(rs(0),"..","")&""
		If Request.ServerVariables("HTTP_REFERER")="" Or InStr(Request.ServerVariables("HTTP_REFERER"),Request.ServerVariables("SERVER_NAME"))=0 Or FileName="" Then 
			Response.Redirect "Default.asp"
		Else
			Call DownLoadFile(Server.MapPath(FileUrl&FileName))
		End If
	End If
End If
Rs.Close:Set Rs=Nothing

Sub UpdateUserpostExc()
	'用户积分部分
	Dim ExtCredits,MustOpen,ExtSort,MustSort,UExt,u
	Dim UserPostID,My_ExtSort
	If Not team.UserLoginED Then  Exit Sub
	ExtCredits = Split(team.Club_Class(21),"|")
	MustOpen = Split(team.Club_Class(22),"|")
	For U=0 to Ubound(ExtCredits)
		ExtSort=Split(ExtCredits(U),",")
		MustSort=Split(MustOpen(U),",")
		If ExtSort(3)=1 Then
			If U = 0 Then
				UExt = UExt &"Extcredits0=Extcredits0+"&MustSort(4)&""
			Else
				UExt = UExt &",Extcredits"&U&"=Extcredits"&U&"+"&MustSort(4)&""
			End if
		End if
	Next
	team.execute("Update ["&IsForum&"User] Set "&UExt&" Where ID = "& team.TK_UserID)
End Sub

Sub DownLoadFile(strFile)
	On error resume next
	Server.ScriptTimeOut=999999
	Dim S,fso,f,intFilelength,strFilename
	strFilename = strFile
	Response.Clear
	Set s = Server.CreateObject("ADODB.Stream") 
	s.Open
	s.Type = 1 
	Set fso = Server.CreateObject("Scripting.FileSystemObject") 
	If Not fso.FileExists(strFilename) Then
		Response.Write("<h1>错误: </h1><br>系统找不到指定文件")
		Exit Sub		
	End If
	Set f = fso.GetFile(strFilename)
		intFilelength = f.size
		s.LoadFromFile(strFilename)
		If err Then
		 	Response.Write("<h1>错误: </h1>" & err.Description & "<p>")
			Response.End 
		End If
		Set fso=Nothing
		Dim Data
		Data=s.Read
		s.Close
		Set s=Nothing
		If Response.IsClientConnected Then 
			Response.AddHeader "Content-Disposition", "attachment; filename=" & f.name 
			Response.AddHeader "Content-Length", intFilelength 
 			Response.CharSet = "UTF-8" 
			Response.ContentType = "application/octet-stream"
			Response.BinaryWrite Data
			Response.Flush
		End If
End Sub
%>