asp上传文件类

Private Sub Class_Initialize()
set Form = server.createobject("Scripting.Dictionary")
set Fils = server.createobject("Scripting.Dictionary")
Set StreamT = server.CreateObject("Adodb.stream")

vMaxSize = -1
vSingleSize = -1
vErr = -1
vExe = ""
vTotalSize = 0
vCharSet = "gb2312"
vOP=false
pID="AnUpload"
setApp "",0,0,""
vMode = 0
StreamOpened=false
End Sub

Private Sub Class_Terminate()
Dim f
Form.RemoveAll()
For each f in Fils 
Fils(f).value=empty
Set Fils(f) = Nothing
Next
Fils.RemoveAll()
Set Form = Nothing
Set Fils = Nothing
if StreamOpened then StreamT.close()
Set StreamT = Nothing
End Sub

'==============================
'函数名:GetData
'作用:处理客户端提交来的所有数据
'==============================
Public Sub GetData()
Dim time1
time1 = timer()
if vOP And trim(request.querystring("processid"))<>"" then pID=request.querystring("processid")
Dim value, str, bcrlf, fpos, sSplit, slen, istart,ef
Dim TotalBytes,tempdata,BytesRead,ChunkReadSize,PartSize,DataPart,formend, formhead, startpos, endpos, formname, FileName, fileExe, valueend, NewName,localname,type_1,contentType
TotalBytes = Request.TotalBytes
ef = false
If checkEntryType = false Then ef = true : vErr = 2
'下面3句注释掉了，因为在IIS5.0中，如果上传大小大于限制大小的文件，会出错，一直没找到解决方法。如果是在IIS5以上的版本使用，可以取消下面3句的注释
If Not ef Then
If vMaxSize > 0 And TotalBytes > vMaxSize Then ef = true : vErr = 1
End If
If ef Then Exit Sub
If vMode = 0 Then
vTotalSize = 0 
StreamT.Type = 1
StreamT.Mode = 3
StreamT.Open
StreamOpened = true
BytesRead = 0
ChunkReadSize = 1024 * 16
Do While BytesRead < TotalBytes
PartSize = ChunkReadSize
If PartSize BytesRead > TotalBytes Then PartSize = TotalBytes - BytesRead
DataPart = Request.BinaryRead(PartSize)
StreamT.Write DataPart
BytesRead = BytesRead PartSize
setApp "uploading",TotalBytes,BytesRead,""
Loop
setApp "uploaded",TotalBytes,BytesRead,""
StreamT.Position = 0
tempdata = StreamT.Read
Else
tempdata = Request.BinaryRead(TotalBytes)
End If
bcrlf = ChrB(13) & ChrB(10)
fpos = InStrB(1, tempdata, bcrlf)
        sSplit = MidB(tempdata, 1, fpos - 1)
slen = LenB(sSplit)
istart = slen 2
        Do
            formend = InStrB(istart, tempdata, bcrlf & bcrlf)
            formhead = MidB(tempdata, istart, formend - istart)
            str = Bytes2Str(formhead)
            startpos = InStr(str, "name=""") 6
            endpos = InStr(startpos, str, """")
            formname = LCase(Mid(str, startpos, endpos - startpos))
            valueend = InStrB(formend 3, tempdata, sSplit)
If InStr(str, "filename=""") > 0 Then
startpos = InStr(str, "filename=""") 10
endpos = InStr(startpos, str, """")
type_1=instr(endpos,lcase(str),"content-type")
contentType=trim(mid(str,type_1 13))
FileName = Mid(str, startpos, endpos - startpos)
If Trim(FileName) <> "" Then
FileName = Replace(FileName, "/", "\")
FileName = Replace(FileName, chr(0), "")
LocalName = FileName
FileName = Mid(FileName, InStrRev(FileName, "\") 1)
If instr(FileName,".")>0 Then
fileExe = Split(FileName, ".")(UBound(Split(FileName, ".")))
else
fileExe = ""
End If
If vExe <> "" Then '判断扩展名
If checkExe(fileExe) = True Then
vErr = 3
vErrExe = fileExe
tempdata = empty
Exit Sub
End If
End If
NewName = Getname()
NewName = NewName & "." & fileExe
vTotalSize = vTotalSize valueend - formend - 6
If vSingleSize > 0 And (valueend - formend - 6) > vSingleSize Then '判断上传单个文件大小
vErr = 5
tempdata = empty
Exit Sub
End If
If vMaxSize > 0 And vTotalSize > vMaxSize Then '判断上传数据总大小
vErr = 1
tempdata = empty
Exit Sub
End If
If Fils.Exists(formname) Then
vErr = 4
tempdata = empty
Exit Sub
Else
Dim fileCls:set fileCls= new UploadFileEx
fileCls.ContentType=contentType
fileCls.Size = (valueend - formend - 6)
fileCls.Position = (formend 3)
fileCls.FormName = formname
fileCls.NewName = NewName
fileCls.FileName = FileName
fileCls.LocalName = FileName
fileCls.extend=split(NewName,".")(ubound(split(NewName,".")))
Fils.Add formname, fileCls
Set fileCls = Nothing
End If
End If
Else
value = MidB(tempdata, formend 4, valueend - formend - 6)
If Form.Exists(formname) Then
Form(formname) = Form(formname) & "," & Bytes2Str(value)
Else
Form.Add formname, Bytes2Str(value)
End If
End If
            istart = valueend 2 slen
        Loop Until (istart 2) >= LenB(tempdata)
vErr = 0
tempdata = empty
vLostTime = FormatNumber((timer-time1)*1000,2)
End Sub

Public sub setApp(stp,total,current,desc)
Application.lock()
Application(pID)="{ID:""" & pID & """,step:""" & stp & """,total:" & total & ",now:" & current & ",description:""" & desc & """,dt:""" & now() & """}"
Application.unlock()
end sub
'==============================
'判断扩展名
'==============================
Private Function checkExe(ByVal ex)
Dim notIn: notIn = True
If vExe="*" then
notIn=false 
elseIf InStr(1, vExe, "|") > 0 Then
Dim tempExe: tempExe = Split(vExe, "|")
Dim I: I = 0
For I = 0 To UBound(tempExe)
If LCase(ex) = tempExe(I) Then
notIn = False
Exit For
End If
Next
Else
If vExe = LCase(ex) Then
notIn = False
End If
End If
checkExe = notIn
End Function

'==============================
'把数字转换为文件大小显示方式
'==============================
Public Function GetSize(ByVal Size)
If Size < 1024 Then
GetSize = FormatNumber(Size, 2) & "B"
ElseIf Size >= 1024 And Size < 1048576 Then
GetSize = FormatNumber(Size / 1024, 2) & "KB"
ElseIf Size >= 1048576 Then
GetSize = FormatNumber((Size / 1024) / 1024, 2) & "MB"
End If
End Function

'==============================
'二进制数据转换为字符
'==============================
Private Function Bytes2Str(ByVal byt)
If LenB(byt) = 0 Then
Bytes2Str = ""
Exit Function
End If
Dim mystream, bstr
Set mystream =server.createobject("ADODB.Stream")
mystream.Type = 2
mystream.Mode = 3
mystream.Open
mystream.WriteText byt
mystream.Position = 0
mystream.CharSet = vCharSet
mystream.Position = 2
bstr = mystream.ReadText()
mystream.Close
Set mystream = Nothing
Bytes2Str = bstr
End Function

'==============================
'获取错误描述
'==============================
Private Function GetErr(ByVal Num)
Select Case Num
Case 0
GetErr = "数据处理完毕!"
Case 1
GetErr = "上传数据超过" & GetSize(vMaxSize) & "限制!可设置MaxSize属性来改变限制!"
Case 2
GetErr = "未设置上传表单enctype属性为multipart/form-data或者未设置method属性为Post,上传无效!"
Case 3
GetErr = "含有非法扩展名(" & vErrExe & ")文件!只能上传扩展名为" & Replace(vExe, "|", ",") & "的文件"
Case 4
GetErr = "对不起,程序不允许使用相同name属性的文件域!"
Case 5
GetErr = "单个文件大小超出" & GetSize(vSingleSize) & "的上传限制!"
End Select
End Function

'==============================
'根据日期生成随机文件名
'==============================
Private Function Getname()
Dim y, m, d, h, mm, S, r
Randomize
y = Year(Now)
m = right("0" & Month(Now),2)
d = right("0" & Day(Now),2)
h = right("0" & Hour(Now),2)
mm =right("0" & Minute(Now),2)
S = right("0" & Second(Now),2)
r = 0
r = CInt(Rnd() * 10000)
S = right("0000" & r,4)
Getname = y & m & d & h & mm & S & r
End Function

'==============================
'检测上传类型是否为multipart/form-data
'==============================
Private Function checkEntryType()
Dim ContentType, ctArray, bArray,RequestMethod
RequestMethod=trim(LCase(Request.ServerVariables("REQUEST_METHOD")))
if RequestMethod="" or RequestMethod<>"post" then
checkEntryType = False
exit function
end if
ContentType = LCase(Request.ServerVariables("HTTP_CONTENT_TYPE"))
ctArray = Split(ContentType, ";")
if ubound(ctarray)>=0 then
If Trim(ctArray(0)) = "multipart/form-data" Then
checkEntryType = True
vboundary = Split(ContentType,"boundary=")(1)
Else
checkEntryType = False
End If
else
checkEntryType = False
end if
End Function

'==============================
'获取上传表单值,参数可选,如果为-1则返回一个包含所有表单项的一个dictionary对象
'==============================
Public Function Forms(ByVal formname)
If trim(formname) = "-1" Then
Set Forms = Form
Else
If Form.Exists(LCase(formname)) Then
Forms = Form(LCase(formname))
Else
Forms = ""
End If
End If
End Function

'==============================
'获取上传的文件类,参数可选,如果为-1则返回一个包含所有上传文件类的一个dictionary对象
'==============================
Public Function Files(ByVal formname)
If trim(formname) = "-1" Then
Set Files = Fils
Else
If Fils.Exists(LCase(formname)) Then
Set Files = Fils(LCase(formname))
Else
Set Files = Nothing
End If
End If
End Function
End Class

Class UploadFileEx
Private mvarFormName , mvarNewName , mvarLocalName , mvarFileName , mvarUserSetName , mvarContentType ,mException,mvarPosition
Private mvarSize , mvarValue , mvarPath , mvarExtend ,mvarWidth, mvarHeight

Public Property Let Extend(ByVal vData )
mvarExtend = vData
End Property
Public Property Get Extend() 
Extend = mvarExtend
End Property

Public Property Get Width() 
Width = mvarWidth
End Property

Public Property Get Height() 
Height = mvarHeight
End Property


Public Property Let Path(ByVal vData )
mvarPath = vData
End Property
Public Property Get Path() 
Path = mvarPath
End Property

Public Property Get Exception() 
Exception = mException
End Property

Public Property Let Value(ByVal vData )
mvarValue = vData
End Property

Public Property Get Value() 
Value = mvarValue
End Property

Public Property Let Size(ByVal vData )
mvarSize = vData
End Property
Public Property Get Size() 
Size = mvarSize
End Property

Public Property Let Position(ByVal vData )
mvarPosition = vData
End Property
Public Property Get Position() 
Size = mvarPosition
End Property

Public Property Let ContentType(ByVal vData )
mvarContentType = vData
End Property
Public Property Get ContentType() 
ContentType = mvarContentType
End Property

Public Property Let UserSetName(ByVal vData )
mvarUserSetName = vData
End Property
Public Property Get UserSetName() 
UserSetName = mvarUserSetName
End Property

Public Property Let FileName(ByVal vData )
mvarFileName = vData
End Property
Public Property Get FileName() 
FileName = mvarFileName
End Property

Public Property Let LocalName(ByVal vData )
mvarLocalName = vData
End Property
Public Property Get LocalName() 
LocalName = mvarLocalName
End Property

Public Property Let NewName(ByVal vData )
mvarNewName = vData
End Property
Public Property Get NewName() 
NewName = mvarNewName
End Property

Public Property Let FormName(ByVal vData )
mvarFormName = vData
End Property
Public Property Get FormName() 
FormName = mvarFormName
End Property