'----------------------------------------------------------
'****************  风声无组件上传类 2.11  *****************
'作者：风声
'网站：http://www.fonshen.com
'邮件：webmaster@fonshen.com
'版权：版权全体,源代码公开,各种用途均可免费使用
'修改：迦楠
'网站：http://www.ishere.cn | http://www.aobodo.com
'说明：SavePath参数支持相对与绝对两种路径,并自动生成目标文件夹
'**********************************************************
'----------------------------------------------------------
Class UpLoadClass

Private m_TotalSize,m_MaxSize,m_FileType,m_SavePath,m_AutoSave,m_Error,m_Charset
Private m_dicForm,m_binForm,m_binItem,m_strDate,m_lngTime
Private m_Fso,astrPath, ulngPath, i, strTmpPath
Public  FormItem,FileItem

Public Property Get Version
Version="Fonshen UpLoadClass Version 2.11"
End Property

<span id="more-463"></span>

Public Property Get Error
Error=m_Error
End Property

Public Property Get Charset
Charset=m_Charset
End Property
Public Property Let Charset(strCharset)
m_Charset=strCharset
End Property

Public Property Get TotalSize
TotalSize=m_TotalSize
End Property
Public Property Let TotalSize(lngSize)
if isNumeric(lngSize) then m_TotalSize=Clng(lngSize)
End Property

Public Property Get MaxSize
MaxSize=m_MaxSize
End Property
Public Property Let MaxSize(lngSize)
if isNumeric(lngSize) then m_MaxSize=Clng(lngSize)
End Property

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

Public Property Get SavePath
SavePath=m_SavePath
End Property
Public Property Let SavePath(strPath)
m_SavePath=Replace(strPath,chr(0),"")
m_SavePath=AutoCreateFolder(m_SavePath)
End Property

Public Property Get AutoSave
AutoSave=m_AutoSave
End Property
Public Property Let AutoSave(byVal Flag)
select case Flag
case 0,1,2: m_AutoSave=Flag
end select
End Property

Private Sub Class_Initialize
m_Error    = -1
m_Charset  = "utf-8"
m_TotalSize= 0
m_MaxSize  = 153600
m_FileType = "jpg/gif"
m_SavePath = ""
m_AutoSave = 2
Dim dtmNow : dtmNow = Date()
m_strDate  = Year(dtmNow)&amp;Right("0"&amp;Month(dtmNow),2)&amp;Right("0"&amp;Day(dtmNow),2)
m_lngTime  = Clng(Timer()*1000)
Set m_binForm = Server.CreateObject("ADODB.Stream")
Set m_binItem = Server.CreateObject("ADODB.Stream")
Set m_dicForm = Server.CreateObject("Scripting.Dictionary")
m_dicForm.CompareMode = 1
Set m_Fso = Server.CreateObject("Scripting.FileSystemObject")
End Sub

Private Sub Class_Terminate
m_dicForm.RemoveAll
Set m_dicForm = nothing
Set m_binItem = nothing
m_binForm.Close()
Set m_binForm = nothing
Set m_Fso = nothing
End Sub

Public Function Open()
Open = 0
if m_Error=-1 then
m_Error=0
else
Exit Function
end if
Dim lngRequestSize : lngRequestSize=Request.TotalBytes
if m_TotalSize&gt;0 and lngRequestSize&gt;m_TotalSize then
m_Error=5
Exit Function
elseif lngRequestSize&lt;1 then
m_Error=4
Exit Function
end if

Dim lngChunkByte : lngChunkByte = 102400
Dim lngReadSize : lngReadSize = 0
m_binForm.Type = 1
m_binForm.Open()
do
m_binForm.Write Request.BinaryRead(lngChunkByte)
lngReadSize=lngReadSize+lngChunkByte
if  lngReadSize &gt;= lngRequestSize then exit do
loop
m_binForm.Position=0
Dim binRequestData : binRequestData=m_binForm.Read()

Dim bCrLf,strSeparator,intSeparator
bCrLf=ChrB(13)&amp;ChrB(10)
intSeparator=InstrB(1,binRequestData,bCrLf)-1
strSeparator=LeftB(binRequestData,intSeparator)

Dim strItem,strInam,strFtyp,strPuri,strFnam,strFext,lngFsiz
Const strSplit="'""&gt;"
Dim strFormItem,strFileItem,intTemp,strTemp
Dim p_start : p_start=intSeparator+2
Dim p_end
Do
p_end = InStrB(p_start,binRequestData,bCrLf&amp;bCrLf)-1
m_binItem.Type=1
m_binItem.Open()
m_binForm.Position=p_start
m_binForm.CopyTo m_binItem,p_end-p_start
m_binItem.Position=0
m_binItem.Type=2
m_binItem.Charset=m_Charset
strItem = m_binItem.ReadText()
m_binItem.Close()
intTemp=Instr(39,strItem,"""")
strInam=Mid(strItem,39,intTemp-39)

p_start = p_end + 4
p_end = InStrB(p_start,binRequestData,strSeparator)-1
m_binItem.Type=1
m_binItem.Open()
m_binForm.Position=p_start
lngFsiz=p_end-p_start-2
m_binForm.CopyTo m_binItem,lngFsiz

if Instr(intTemp,strItem,"filename=""")&lt;&gt;0 then
if not m_dicForm.Exists(strInam&amp;"_From") then
strFileItem=strFileItem&amp;strSplit&amp;strInam
if m_binItem.Size&lt;&gt;0 then
intTemp=intTemp+13
strFtyp=Mid(strItem,Instr(intTemp,strItem,"Content-Type: ")+14)
strPuri=Mid(strItem,intTemp,Instr(intTemp,strItem,"""")-intTemp)
intTemp=InstrRev(strPuri,"\")
strFnam=Mid(strPuri,intTemp+1)
m_dicForm.Add strInam&amp;"_Type",strFtyp
m_dicForm.Add strInam&amp;"_Name",strFnam
m_dicForm.Add strInam&amp;"_Path",Left(strPuri,intTemp)
m_dicForm.Add strInam&amp;"_Size",lngFsiz
if Instr(strFnam,".")&lt;&gt;0 then
strFext=Mid(strFnam,InstrRev(strFnam,".")+1)
else
strFext=""
end if

select case strFtyp
case "image/jpeg","image/pjpeg","image/jpg"
if Lcase(strFext)&lt;&gt;"jpg" then strFext="jpg"
m_binItem.Position=3
do while not m_binItem.EOS
do
intTemp = Ascb(m_binItem.Read(1))
loop while intTemp = 255 and not m_binItem.EOS
if intTemp &lt; 192 or intTemp &gt; 195 then
m_binItem.read(Bin2Val(m_binItem.Read(2))-2)
else
Exit do
end if
do
intTemp = Ascb(m_binItem.Read(1))
loop while intTemp &lt; 255 and not m_binItem.EOS
loop
m_binItem.Read(3)
m_dicForm.Add strInam&amp;"_Height",Bin2Val(m_binItem.Read(2))
m_dicForm.Add strInam&amp;"_Width",Bin2Val(m_binItem.Read(2))
case "image/gif"
if Lcase(strFext)&lt;&gt;"gif" then strFext="gif"
m_binItem.Position=6
m_dicForm.Add strInam&amp;"_Width",BinVal2(m_binItem.Read(2))
m_dicForm.Add strInam&amp;"_Height",BinVal2(m_binItem.Read(2))
case "image/png"
if Lcase(strFext)&lt;&gt;"png" then strFext="png"
m_binItem.Position=18
m_dicForm.Add strInam&amp;"_Width",Bin2Val(m_binItem.Read(2))
m_binItem.Read(2)
m_dicForm.Add strInam&amp;"_Height",Bin2Val(m_binItem.Read(2))
case "image/bmp"
if Lcase(strFext)&lt;&gt;"bmp" then strFext="bmp"
m_binItem.Position=18
m_dicForm.Add strInam&amp;"_Width",BinVal2(m_binItem.Read(4))
m_dicForm.Add strInam&amp;"_Height",BinVal2(m_binItem.Read(4))
case "application/x-shockwave-flash"
if Lcase(strFext)&lt;&gt;"swf" then strFext="swf"
m_binItem.Position=0
if Ascb(m_binItem.Read(1))=70 then
m_binItem.Position=8
strTemp = Num2Str(Ascb(m_binItem.Read(1)), 2 ,8)
intTemp = Str2Num(Left(strTemp, 5), 2)
strTemp = Mid(strTemp, 6)
while (Len(strTemp) &lt; intTemp * 4)
strTemp = strTemp &amp; Num2Str(Ascb(m_binItem.Read(1)), 2 ,8)
wend
m_dicForm.Add strInam&amp;"_Width", Int(Abs(Str2Num(Mid(strTemp, intTemp + 1, intTemp), 2) - Str2Num(Mid(strTemp, 1, intTemp), 2)) / 20)
m_dicForm.Add strInam&amp;"_Height",Int(Abs(Str2Num(Mid(strTemp, 3 * intTemp + 1, intTemp), 2) - Str2Num(Mid(strTemp, 2 * intTemp + 1, intTemp), 2)) / 20)
end if
end select

m_dicForm.Add strInam&amp;"_Ext",strFext
m_dicForm.Add strInam&amp;"_From",p_start
if m_AutoSave&lt;&gt;2 then
intTemp=GetFerr(lngFsiz,strFext)
m_dicForm.Add strInam&amp;"_Err",intTemp
if intTemp=0 then
if m_AutoSave=0 then
strFnam=GetTimeStr()
if strFext&lt;&gt;"" then strFnam=strFnam&amp;"."&amp;strFext
end if
m_binItem.SaveToFile m_SavePath&amp;strFnam,2
m_dicForm.Add strInam,strFnam
end if
end if
else
m_dicForm.Add strInam&amp;"_Err",-1
end if
end if
else
m_binItem.Position=0
m_binItem.Type=2
m_binItem.Charset=m_Charset
strTemp=m_binItem.ReadText
if m_dicForm.Exists(strInam) then
m_dicForm(strInam) = m_dicForm(strInam)&amp;","&amp;strTemp
else
strFormItem=strFormItem&amp;strSplit&amp;strInam
m_dicForm.Add strInam,strTemp
end if
end if

m_binItem.Close()
p_start = p_end+intSeparator+2
loop Until p_start+3&gt;lngRequestSize
FormItem=Split(strFormItem,strSplit)
FileItem=Split(strFileItem,strSplit)

Open = lngRequestSize
End Function

Private Function GetTimeStr()
m_lngTime=m_lngTime+1
GetTimeStr=m_strDate&amp;Right("00000000"&amp;m_lngTime,8)
End Function

Private Function GetFerr(lngFsiz,strFext)
dim intFerr
intFerr=0
if lngFsiz&gt;m_MaxSize and m_MaxSize&gt;0 then
if m_Error=0 or m_Error=2 then m_Error=m_Error+1
intFerr=intFerr+1
end if
if Instr(1,LCase("/"&amp;m_FileType&amp;"/"),LCase("/"&amp;strFext&amp;"/"))=0 and m_FileType&lt;&gt;"" then
if m_Error&lt;2 then m_Error=m_Error+2
intFerr=intFerr+2
end if
GetFerr=intFerr
End Function

Public Function Save(Item,strFnam)
Save=false
if m_dicForm.Exists(Item&amp;"_From") then
dim intFerr,strFext
strFext=m_dicForm(Item&amp;"_Ext")
intFerr=GetFerr(m_dicForm(Item&amp;"_Size"),strFext)
if m_dicForm.Exists(Item&amp;"_Err") then
if intFerr=0 then
m_dicForm(Item&amp;"_Err")=0
end if
else
m_dicForm.Add Item&amp;"_Err",intFerr
end if
if intFerr&lt;&gt;0 then Exit Function
if VarType(strFnam)=2 then
select case strFnam
case 0:strFnam=GetTimeStr()
if strFext&lt;&gt;"" then strFnam=strFnam&amp;"."&amp;strFext
case 1:strFnam=m_dicForm(Item&amp;"_Name")
end select
end if
m_binItem.Type = 1
m_binItem.Open
m_binForm.Position = m_dicForm(Item&amp;"_From")
m_binForm.CopyTo m_binItem,m_dicForm(Item&amp;"_Size")
m_binItem.SaveToFile m_SavePath&amp;strFnam,2
m_binItem.Close()
if m_dicForm.Exists(Item) then
m_dicForm(Item)=strFnam
else
m_dicForm.Add Item,strFnam
end if
Save=true
end if
End Function

Public Function GetData(Item)
GetData=""
if m_dicForm.Exists(Item&amp;"_From") then
if GetFerr(m_dicForm(Item&amp;"_Size"),m_dicForm(Item&amp;"_Ext"))&lt;&gt;0 then Exit Function
m_binForm.Position = m_dicForm(Item&amp;"_From")
GetData = m_binForm.Read(m_dicForm(Item&amp;"_Size"))
end if
End Function

Public Function Form(Item)
if m_dicForm.Exists(Item) then
Form=m_dicForm(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

Private Function Num2Str(num, base, lens)
Dim ret,i
ret = ""
while(num &gt;= base)
i   = num Mod base
ret = i &amp; ret
num = (num - i) / base
wend
Num2Str = Right(String(lens, "0") &amp; num &amp; ret, lens)
End Function

Private Function Str2Num(str, base)
Dim ret, i
ret = 0
for i = 1 to Len(str)
ret = ret * base + Cint(Mid(str, i, 1))
next
Str2Num = ret
End Function

Private Function AutoCreateFolder(strPath)
On Error Resume Next
If InStr(strPath, "\") &lt;=0 or InStr(strPath, ":") &lt;= 0 Then
strPath = Server.MapPath(strPath)
End If
If m_Fso.FolderExists(strPath) Then
AutoCreateFolder = strPath
Exit Function
End If
astrPath = Split(strPath, "\")
ulngPath = UBound(astrPath)
strTmpPath = ""
For i = 0 To ulngPath
strTmpPath = strTmpPath &amp; astrPath(i) &amp; "\"
If Not m_Fso.FolderExists(strTmpPath) Then
m_Fso.CreateFolder(strTmpPath)
End If
Next
AutoCreateFolder = strPath
End Function

End Class