jdfiletosave.asp

平凡BBS1.0

<%
OPTION EXPLICIT
Server.ScriptTimeOut=5000
response.Buffer=true
dim db,conn,rs,webname
%>
<!--#include file="conn.asp"-->
<%
'----------------------------------------------------------
'**************文件上传*************
'
'

dim jd_size,jd_style,jd_path,n
jd_style="rar/jpg/gif/zip" '上传类型
jd_size=1024000  ' 上传大小 单位字节 1024000=1M
jd_path="img/"    '上传目录
n=0  ' 会员发贴在N以上才能上传; 设为 0 时不限制

'**********************************************************
'----------------------------------------------------------
sub connopen(str)
    On Error Resume Next
	set conn=Server.CreateObject("ADODB.Connection")
	Conn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & str
    If Err Then
           err.Clear
           Set Conn = Nothing
           Response.Write "数据库连接出错，请检查连接字串。"
           Response.End
     End If
end sub
'----------------------------------------------------------
Class UpLoadClass

	Private p_MaxSize,p_TotalSize,p_FileType,p_SavePath,p_AutoSave,p_Error
	Private objForm,binForm,binItem,strDate,lngTime
	Public	FormItem,FileItem

	Public Property Get Version
		Version="Rumor UpLoadClass Version 2.08 Beta 1"
	End Property

	Public Property Get Error
		Error=p_Error
	End Property

	Public Property Get MaxSize
		MaxSize=p_MaxSize
	End Property
	Public Property Let MaxSize(lngSize)
		if isNumeric(lngSize) then
			p_MaxSize=clng(lngSize)
		end if
	End Property

	Public Property Get TotalSize
		TotalSize=p_TotalSize
	End Property
	Public Property Let TotalSize(lngSize)
		if isNumeric(lngSize) then
			p_TotalSize=clng(lngSize)
		end if
	End Property

	Public Property Get FileType
		FileType=p_FileType
	End Property
	Public Property Let FileType(strType)
		p_FileType=strType
	End Property

	Public Property Get SavePath
		SavePath=p_SavePath
	End Property
	Public Property Let SavePath(strPath)
		p_SavePath=replace(strPath,chr(0),"")
	End Property

	Public Property Get AutoSave
		AutoSave=p_AutoSave
	End Property
	Public Property Let AutoSave(byVal Flag)
		select case Flag
			case 0:
			case 1:
			case 2:
			case false:Flag=2
			case else:Flag=0
		end select
		p_AutoSave=Flag
	End Property

	Private Sub Class_Initialize
		p_Error	   = -1
		p_MaxSize  = 153600
		p_FileType = "jpg/gif"
		p_SavePath = jd_path
		p_AutoSave = 0
		p_TotalSize= 0		
		strDate	   = replace(cstr(Date()),"-","")
		lngTime	   = clng(timer()*1000)
		Set binForm = Server.CreateObject("ADODB.Stream")
		Set binItem = Server.CreateObject("ADODB.Stream")
		Set objForm = Server.CreateObject("Scripting.Dictionary")
		objForm.CompareMode = 1
	End Sub

	Private Sub Class_Terminate
		objForm.RemoveAll
		Set objForm = nothing
		Set binItem = nothing
		if p_Error<>4 then binForm.Close()
		Set binForm = nothing
	End Sub

	Public Sub Open()
		if p_Error=-1 then
			p_Error=0
		else
			Exit Sub
		end if
		Dim lngRequestSize,lngReadSize,binRequestData,strFormItem,strFileItem,p_ChunkByte,intTemp,strTemp
		Const strSplit="'"">"
		lngRequestSize=Request.TotalBytes
		if lngRequestSize<1 or (lngRequestSize>p_TotalSize and p_TotalSize<>0) then
			p_Error=4
			Exit Sub
		end if
		binForm.Type = 1
		binForm.Open
		lngReadSize=0
		p_ChunkByte= 102400
		binItem.Type = 2
		binItem.Charset="gb2312"
		binItem.Open
		response.Flush()
		do
			binForm.write Request.BinaryRead(p_ChunkByte)
			lngReadSize=lngReadSize+p_ChunkByte
			if  lngReadSize >= lngRequestSize then exit do
			binItem.WriteText "lngTotalSize="&lngRequestSize&";lngReadSize="&lngReadSize&";"
			binItem.SaveToFile Server.MapPath("upLoadding.ini"),2
			response.flush()
		loop
		binItem.WriteText "lngTotalSize="&lngRequestSize&";lngReadSize="&lngReadSize&";"
		binItem.SaveToFile Server.MapPath("upLoadding.ini"),2
		binItem.Close()
		response.Flush()
		binForm.Position=0
		binRequestData=binForm.Read()

		Dim bCrLf,strSeparator,intSeparator
		bCrLf=ChrB(13)&ChrB(10)

		intSeparator=InstrB(1,binRequestData,bCrLf)-1
		strSeparator=LeftB(binRequestData,intSeparator)

		Dim p_start,p_end,strItem,strInam
		Dim strFtyp,strFnam,strFext,lngFsiz
		p_start=intSeparator+2
		Do
			p_end  =InStrB(p_start,binRequestData,bCrLf&bCrLf)+3
			binItem.Type=1
			binItem.Open
			binForm.Position=p_start
			binForm.CopyTo binItem,p_end-p_start
			binItem.Position=0
			binItem.Type=2
			binItem.Charset="gb2312"
			strItem=binItem.ReadText
			binItem.Close()

			p_start=p_end
			p_end  =InStrB(p_start,binRequestData,strSeparator)-1
			binItem.Type=1
			binItem.Open
			binForm.Position=p_start
			lngFsiz=p_end-p_start-2
			binForm.CopyTo binItem,lngFsiz

			intTemp=Instr(39,strItem,"""")
			strInam=Mid(strItem,39,intTemp-39)

			if Instr(intTemp,strItem,"filename=""")<>0 then
			if not objForm.Exists(strInam&"_From") then
				strFileItem=strFileItem&strSplit&strInam
				if binItem.Size<>0 then
					intTemp=intTemp+13
					strFtyp=Mid(strItem,Instr(intTemp,strItem,"Content-Type: ")+14)
					strTemp=Mid(strItem,intTemp,Instr(intTemp,strItem,"""")-intTemp)
					intTemp=InstrRev(strTemp,"\")
					strFnam=Mid(strTemp,intTemp+1)
					objForm.Add strInam&"_Type",strFtyp
					objForm.Add strInam&"_Name",strFnam
					objForm.Add strInam&"_Path",Left(strTemp,intTemp)
					objForm.Add strInam&"_Size",lngFsiz
					if Instr(intTemp,strTemp,".")<>0 then
						strFext=Mid(strTemp,InstrRev(strTemp,".")+1)
					else
						strFext=""
					end if
					if left(strFtyp,6)="image/" then
						binItem.Position=0
						binItem.Type=1
						strTemp=binItem.read(10)
						if strcomp(strTemp,chrb(255) & chrb(216) & chrb(255) & chrb(224) & chrb(0) & chrb(16) & chrb(74) & chrb(70) & chrb(73) & chrb(70),0)=0 then
							if Lcase(strFext)<>"jpg" then strFext="jpg"
							binItem.Position=3
							do while not binItem.EOS
								do
									intTemp = ascb(binItem.Read(1))
								loop while intTemp = 255 and not binItem.EOS
								if intTemp < 192 or intTemp > 195 then
									binItem.read(Bin2Val(binItem.Read(2))-2)
								else
									Exit do
								end if
								do
									intTemp = ascb(binItem.Read(1))
								loop while intTemp < 255 and not binItem.EOS
							loop
							binItem.Read(3)
							objForm.Add strInam&"_Height",Bin2Val(binItem.Read(2))
							objForm.Add strInam&"_Width",Bin2Val(binItem.Read(2))
						elseif strcomp(leftB(strTemp,8),chrb(137) & chrb(80) & chrb(78) & chrb(71) & chrb(13) & chrb(10) & chrb(26) & chrb(10),0)=0 then
							if Lcase(strFext)<>"png" then strFext="png"
							binItem.Position=18
							objForm.Add strInam&"_Width",Bin2Val(binItem.Read(2))
							binItem.Read(2)
							objForm.Add strInam&"_Height",Bin2Val(binItem.Read(2))
						elseif strcomp(leftB(strTemp,6),chrb(71) & chrb(73) & chrb(70) & chrb(56) & chrb(57) & chrb(97),0)=0 or strcomp(leftB(strTemp,6),chrb(71) & chrb(73) & chrb(70) & chrb(56) & chrb(55) & chrb(97),0)=0 then
							if Lcase(strFext)<>"gif" then strFext="gif"
							binItem.Position=6
							objForm.Add strInam&"_Width",BinVal2(binItem.Read(2))
							objForm.Add strInam&"_Height",BinVal2(binItem.Read(2))
						elseif strcomp(leftB(strTemp,2),chrb(66) & chrb(77),0)=0 then
							if Lcase(strFext)<>"bmp" then strFext="bmp"
							binItem.Position=18
							objForm.Add strInam&"_Width",BinVal2(binItem.Read(4))
							objForm.Add strInam&"_Height",BinVal2(binItem.Read(4))
						end if
					end if
					objForm.Add strInam&"_Ext",strFext
					objForm.Add strInam&"_From",p_start
					intTemp=GetFerr(lngFsiz,strFext)
					if p_AutoSave<>2 then
						objForm.Add strInam&"_Err",intTemp
						if intTemp=0 then
							if p_AutoSave=0 then
								strFnam=GetTimeStr()
								if strFext<>"" then strFnam=strFnam&"."&strFext
							end if
							binItem.SaveToFile Server.MapPath(p_SavePath&strFnam),2
							objForm.Add strInam,strFnam
						end if
					end if
				else
					objForm.Add strInam&"_Err",-1
				end if
			end if
			else
				binItem.Position=0
				binItem.Type=2
				binItem.Charset="gb2312"
				strTemp=binItem.ReadText
				if objForm.Exists(strInam) then
					objForm(strInam) = objForm(strInam)&","&strTemp
				else
					strFormItem=strFormItem&strSplit&strInam
					objForm.Add strInam,strTemp
				end if
			end if

			binItem.Close()
			p_start = p_end+intSeparator+2
		loop Until p_start+3>lngRequestSize
		FormItem=split(strFormItem,strSplit)
		FileItem=split(strFileItem,strSplit)
	End Sub

	Private Function GetTimeStr()
		lngTime=lngTime+1
		GetTimeStr=strDate&lngTime
	End Function

	Private Function GetFerr(lngFsiz,strFext)
		dim intFerr
		intFerr=0
		if lngFsiz>p_MaxSize and p_MaxSize>0 then
			if p_Error=0 or p_Error=2 then p_Error=p_Error+1
			intFerr=intFerr+1
		end if
		if Instr(1,LCase("/"&p_FileType&"/"),LCase("/"&strFext&"/"))=0 and p_FileType<>"" then
			if p_Error<2 then p_Error=p_Error+2
			intFerr=intFerr+2
		end if
		GetFerr=intFerr
	End Function

	Public Function Save(Item,strFnam)
		Save=false
		if objForm.Exists(Item&"_From") then
			dim intFerr,strFext
			strFext=objForm(Item&"_Ext")
			intFerr=GetFerr(objForm(Item&"_Size"),strFext)
			if objForm.Exists(Item&"_Err") then
				if intFerr=0 then
					objForm(Item&"_Err")=0
				end if
			else
				objForm.Add Item&"_Err",intFerr
			end if
			if intFerr<>0 then Exit Function
			if VarType(strFnam)=2 then
				select case strFnam
					case 0:strFnam=GetTimeStr()
						if strFext<>"" then strFnam=strFnam&"."&strFext
					case 1:strFnam=objForm(Item&"_Name")
				end select
			end if
			binItem.Type = 1
			binItem.Open
			binForm.Position = objForm(Item&"_From")
			binForm.CopyTo binItem,objForm(Item&"_Size")
			binItem.SaveToFile Server.MapPath(p_SavePath&strFnam),2
			binItem.Close()
			if objForm.Exists(Item) then
				objForm(Item)=strFnam
			else
				objForm.Add Item,strFnam
			end if
			Save=true
		end if
	End Function

	Public Function GetData(Item)
		GetData=""
		if objForm.Exists(Item&"_From") then
			if GetFerr(objForm(Item&"_Size"),objForm(Item&"_Ext"))<>0 then Exit Function
			binForm.Position = objForm(Item&"_From")
			GetData=binFormStream.Read(objForm(Item&"_Size"))
		end if
	End Function

	Public Function Form(Item)
		if objForm.Exists(Item) then
			Form=objForm(Item)
		else
			Form=""
		end if
	End Function

	Private Function BinVal2(bin)
		dim lngValue,i
		lngValue = 0
		for i = lenb(bin) to 1 step -1
			lngValue = lngValue *256 + ascb(midb(bin,i,1))
		next
		BinVal2=lngValue
	End Function

	Private Function Bin2Val(bin)
		dim lngValue,i
		lngValue = 0
		for i = 1 to lenb(bin)
			lngValue = lngValue *256 + ascb(midb(bin,i,1))
		next
		Bin2Val=lngValue
	End Function

End Class
%>


<html>
<head>
<title>文件上传</title>
<style type="text/css">
<!--
.p9{ font-size: 9pt; font-family: 宋体 }
-->
</style>
<meta http-equiv="Content-Type" content="text/html; charset=gb2312">
</head>
<body leftmargin="0" topmargin="0" class="p9">
<%
dim editorstyle
editorstyle=1
 if n<>0 then
   call connopen(db)
   dim usertop,userid
	webname=conn.execute("select jd_webname,jd_editorstyle from admin",0,1)(0)
	userid=request.Cookies("JD100_NET_GBBOOK_"&webname)("id")

   set rs=conn.execute("select jd_topic,jd_cls from member where id="&userid&" ",0,1)
   if rs.eof then

	   rs.close
	   set rs=nothing
	   conn.close
	   set conn=nothing
        Response.Write "你还没有登录"
        Response.End
   else
	editorstyle=rs(1)
      if int(rs(0))<=n and int(rs(1))<5  and Session("Admin"&webname)="" then
	   rs.close
	   set rs=nothing
	   conn.close
	   set conn=nothing
        Response.Write "发贴:"&n&"以上的会员才可以上传"
        Response.End
	  end if
   end if
   rs.close
   set rs=nothing
   conn.close
   set conn=nothing
 end if


dim request2
set request2=New UpLoadClass
	request2.TotalSize= 104857600
	request2.MaxSize  = jd_size
	request2.FileType = jd_style 
	request2.open()

'外部提交
dim server_v1,server_v2
server_v1=Cstr(Request.ServerVariables("HTTP_REFERER")) 
server_v2=Cstr(Request.ServerVariables("SERVER_NAME")) 
if mid(server_v1,8,len(server_v2))<>server_v2 then 
response.Write "非法提交2"
response.end
end if 
dim ffff,filename,cls
filename=request2.SavePath&request2.Form("File1")
cls=request2.Form("cls")
webname=request2.Form("webname")
if cls="" and n<>0 then
	if editorstyle=0 then
	cls="words"
	else
	cls="content"
	end if
end if

ffff=lcase(right(filename,3))
		if request2.Error=1 then
		response.Write("超出"&jd_size&"限制")
		end if
		if request2.Error=2 then
		response.Write("不充许的上传类型")
		end if
		if request2.Error=4 then
		response.Write("超出限制")
		else

			if len(request2.Form("File1"))<3 then
					Response.Write " 上传失败"
			else

				if cls="content" then
					if ffff="gif" or ffff="jpg" or ffff="bmp" then
							response.write "<script>parent.Composition.document.body.innerHTML+=""<img src='"&filename&"' border='0'>"";</script>"
						else
							response.write "<script>parent.Composition.document.body.innerHTML+=""<a href="&filename&" target='_blank'>"&filename&"</a>""</script>"
					End if
				else
					if ffff="gif" or ffff="jpg" or ffff="bmp" then
					response.write "<script>parent.document.form."&cls&".value+='[img]"&filename&"[/img]'</script>"
					else
					response.write "<script>parent.document.form."&cls&".value+='[url]"&filename&"[/url]'</script>"
					end if
				
				end if
					Response.Write " 上传成功 "
			end if
		end if

set request2=nothing  '删除此对象
response.write "[<a href=""javascript:history.back();"">继续上传</a>]"
%>
</body>
</html>