无组件多文件上传系统(三)

无组件多文件上传系统(三) 第三部分：风声文件上传类文件 uploadclass.asp 这个未动过，咱也不懂 <% '---------------------------------------------------------- '***************** 风声无组件上传类 2.0 ***************** '作者：风声 '网站： '邮件：Rumor@17560.net '版权：版权全体,源代码公开,各种用途均可免费使用 '********************************************************** '---------------------------------------------------------- Class UpLoadClass Private p_MaxSize,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.0" 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 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 = 1536000 '最大150K 153600 p_FileType = "jpg/gif" p_SavePath = "" p_AutoSave = 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 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,binRequestData,strFormItem,strFileItem Const strSplit="'"">" lngRequestSize=Request.TotalBytes if lngRequestSize<1 then p_Error=4 Exit Sub end if binRequestData=Request.BinaryRead(lngRequestSize) binForm.Type = 1 binForm.Open binForm.Write binRequestData 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,intTemp,strTemp 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 %>