xu_class.asp

插件介绍： XUploadFiles 是一个用于辅助网站进行文件上传的客户端插件

<%
' ****************************************************
' ASP for XUploadFiles 2.1.0.0
' 程序制作：blue999.com
' 版权所有：blue999.com
' 主页地址：http://www.blue999.com/xuploadfiles/
' 程序申明：用于商业应用时请与作者联系
' 最后修改：2005.11.16
' ****************************************************
Class XUpload_class
Public Form,File
Private oUpFileStream,AIQSN,VUELO,SFNHV,RYXYV,UVBWH,ZFSKG,ITLUT,GIONB,TLRKK,XASTU,RRUGY,RXZWA,CANBM,JEGUI,IXIZC,MJKVP

Public Function GetVersion
GetVersion=SFNHV
End Function
Public Function IsError
IsError=RYXYV
End Function
Public Sub SetOverlayMode(value)
UVBWH=value
End Sub
Public Sub SetMinFileSize(value)
ZFSKG=value
End Sub
Public Sub SetMaxFileSize(value)
ITLUT=value
End Sub
Public Sub SetMaxFileCount(value)
GIONB=value
End Sub
Public Sub SetMaxTotalSize(value)
TLRKK=value
End Sub
Public Sub SetAllowExt(value)
XASTU=LCase(Trim(value))
If(XASTU<>"") Then XASTU=";" + XASTU + ";"
End Sub
Public Sub SetDenyExt(value)
RRUGY=LCase(Trim(value))
if(RRUGY<>"") Then RRUGY=";" + RRUGY + ";"
End Sub
Public Sub SetThumbImage(value)
RXZWA=Trim(value)
End Sub
Public Sub SetStatURL(value)
CANBM=Trim(value)
End Sub
Public Function HasThumbImage
HasThumbImage=false
If StrComp(Form("xu_thumbtag"),"thumb",vbTextCompare)=0 Then HasThumbImage=true
End Function
Public Sub OutErr(message)
RYXYV=true
Response.Write(message)
End Sub
Public Sub Out(message)
If NOT RYXYV AND Not IXIZC Then
IXIZC=true
Response.Write("ok")
End If
Response.Write(JEGUI)
Response.Write(message)
End Sub

 Private Sub Class_Initialize
AIQSN="Provider=Microsoft.Jet.OLEDB.4.0;Data Source="
VUELO="XUploadFiles.mdb"
SFNHV=2100
RYXYV=false
SetOverlayMode(false)
SetMinFileSize(1)
SetMaxFileSize(10485760)
SetMaxFileCount(100)
SetMaxTotalSize(10485760)
SetAllowExt("")
SetDenyExt("asa;asp;cdx;cer;aspx;php")
SetThumbImage("")
SetStatURL("")
JEGUI=Chr(7)
IXIZC=false
MJKVP="XUploadFiles.asa"
End Sub
Public Sub InitParameters
If RYXYV Then Exit Sub
WOOUP()
If RYXYV Then Exit Sub
Dim WQWOM,NKPXY
Set WQWOM=New RegExp
Set NKPXY=New RegExp
WQWOM.Pattern="\D"
WQWOM.IgnoreCase=true
NKPXY.Pattern="[\/|\\]"
NKPXY.IgnoreCase=true
If CLng(Form("xu_version")) < SFNHV Then
OutErr("您的上传插件版本太低，请升级到最新版本。")
ElseIf WQWOM.Test(Form("xu_verifier")) OR NKPXY.Test(Form("xu_tag")) Then
OutErr("发送的数据格式不正确。")
ElseIf Form("xu_operate")="init" Then
on error Resume Next
Dim EKBKG,OQOIT,RRDQR
EKBKG=Server.MapPath(MJKVP)
Set OQOIT=CreateObject("Scripting.FileSystemObject")
If OQOIT.FileExists(EKBKG) AND DateDiff("n",Application("xu_EKBKG"),Now) >= 30 Then
Set RRDQR=OQOIT.GetFile(EKBKG)
If RRDQR.size > 10485760 Then RRDQR.Delete
Set RRDQR=Nothing
End If
If NOT OQOIT.FileExists(EKBKG) Then OQOIT.CopyFile Server.MapPath(VUELO),EKBKG
Set OQOIT=Nothing
Out(SFNHV)
Out(ZFSKG)
Out(ITLUT)
Out(GIONB)
Out(TLRKK)
Out(XASTU)
Out(RRUGY)
Out(RXZWA)
Out(CANBM)
RYXYV=true
ElseIf Form("xu_operate")="postclose" Then
Out("ok")
RYXYV=true
Else
Application("xu_EKBKG")=Now
End If
Set WQWOM=Nothing
Set NKPXY=Nothing
End Sub
Public Function IsUploadFile
IsUploadFile=false
If RYXYV Then Exit Function
If Form("xu_operate")="postdata" Then
Dim LNTWN,PLPNY
Set PLPNY=New RegExp
PLPNY.Pattern="[\/|\\|\.]"
PLPNY.IgnoreCase=true
LNTWN=Form("xu_tag")
If LNTWN="0" OR(LNTWN="" AND Form("xu_desc")<>"") OR(LNTWN<>"" AND CLng(Form("xu_length"))=0) OR(LNTWN<>"" AND CLng(Form("xu_offset"))=0 AND Form("xu_desc")="") OR PLPNY.Test(Form("xu_desc")) OR File("xu_postfile").FileSize<>CLng(Form("xu_length")) OR CLng(Form("xu_offset")) + CLng(Form("xu_length")) > CLng(Form("xu_filelength")) Then
Set PLPNY=Nothing
OutErr("发送的数据格式不正确。")
Exit Function
End If
Set PLPNY=Nothing
If CLng(Form("xu_filelength")) < ZFSKG Then
OutErr("上传文件的长度小于服务器的最小限制。")
Exit Function
End If
If CLng(Form("xu_filelength")) > ITLUT Then
OutErr("上传文件的长度超过服务器限制。")
Exit Function
End If
If LNTWN="" AND NOT NVKWL(File("xu_postfile").FileName) Then
OutErr("服务器不接受该类型的文件。")
Exit Function
End If
' 数据库结构：ID,ParentID,Verifier,UpDesc,FileData,DataLength,UpDate
If Clng(Form("xu_length"))=0 Then
LNTWN="0"
Else
on error Resume Next
Dim FQKWC,VRIQB
Set FQKWC=Server.CreateObject("ADODB.Connection")
FQKWC.Open AIQSN & Server.MapPath(MJKVP)
Set VRIQB=Server.CreateObject("ADODB.Recordset")
VRIQB.Open "upload",FQKWC,1,3,2
VRIQB.AddNew
If LNTWN<>"" Then VRIQB("ParentID")=LNTWN
VRIQB("Verifier")=Form("xu_verifier")
If Form("xu_desc")<>"" Then VRIQB("UpDesc")=Form("xu_desc")
oUpFileStream.Position=File("xu_postfile").FileStart
VRIQB("FileData").AppendChunk oUpFileStream.Read(File("xu_postfile").FileSize)
VRIQB("DataLength")=File("xu_postfile").FileSize
VRIQB("UpDate")=Now
VRIQB.Update
If LNTWN="" Then
LNTWN=VRIQB("ID")
VRIQB("ParentID")=VRIQB("ID")
VRIQB.Update
End If
VRIQB.Close
Set VRIQB=Nothing
FQKWC.Close
Set FQKWC=Nothing
If Err.number<>0 Then
OutErr("服务器保存文件数据发生错误，请重新上传文件。")
Exit Function
End If
End If
Out(LNTWN)
RYXYV=true
ElseIf Form("xu_operate")="postfile" Then
Else
OutErr("服务器不支持该命令。")
End If
IsUploadFile=NOT RYXYV
End Function
Public Function SaveToFile(ByVal WAMEJ)
SaveToFile=""
If RYXYV OR WAMEJ="" Then Exit Function
If InStr(WAMEJ,":")=0 Then WAMEJ=Server.MapPath(WAMEJ)
If NOT NVKWL(WAMEJ) Then
OutErr("服务器不接受该类型文件。")
Exit Function
End If
If CLng(Form("xu_filesize")) < ZFSKG Then
OutErr("上传文件的长度小于服务器的最小限制。")
Exit Function
End If
If CLng(Form("xu_filesize")) > ITLUT Then
OutErr("上传文件的长度超过服务器限制。")
Exit Function
End If
If NOT UVBWH Then
Dim TKJHE,QFUVY,GMFBA
QFUVY=DZIMS(WAMEJ)
TKJHE=""
If InStrRev(QFUVY,".") > 0 Then TKJHE=Mid(QFUVY,InStrRev(QFUVY,"."))
WAMEJ=Left(WAMEJ,Len(WAMEJ)-Len(TKJHE)) & "-"
Randomize
Dim OQOIT
Set OQOIT=CreateObject("Scripting.FileSystemObject")
For GMFBA=0 To 100
QFUVY=CLng(Rnd * 8999) + 1000
If NOT OQOIT.FileExists(WAMEJ & QFUVY & TKJHE) Then Exit For
Next
Set OQOIT=Nothing
WAMEJ=WAMEJ & QFUVY & TKJHE
End If
If NOT YCFDY(WAMEJ) Then
OutErr("服务器不接受该类型文件。")
Else
Dim CHIBW
CHIBW=CLng(Form("xu_filesize"))
If Form("xu_tag")="0" Then CHIBW=0
SaveToFile=JCWEI(WAMEJ,CHIBW,"SELECT * FROM upload WHERE ParentID=" & Form("xu_tag") & " AND IsNull(UpDesc) AND Verifier=" & Form("xu_verifier") & " ORDER BY ID")
End If
End Function
Public Function SaveThumbToFile(ByVal WAMEJ)
If InStr(WAMEJ,":")=0 Then WAMEJ=Server.MapPath(WAMEJ)
If RYXYV OR WAMEJ="" OR NOT NVKWL(WAMEJ) OR NOT HasThumbImage() OR Form("xu_tag")="0" OR CLng(Form("xu_thumbsize"))=0 OR CLng(Form("xu_thumbsize")) > ITLUT Then
SaveThumbToFile=""
ElseIf NOT YCFDY(WAMEJ) Then
SaveThumbToFile=""
Else
SaveThumbToFile=JCWEI(WAMEJ,Clng(Form("xu_thumbsize")),"SELECT * FROM upload WHERE ParentID=" & Form("xu_tag") & " AND UpDesc=""thumb"" AND Verifier=" & Form("xu_verifier") & " ORDER BY ID")
End If
End Function
Public Function CreateFileName(ByVal IYPOT,ByVal WFLBF,ByVal WAMEJ)
If InStr(WFLBF,".") > 0 Then
CreateFileName=""
OutErr("路径或文件名中包含有非法字符")
Exit Function
End If
If IYPOT="" Then IYPOT="."
If InStr(IYPOT,":")=0 Then IYPOT=Server.MapPath(IYPOT) & "\"
If Right(IYPOT,1)<>"/" AND Right(IYPOT,1)<>"\" Then IYPOT=IYPOT & "/"
If WFLBF<>"" Then
If Left(WFLBF,1)="/" OR Left(WFLBF,1)="\" Then WFLBF=Mid(WFLBF,2)
End If
If WFLBF<>"" Then
If Right(WFLBF,1)<>"/" AND Right(WFLBF,1)<>"\" Then WFLBF=WFLBF & "/"
End If
CreateFileName=IYPOT & WFLBF & DZIMS(WAMEJ)
End Function
Public Function CreateFileURL(ByVal IYPOT,ByVal WFLBF,ByVal WAMEJ)
If IYPOT="" Then IYPOT="."
If InStr(IYPOT,":")=0 Then
If Right(IYPOT,1)<>"/" AND Right(IYPOT,1)<>"\" Then IYPOT=IYPOT & "/"
Else
IYPOT="/*内部地址*/"
End If
If WFLBF<>"" Then
If Left(WFLBF,1)="/" OR Left(WFLBF,1)="\" Then WFLBF=Mid(WFLBF,2)
End If
If WFLBF<>"" Then
If Right(WFLBF,1)<>"/" AND Right(WFLBF,1)<>"\" Then WFLBF=WFLBF & "/"
End If
CreateFileURL= IYPOT & WFLBF & DZIMS(WAMEJ)
End Function

 Private Function NVKWL(ByVal WAMEJ)
NVKWL=true
Dim TKJHE
WAMEJ=DZIMS(WAMEJ)
TKJHE=Trim(LCase(Mid(WAMEJ,InStrRev(WAMEJ,".")+1)))
If InStrRev(WAMEJ,".") > 0 Then
TKJHE=";" & TKJHE & ";"
If XASTU<>"" Then
If InStr(XASTU,TKJHE)=0 Then NVKWL=false
ElseIf RRUGY<>"" Then
If InStr(RRUGY,TKJHE) > 0 Then  NVKWL=false
End If
ElseIf XASTU<>"" Then
NVKWL=false
End If
End Function
 Private Function YCFDY(ByVal WAMEJ)
YCFDY=false
If InStr(WAMEJ,":")=0 Then WAMEJ=Server.MapPath(WAMEJ)
on error Resume Next
Dim IWURR,OQOIT,HVROI
Set OQOIT=CreateObject("Scripting.FileSystemObject")
IWURR=DZIMS(WAMEJ)
IWURR=Left(WAMEJ,Len(WAMEJ)-Len(IWURR)) & OQOIT.GetTempName & IWURR
Set HVROI=OQOIT.CreateTextFile(IWURR,1,false)
HVROI.Close
Set HVROI=OQOIT.GetFile(IWURR)
If StrComp(HVROI.Name,DZIMS(IWURR),vbTextCompare)=0 Then YCFDY=true
HVROI.Delete
Set HVROI=Nothing 
Set OQOIT=Nothing
If Err.number<>0 Then YCFDY=false
End Function
 Private Function DZIMS(ByVal WAMEJ)
Dim HVZHB,BXUFC
HVZHB=InStrRev(WAMEJ,"/")
BXUFC=InStrRev(WAMEJ,"\")
If HVZHB < BXUFC Then HVZHB=BXUFC
DZIMS=Mid(WAMEJ,HVZHB+1)
End Function
 Private Sub Class_Terminate
on error Resume Next
Form.RemoveAll
Set Form=Nothing
File.RemoveAll
Set File=Nothing
oUpFileStream.Close
Set oUpFileStream=Nothing
End Sub
 Private Sub WOOUP
on error Resume Next
Dim RequestBinDate,sSpace,bCrLf,sInfo,iInfoStart,iInfoEnd,tStream,iStart,oFileInfo
Dim sFormValue,sFileName
Dim iFindStart,iFindEnd
Dim iFormStart,iFormEnd,sFormName
'代码开始
If Request.TotalBytes < 1 Then'如果没有数据上传
OutErr("没有数据上传,这是因为直接提交网址所产生的错误!!")
Exit Sub
End If
Set Form=Server.CreateObject("Scripting.Dictionary")
Form.CompareMode=1
Set File=Server.CreateObject("Scripting.Dictionary")
File.CompareMode=1
Set tStream=Server.CreateObject("ADODB.Stream")
Set oUpFileStream=Server.CreateObject("ADODB.Stream")
if Err.number<>0 then
OutErr("创建流对象(ADODB.STREAM)时出错,可能系统不支持或没有开通该组件")
Exit Sub
End If
oUpFileStream.Type=1
oUpFileStream.Mode=3
oUpFileStream.Open 
oUpFileStream.Write Request.BinaryRead(Request.TotalBytes)
oUpFileStream.Position=0
RequestBinDate=oUpFileStream.Read 
iFormEnd=oUpFileStream.Size
bCrLf=ChrB(13) & ChrB(10)
'取得每个项目之间的分隔符
sSpace=MidB(RequestBinDate,1, InStrB(1,RequestBinDate,bCrLf)-1)
iStart=LenB(sSpace)
iFormStart=iStart+2
'分解项目
Do
iInfoEnd=InStrB(iFormStart,RequestBinDate,bCrLf & bCrLf)+3
tStream.Type=1
tStream.Mode=3
tStream.Open
oUpFileStream.Position=iFormStart
oUpFileStream.CopyTo tStream,iInfoEnd-iFormStart
tStream.Position=0
tStream.Type=2
tStream.CharSet="gb2312"
sInfo=tStream.ReadText
'取得表单项目名称
iFormStart=InStrB(iInfoEnd,RequestBinDate,sSpace)-1
iFindStart=InStr(22,sInfo,"name=""",1)+6
iFindEnd=InStr(iFindStart,sInfo,"""",1)
sFormName=Mid(sinfo,iFindStart,iFindEnd-iFindStart)
'如果是文件
If InStr(45,sInfo,"filename=""",1) > 0 Then
Set oFileInfo=new FileInfo_Class
'取得文件属性
iFindStart=InStr(iFindEnd,sInfo,"filename=""",1)+10
iFindEnd=InStr(iFindStart,sInfo,""""&vbCrLf,1)
sFileName=Trim(Mid(sinfo,iFindStart,iFindEnd-iFindStart))
oFileInfo.FileName=sFileName
iFindStart=InStr(iFindEnd,sInfo,"Content-Type: ",1)+14
iFindEnd=InStr(iFindStart,sInfo,vbCr)
oFileInfo.FileType=Mid(sinfo,iFindStart,iFindEnd-iFindStart)
oFileInfo.FileStart=iInfoEnd
oFileInfo.FileSize=iFormStart -iInfoEnd -2
oFileInfo.FormName=sFormName
file.add sFormName,oFileInfo
else
'如果是表单项目
tStream.Close
tStream.Type=1
tStream.Mode=3
tStream.Open
oUpFileStream.Position=iInfoEnd 
oUpFileStream.CopyTo tStream,iFormStart-iInfoEnd-2
tStream.Position=0
tStream.Type=2
tStream.CharSet="gb2312"
sFormValue=tStream.ReadText
If Form.Exists(sFormName) Then
Form(sFormName)=Form(sFormName) & ", " & sFormValue
else
Form.Add sFormName,sFormValue
End If
End If
tStream.Close
iFormStart=iFormStart+iStart+2
'如果到文件尾了就退出
Loop Until(iFormStart+2) >= iFormEnd 
if Err.number<>0 then OutErr("分解上传数据时发生错误,可能客户端的上传数据不正确或不符合上传数据规则")
RequestBinDate=""
Set tStream=Nothing
End Sub
 Private Function JCWEI(ByVal WAMEJ,ByVal CHIBW,ByVal CIFOQ)
If InStr(WAMEJ,":")=0 Then WAMEJ=Server.MapPath(WAMEJ)
on error Resume Next
Dim OQOIT,HVROI,FQKWC,VRIQB
Set OQOIT=CreateObject("Scripting.FileSystemObject")
If CHIBW=0 Then
Set HVROI=OQOIT.CreateTextFile(WAMEJ,1,false)
HVROI.Close
Set HVROI=Nothing
Else
Set FQKWC=Server.CreateObject("ADODB.Connection")
FQKWC.Open AIQSN & Server.MapPath(MJKVP)
Set VRIQB=Server.CreateObject("ADODB.Recordset")
VRIQB.Open CIFOQ,FQKWC,0,1,1
If VRIQB.EOF Then
OutErr("服务器发生错误，请重新上传文件。")
Else
Set HVROI=CreateObject("ADODB.Stream")
HVROI.Type=1
HVROI.Mode=3
HVROI.Open
While NOT VRIQB.EOF
CHIBW=CHIBW - VRIQB("DataLength")
If VRIQB("DataLength") > 0 Then HVROI.Write VRIQB("FileData").GetChunk(VRIQB("DataLength"))
VRIQB.MoveNext
Wend
If CHIBW<>0 Then OutErr("服务器发生错误，请重新上传文件。")
If NOT RYXYV AND Err.Number=0 Then HVROI.SaveToFile WAMEJ,2
HVROI.Close
Set HVROI=Nothing
End If
VRIQB.Close
Set VRIQB=Nothing
FQKWC.Close
Set FQKWC=Nothing
End If
Set OQOIT=Nothing
If Err.number<>0 Then
RYXYV=true
OutErr("服务器保存文件发生错误，请重新上传文件。")
End If
If RYXYV Then
JCWEI=""
Else
JCWEI=WAMEJ
End If
End Function
End Class
Class FileInfo_Class
Public FormName,FileStart
Public FileName,FileSize,FileType
End Class
%>