TUpload无组件上传类

 <% 'response.charset = "utf-8" 'if request("act") = "upload" Then ' Dim up: Set up = new TUpload ' up.exec() ' response.write up.param 'End If Class TUpload Private FMaxSize,FAutoSave,FFilePath,FFileExts,FParam,FErrors Private FFilesDict,FRequestData,FItemData,FRequestBin Public FFileCount,FCharset,FRequestSize Dim bCrLf,strSeparator,intSeparator Property Get Errors() Dim arr,i,info If FErrors = "" And FFilesDict.count > 0 Then arr = FFilesDict.items For i = 0 To FFilesDict.count - 1 Set info = arr(i) If info.bErr Then FErrors = FErrors & info.FileName & " : " & info.ErrMsg & Chr(13) End If Next If Len(FErrors) > 1 Then FErrors = Left(FErrors,Len(FErrors) - 1) End If Errors = FErrors End Property Property Get Param() Dim arr,i,info If FParam = "" And FFilesDict.count > 0 Then arr = FFilesDict.items For i = 0 To FFilesDict.count - 1 Set info = arr(i) If Not info.bErr Then FParam = FParam & info.FieldName & "=" & info.SaveFileName & "&" End If Next If Len(FParam) > 1 Then FParam = Left(FParam,Len(FParam) - 1) End If Param = FParam End Property Public Property Let MaxSize(value) if isNumeric(value) then FMaxSize = Clng(value) End Property Public Property Let FileExts(value) FFileExts = value ' "|" 分隔 End Property Public Property Let FilePath(value) FFilePath = Replace(value,chr(0),"") End Property Public Property Let AutoSave(byVal value) FAutoSave = value End Property Property Get Files() Set Files = FFilesDict End Property Private Sub Class_Initialize FFileCount = 0 FCharset = Response.Charset FMaxSize = 1024 * 1024 FFileExts = "*" FAutoSave = True FFilePath = server.mappath(".") & "/" FRequestSize = Request.TotalBytes bCrLf = ChrB(13) & ChrB(10) Set FRequestData = Server.CreateObject("ADODB.Stream") Set FItemData = Server.CreateObject("ADODB.Stream") Set FFilesDict = Server.CreateObject("Scripting.Dictionary") FFilesDict.CompareMode = 1 End Sub Private Sub Class_Terminate Set FItemData = Nothing FFilesDict.RemoveAll : Set FFilesDict = Nothing FRequestData.Close() : Set FRequestData = Nothing End Sub Public Function exec() exec = false If FRequestSize <= 0 Then Exit Function Dim lngChunkByte : lngChunkByte = 1024 * 100 Dim lngReadSize : lngReadSize = 0 FRequestData.Type = 1 FRequestData.Open() do FRequestData.Write Request.BinaryRead(lngChunkByte) lngReadSize = lngReadSize + lngChunkByte if lngReadSize >= FRequestSize then exit do loop FRequestData.Position = 0 FRequestBin = FRequestData.Read() intSeparator = InstrB(1,FRequestBin,bCrLf)-1 strSeparator = LeftB(FRequestBin,intSeparator) Dim p_start,p_end p_start = intSeparator + 2 Do Call saveFileInfo(p_start,p_end) Loop Until p_start + 3 > FRequestSize If FAutoSave Then saveAll exec = true End Function Private function getItem(p_start,p_end) FItemData.Type = 1 FItemData.Open() FRequestData.Position = p_start FRequestData.CopyTo FItemData,p_end - p_start FItemData.Position = 0 FItemData.Type = 2 FItemData.Charset = FCharset getItem = FItemData.ReadText() FItemData.Close() End Function Private Function saveFileInfo(ByRef p_start,ByRef p_end) p_end = InStrB(p_start,FRequestBin,bCrLf&bCrLf) - 1 Dim strItem : strItem = getItem(p_start,p_end) p_start = p_end + 4 p_end = InStrB(p_start,FRequestBin,strSeparator) - 1 if Instr(strItem,"filename=""") <> 0 Then ' 获取文件列表 Dim info,intTemp,filename intTemp = Instr(strItem,"filename=""") + 10 filename = Mid(strItem,intTemp,Instr(intTemp,strItem,"""") - intTemp) If Trim(filename) <> "" Then Set info = new TFileInfo with info intTemp = Instr(39,strItem,"""") .FieldName = Mid(strItem,39,intTemp-39) .FileName = filename If InStr(.FileName,".") > 0 Then .FileExt = Mid(.FileName,InstrRev(.FileName,".") + 1) .FileType = Mid(strItem,Instr(intTemp,strItem,"Content-Type: ")+14) .FileSize = p_end - p_start - 2 .FilePos = p_start End with checkFile info FFileCount = FFileCount + 1 FFilesDict.add FFileCount,info ' add file info End If End If p_start = p_end + intSeparator + 2 End Function Private Sub checkFile(ByRef Info) Info.bErr = False If InStr(FFileExts,Info.FileExt) <= 0 And InStr(FFileExts,"*") <= 0 Then Info.bErr = True Info.ErrMsg = "file ext. not allow" & Info.FileExt Exit Sub End If If Info.FileSize > FMaxSize Then Info.bErr = True Info.ErrMsg = "file too large" & Info.FileSize End If End Sub Private Function genFileName(i) Dim filename : filename = now() filename = replace(filename,"-","") filename = replace(filename,":","") filename = replace(filename," ","") genFileName = filename & i End Function Private Function saveAll() Dim i For i = 1 To FFilesDict.count Call save(i,genFileName(i)) Next End Function Public Function Save(item,filename) Dim info If Not FFilesDict.exists(item) Then Exit Function Set info = FFilesDict.item(item) If info.bErr Then Exit Function FItemData.Type = 1 FItemData.Open FRequestData.Position = info.FilePos FRequestData.CopyTo FItemData,info.FileSize filename = FFilePath & filename & "." & info.FileExt FItemData.SaveToFile filename,2 FItemData.Close() info.SaveFileName = filename Save = true End Function End Class ' 文件信息记录 Class TFileInfo Dim FieldName,FilePos,FileSize,FileName,FileExt,FileType,bErr,ErrMsg,SaveFileName End Class %>