论坛 Forum

<%

Class UpFile_Class

Dim Form,File

Dim AllowExt_ '允许上传类型(白名单)

Dim NoAllowExt_ '不允许上传类型(黑名单)

Dim IsDebug_ '是否显示出错信息

Private oUpFileStream '上传的数据流

Private isErr_ '错误的代码,0或true表示无错

Private ErrMessage_ '错误的字符串信息

Private isGetData_ '指示是否已执行过GETDATA过程

'------------------------------------------------------------------

'类的属性

Public Property Get Version

Version="无惧上传类 Version V2.0"

End Property

Public Property Get isErr '错误的代码,0或true表示无错

isErr=isErr_

End Property

Public Property Get ErrMessage '错误的字符串信息

ErrMessage=ErrMessage_

End Property

Public Property Get AllowExt '允许上传类型(白名单)

AllowExt=AllowExt_

End Property

Public Property Let AllowExt(Value) '允许上传类型(白名单)

AllowExt_=LCase(Value)

End Property

Public Property Get NoAllowExt '不允许上传类型(黑名单)

NoAllowExt=NoAllowExt_

End Property

Public Property Let NoAllowExt(Value) '不允许上传类型(黑名单)

NoAllowExt_=LCase(Value)

End Property

Public Property Let IsDebug(Value) '是否设置为调试模式

IsDebug_=Value

End Property

'----------------------------------------------------------------

'类实现代码

'初始化类

Private Sub Class_Initialize

isErr_ = 0

NoAllowExt="" '黑名单,可以在这里预设不可上传的文件类型,以文件的后缀名来判断,不分大小写,每个每缀名用;号分开,如果黑名单为空,则判断白名单

NoAllowExt=LCase(NoAllowExt)

AllowExt="" '白名单,可以在这里预设可上传的文件类型,以文件的后缀名来判断,不分大小写,每个后缀名用;号分开

AllowExt=LCase(AllowExt)

isGetData_=false

End Sub

'类结束

Private Sub Class_Terminate

on error Resume Next

'清除变量及对像

Form.RemoveAll

Set Form = Nothing

File.RemoveAll

Set File = Nothing

oUpFileStream.Close

Set oUpFileStream = Nothing

if Err.number<>0 then OutErr("清除类时发生错误!")

End Sub

'分析上传的数据

Public Sub GetData (MaxSize)

'定义变量

on error Resume Next

if isGetData_=false then 

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 '如果没有数据上传

isErr_ = 1

ErrMessage_="没有数据上传,这是因为直接提交网址所产生的错误!"

OutErr("没有数据上传,这是因为直接提交网址所产生的错误!!")

Exit Sub

End If

If MaxSize > 0 Then '如果限制大小

If Request.TotalBytes > MaxSize Then

isErr_ = 2 '如果上传的数据超出限制大小

ErrMessage_="上传的数据超出限制大小!"

OutErr("上传的数据超出限制大小!")

Exit Sub

End If

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)时出错,可能系统不支持或没有开通该组件")

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 = GetFileName(sFileName)

oFileInfo.FilePath = GetFilePath(sFileName)

oFileInfo.FileExt = GetFileExt(sFileName)

iFindStart = InStr (iFindEnd,sInfo,"Content-Type: ",1)+14

iFindEnd = InStr (iFindStart,sInfo,vbCr)

oFileInfo.FileMIME = 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

isGetData_=true

end if

End Sub

'保存到文件,自动覆盖已存在的同名文件

Public Function SaveToFile(Item,Path)

SaveToFile=SaveToFileEx(Item,Path,True)

End Function

'保存到文件,自动设置文件名

Public Function AutoSave(Item,Path)

AutoSave=SaveToFileEx(Item,Path,false)

End Function

'保存到文件,OVER为真时,自动覆盖已存在的同名文件,否则自动把文件改名保存

Private Function SaveToFileEx(Item,Path,Over)

On Error Resume Next

Dim FileExt

if file.Exists(Item) then

Dim oFileStream

Dim tmpPath

isErr_=0

Set oFileStream = CreateObject ("ADODB.Stream")

oFileStream.Type = 1

oFileStream.Mode = 3

oFileStream.Open

oUpFileStream.Position = File(Item).FileStart

oUpFileStream.CopyTo oFileStream,File(Item).FileSize

tmpPath=Split(Path,".")(0)

FileExt=GetFileExt(Path)

if Over then

if isAllowExt(FileExt) then

oFileStream.SaveToFile tmpPath & "." & FileExt,2

if Err.number<>0 then OutErr("保存文件时出错,请检查路径,是否存在该上传目录!该文件保存路径为" & tmpPath & "." & FileExt)

Else

isErr_=3

ErrMessage_="该后缀名的文件不允许上传!"

OutErr("该后缀名的文件不允许上传")

End if

Else

Path=GetFilePath(Path)

dim fori

fori=1

if isAllowExt(File(Item).FileExt) then

do

fori=fori+1

Err.Clear()

tmpPath=Path&GetNewFileName()&"."&File(Item).FileExt

oFileStream.SaveToFile tmpPath

loop Until ((Err.number=0) or (fori>50))

if Err.number<>0 then OutErr("自动保存文件出错,已经测试50次不同的文件名来保存,请检查目录是否存在!该文件最后一次保存时全路径为"&Path&GetNewFileName()&"."&File(Item).FileExt)

Else

isErr_=3

ErrMessage_="该后缀名的文件不允许上传!"

OutErr("该后缀名的文件不允许上传")

End if

End if

oFileStream.Close

Set oFileStream = Nothing

else

ErrMessage_="不存在该对象(如该文件没有上传,文件为空)!"

OutErr("不存在该对象(如该文件没有上传,文件为空)")

end if

if isErr_=3 then SaveToFileEx="" else SaveToFileEx=GetFileName(tmpPath)

End Function

'取得文件数据

Public Function FileData(Item)

isErr_=0

if file.Exists(Item) then

if isAllowExt(File(Item).FileExt) then

oUpFileStream.Position = File(Item).FileStart

FileData = oUpFileStream.Read (File(Item).FileSize)

Else

isErr_=3

ErrMessage_="该后缀名的文件不允许上传"

OutErr("该后缀名的文件不允许上传")

FileData=""

End if

else

ErrMessage_="不存在该对象(如该文件没有上传,文件为空)!"

OutErr("不存在该对象(如该文件没有上传,文件为空)")

end if

End Function

'取得文件路径

Public function GetFilePath(FullPath)

  If FullPath <> "" Then

    GetFilePath = Left(FullPath,InStrRev(FullPath, "\"))

    Else

    GetFilePath = ""

  End If

End function

'取得文件名

Public Function GetFileName(FullPath)

  If FullPath <> "" Then

    GetFileName = mid(FullPath,InStrRev(FullPath, "\")+1)

    Else

    GetFileName = ""

  End If

End function

'取得文件的后缀名

Public Function GetFileExt(FullPath)

  If FullPath <> "" Then

    GetFileExt = LCase(Mid(FullPath,InStrRev(FullPath, ".")+1))

    Else

    GetFileExt = ""

  End If

End function

'取得一个不重复的序号

Public Function GetNewFileName()

dim ranNum

dim dtNow

dtNow=Now()

randomize

ranNum=int(90000*rnd)+10000

'以下这段由webboy提供

GetNewFileName=year(dtNow) & right("0" & month(dtNow),2) & right("0" & day(dtNow),2) & right("0" & hour(dtNow),2) & right("0" & minute(dtNow),2) & right("0" & second(dtNow),2) & ranNum

End Function

Public Function isAllowExt(Ext)

if NoAllowExt="" then

isAllowExt=cbool(InStr(1,";"&AllowExt&";",LCase(";"&Ext&";")))

else

isAllowExt=not CBool(InStr(1,";"&NoAllowExt&";",LCase(";"&Ext&";")))

end if

End Function

End Class

Public Sub OutErr(ErrMsg)

if IsDebug_=true then

Response.Write ErrMsg

Response.End

End if

End Sub

'----------------------------------------------------------------------------------------------------

'文件属性类

Class FileInfo_Class

Dim FormName,FileName,FilePath,FileSize,FileMIME,FileStart,FileExt

End Class

%>

<%OPTION EXPLICIT%>

<!--#include FILE="upfile_class.asp"-->

<%

Server.ScriptTimeOut=9000

dim upfile,formPath,ServerPath,FSPath,formName,FileName,oFile,upfilecount,TmpPath

upfilecount=0

set upfile=new upfile_class ''建立上传对象

upfile.NoAllowExt="asp;exe;htm;html;aspx;cs;vb;js;" '设置上传类型的黑名单

upfile.GetData (10240000)   '取得上传数据,限制最大上传10M

%>

<html>

<head>

<title>文件上传</title>

<style type="text/css">

<!--

.p9{ font-size: 9pt; font-family: 宋体 }

-->

</style>

<meta http-equiv="Content-Type" content="text/html; charset=gb2312">

</head>

<body leftmargin="20" topmargin="20" class="p9">

<hr size=1 noshadow width=300 align=left>

<%

if upfile.isErr then  '如果出错

    select case upfile.isErr

case 1

Response.Write "你没有上传数据?"

case 2

Response.Write "你上传的文件超出我们的限制,最大10M"

end select

else

'Response.Write(upfile.isErr)

%>

<%

FSPath=GetFilePath(Server.mappath("upfile.asp"),"\")'取得当前文件在服务器路径

ServerPath=GetFilePath(Request.ServerVariables("HTTP_REFERER"),"/")'取得在网站上的位置

FSPath=FSPath & "UpLoadPicFile\"

for each formName in upfile.file '列出所有上传了的文件

  set oFile=upfile.file(formname)

  FileName=upfile.form(formName)'取得文本域的值

  if not FileName>"" then  FileName=oFile.filename'如果没有输入新的文件名,就用原来的文件名

  upfile.SaveToFile formname,FSPath&FileName   ''保存文件 也可以使用AutoSave来保存,参数一样,但是会自动建立新的文件名

              'Response.write(FSPath&FileName)

%>

   文件名称：<%=oFile.FilePath&oFile.FileName%><br>   <!--随机生成个文件名-->

   文件大小：<%=oFile.filesize%> KB <br>

  

    <%

TmpPath=GetFilePath(Request.ServerVariables("HTTP_REFERER"),"/src/plugins/")

TmpPath=TmpPath & "FileUpLoad/UpLoadPicFile/" & oFile.FileName

    if upfile.iserr then 

Response.Write upfile.errmessage

else

upfilecount=upfilecount+1

Response.Write "上传成功"

end if

%>

<%

set oFile=nothing

next

  end if

  

Response.write "<script type=text/javascript>parent.KE.plugin[""image""].insert("""&upfile.form("id")&""","""&TmpPath&""","""&upfile.form("imgTitle")&""","""&upfile.form("imgWidth")&""","""&upfile.form("imgHeight")&""","""&upfile.form("imgBorder")&""");</script>"

set upfile=nothing  '删除此对象

Response.End()

  

 

%>

 

</body>

</html>

<%

function GetFilePath(FullPath,str)

  If FullPath <> "" Then

    GetFilePath = left(FullPath,InStrRev(FullPath, str))

    Else

    GetFilePath = ""

  End If

End function

%>

<script type="text/javascript">

    KE.show({

        id : 'content1',

        skinType: 'tinymce',

resizeMode : 1,

        cssPath : 'KindEditor/Css/index.css',

        items : [

            'undo', 'redo', 'cut', 'copy', 'paste',

            'plainpaste', 'wordpaste', 'justifyleft', 'justifycenter', 'justifyright',

            'justifyfull', 'insertorderedlist', 'insertunorderedlist', 'indent', 'outdent', 'subscript',

            'superscript', 'date', 'time', 'specialchar', 'emoticons', 'link', 'unlink', '-',

            'title', 'fontname', 'fontsize', 'textcolor', 'bgcolor', 'bold',

            'italic', 'underline', 'strikethrough', 'removeformat', 'selectall', 'image',

            'layer', 'table', 'hr'

        ]

    });

  </script>